t/test.lisp

   1 (in-package :ps-test)
   2
   3 (defun normalize-whitespace (str)
   4   (substitute #\Space #\Newline (substitute #\Space #\Tab str)))
   5
   6 (defun same-space-between-statements(code)
   7   (let ((cl-ppcre:*use-bmh-matchers* nil)) ;; disable Booyer Moore string matching algorithm, which doesn't work very well on unicode lisps
   8     (cl-ppcre:regex-replace-all "\\s*;\\s*" code "; ")))
   9
  10 (defun remove-duplicate-spaces (str)
  11   (labels ((spacep (char) (and char (char= char #\Space)))
  12            (rds (list)
  13              (cond ((null list) nil)
  14                    ((and (spacep (first list)) (spacep (second list))) (rds (cons #\Space (cddr list))))
  15                    (t (cons (car list) (rds (cdr list)))))))
  16     (coerce (rds (coerce str 'list)) 'string)))
  17
  18 (defun trim-spaces (str)
  19   (string-trim '(#\Space) str))
  20
  21 (defun remove-spaces-near-brackets (str)
  22   (let ((cl-ppcre:*use-bmh-matchers* nil)) ;; disable Booyer Moore string matching algorithm, which doesn't work very well on unicode lisps
  23     (reduce (lambda (str rex-pair) (cl-ppcre:regex-replace-all (first rex-pair) str (second rex-pair)))
  24             (cons str '(("\\[ " "[") (" \\]" "]") ("\\( " "(") (" \\)" ")"))))))
  25
  26 (defun normalize-js-code (str)
  27   (remove-spaces-near-brackets
  28    (trim-spaces
  29     (remove-duplicate-spaces
  30      (same-space-between-statements
  31       (normalize-whitespace str))))))
  32
  33 (defmacro test-ps-js (testname parenscript javascript)
  34   (let (
  35         ;; (parenscript
  36         ;;   `(progn
  37         ;; (defpackage parenscript-test
  38         ;; (:lisp-package :parenscript-test))
  39         ;; ,parenscript)))
  40         )
  41     `(test ,testname ()
  42       (setf ps:*ps-gensym-counter* 0)
  43
  44       ;; is-macro expands its argument again when reporting failures, so
  45       ;; the reported temporary js-variables get wrong if we don't evalute first.
  46       (let* ((generated-code (compile-script ',parenscript))
  47              (js-code ,javascript))
  48         (is (string= (normalize-js-code generated-code)
  49                      (normalize-js-code js-code)))))))
  50
  51 (defmacro defpstest (testname (&key (optimize t)) parenscript javascript)
  52   `(test ,testname
  53     (setf ps:*ps-gensym-counter* 0)
  54     (let* ((generated-code (compile-script ',parenscript))
  55            (js-code ,javascript))
  56       (is (string= (normalize-js-code generated-code)
  57                    (normalize-js-code js-code))))))
  58
  59 (defun run-tests()
  60   (format t "Running reference tests:~&")
  61   (run! 'ref-tests)
  62   (format t "Running other tests:~&")
  63   (run! 'ps-tests)
  64   (format t "Running Package System tests:~&")
  65   (run! 'package-system-tests))
  66