t/test.lisp

   1 ;; SPDX-License-Identifier: BSD-3-Clause
   2
   3 (in-package #:ps-test)
   4
   5 (defun normalize-whitespace (str)
   6   (substitute #\Space #\Newline (substitute #\Space #\Tab str)))
   7
   8 (defun same-space-between-statements (code)
   9   (let ((cl-ppcre:*use-bmh-matchers* nil))
  10     (cl-ppcre:regex-replace-all "\\s*;\\s*" code "; ")))
  11
  12 (defun remove-duplicate-spaces (str)
  13   (labels ((spacep (char) (and char (char= char #\Space)))
  14            (rds (list)
  15              (cond ((null list)
  16                     nil)
  17                    ((and (spacep (first list))
  18                          (spacep (second list)))
  19                     (rds (cons #\Space (cddr list))))
  20                    (t
  21                     (cons (car list) (rds (cdr list)))))))
  22     (coerce (rds (coerce str 'list)) 'string)))
  23
  24 (defun trim-spaces (str)
  25   (string-trim '(#\Space) str))
  26
  27 (defun remove-spaces-near-brackets (str)
  28   (let ((cl-ppcre:*use-bmh-matchers* nil))
  29     (reduce (lambda (str rex-pair)
  30               (cl-ppcre:regex-replace-all (first rex-pair) str (second rex-pair)))
  31             (cons str '(("\\[ " "[") (" \\]" "]") ("\\( " "(") (" \\)" ")"))))))
  32
  33 (defun normalize-js-code (str)
  34   (remove-spaces-near-brackets
  35    (trim-spaces
  36     (remove-duplicate-spaces
  37      (same-space-between-statements
  38       (normalize-whitespace str))))))
  39
  40 (defmacro test-ps-js (testname parenscript javascript
  41                       &key (js-target-version *js-target-version*))
  42   `(test ,testname ()
  43          (is (string= (normalize-js-code ,javascript)
  44                       (normalize-js-code
  45                        (let ((*js-target-version* ,js-target-version))
  46                          (ps-doc* ',parenscript)))))))
  47
  48 (defun jsarray (contents)
  49   (cl-js:js-array
  50    (make-array (length contents)
  51                :initial-contents (mapcar (lambda (x)
  52                                            (if (listp x)
  53                                                (jsarray x)
  54                                                x))
  55                                          contents)
  56                :adjustable t)))
  57
  58 (defmacro %test-js-eval (testname parenscript test-statement)
  59   `(test ,testname ()
  60      (cl-js:with-js-env ()
  61        (let ((js-result (cl-js:run-js (ps-doc* ',parenscript))))
  62          ,test-statement))))
  63
  64 (defmacro test-js-eval (testname parenscript result)
  65   `(%test-js-eval ,testname ,parenscript
  66      (is (equalp js-result
  67                  ,(if (atom result)
  68                       result
  69                       `(jsarray ,result))))))
  70
  71 (defmacro test-js-eval-epsilon (testname parenscript result)
  72   `(%test-js-eval ,testname ,parenscript
  73      (is (< (abs (- js-result ,result)) 0.0001))))
  74
  75 (def-suite parenscript-tests)
  76 (def-suite output-tests :in parenscript-tests)
  77 (def-suite package-system-tests :in parenscript-tests)
  78 (def-suite eval-tests :in parenscript-tests)
  79
  80 (defun run-tests()
  81   (format t "Running output tests:~&")
  82   (run! 'output-tests)
  83   (format t "Running package system tests:~&")
  84   (run! 'package-system-tests)
  85   (format t "Running CL-JavaScript eval tests:~&")
  86   (run! 'eval-tests))