3 (defun normalize-whitespace (str)
4 (substitute #\Space
#\Newline
(substitute #\Space
#\Tab str
)))
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
"; ")))
10 (defun remove-duplicate-spaces (str)
11 (labels ((spacep (char) (and char
(char= char
#\Space
)))
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
)))
18 (defun trim-spaces (str)
19 (string-trim '(#\Space
) str
))
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
'(("\\[ " "[") (" \\]" "]") ("\\( " "(") (" \\)" ")"))))))
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* ((generated-code (compile-script ',parenscript
))
47 (js-code ,javascript
))
48 (is (string= (normalize-js-code generated-code
)
49 (normalize-js-code js-code
)))))))
51 (defmacro defpstest
(testname (&key
(optimize t
)) parenscript javascript
)
53 (setf parenscript
::*var-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
))))))
60 (format t
"Running reference tests:~&")
62 (format t
"Running other tests:~&")
64 (format t
"Running Package System tests:~&")
65 (run! 'package-system-tests
))