3 ;; Testcases for parenscript
5 (defun normalize-whitespace (str)
6 (substitute #\Space
#\Newline
(substitute #\Space
#\Tab str
)))
8 (defun same-space-between-statements(code)
9 (cl-ppcre:regex-replace-all
"\\s*;\\s*" code
"; "))
11 (defun remove-duplicate-spaces (str)
12 (labels ((spacep (char) (and char
(char= char
#\Space
)))
14 (cond ((null list
) nil
)
15 ((and (spacep (first list
)) (spacep (second list
))) (rds (cons #\Space
(cddr list
))))
16 (t (cons (car list
) (rds (cdr list
)))))))
17 (coerce (rds (coerce str
'list
)) 'string
)))
19 (defun trim-spaces (str)
20 (string-trim '(#\Space
) str
))
22 (defun remove-spaces-near-brackets (str)
23 (reduce (lambda (str rex-pair
) (cl-ppcre:regex-replace-all
(first rex-pair
) str
(second rex-pair
)))
24 (cons str
'(("\\[ " "[") (" \\]" "]") ("\\( " "(") (" \\)" ")")))))
26 (defun normalize-js-code (str)
27 (remove-spaces-near-brackets
29 (remove-duplicate-spaces
30 (same-space-between-statements
31 (normalize-whitespace str
))))))
33 (defmacro test-ps-js
(testname parenscript javascript
)
37 ;; (defpackage parenscript-test
38 ;; (:lisp-package :parenscript-test))
42 (setf js
::*var-counter
* 0)
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* ((parenscript::*enable-package-system
* nil
)
47 (generated-code (compile-script ',parenscript
))
48 (js-code ,javascript
))
49 (is (string= (normalize-js-code generated-code
)
50 (normalize-js-code js-code
)))))))
52 (defmacro defpstest
(testname (&key
(optimize t
) (enable-package-system t
)) parenscript javascript
)
54 (setf parenscript
::*var-counter
* 0)
55 (let* ((parenscript::*enable-package-system
* ,enable-package-system
)
56 (generated-code (compile-script ',parenscript
))
57 (js-code ,javascript
))
58 (is (string= (normalize-js-code generated-code
)
59 (normalize-js-code js-code
))))))
62 (format t
"Running reference tests:~&")
64 (format t
"Running other tests:~&")
66 (format t
"Running Package System tests:~&")
67 (run! 'package-system-tests
))