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))
   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))
  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 &key (js-target-version *js-target-version*))
  34   `(test ,testname ()
  35          (is (string= (normalize-js-code (let ((*js-target-version* ,js-target-version))
  36                                            (ps-doc* ',parenscript)))
  37                       (normalize-js-code ,javascript)))))
  38
  39 (defmacro test-js-eval (testname parenscript result)
  40   (let ((js-result (gensym)))
  41    `(test ,testname ()
  42       (cl-js:with-js-env ()
  43         (let ((,js-result (cl-js:run-js (ps-doc* ',parenscript))))
  44           (is (funcall (if (typep ,js-result 'structure-object) #'equalp #'equal)
  45                        ,js-result
  46                        ,result)))))))
  47
  48 (defun jsarray (contents)
  49   (cl-js:js-array
  50    (make-array (length contents) :initial-contents contents :adjustable t)))
  51
  52 (def-suite output-tests)
  53 (def-suite package-system-tests)
  54 (def-suite eval-tests)
  55
  56 (defun run-tests()
  57   (format t "Running output tests:~&")
  58   (run! 'output-tests)
  59   (format t "Running package system tests:~&")
  60   (run! 'package-system-tests)
  61   (format t "Running CL-JavaScript eval tests:~&")
  62   (run! 'eval-tests))