Commit | Line | Data |
---|---|---|
5af33a27 | 1 | (in-package "PS-TEST") |
711dd89e | 2 | |
cf460f93 VS |
3 | (defun normalize-whitespace (str) |
4 | (substitute #\Space #\Newline (substitute #\Space #\Tab str))) | |
a9dd0664 | 5 | |
5af33a27 VS |
6 | (defun same-space-between-statements (code) |
7 | (let ((cl-ppcre:*use-bmh-matchers* nil)) | |
a9dd0664 VS |
8 | (cl-ppcre:regex-replace-all "\\s*;\\s*" code "; "))) |
9 | ||
cf460f93 VS |
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))) | |
a9dd0664 | 17 | |
cf460f93 VS |
18 | (defun trim-spaces (str) |
19 | (string-trim '(#\Space) str)) | |
a9dd0664 | 20 | |
cf460f93 | 21 | (defun remove-spaces-near-brackets (str) |
5af33a27 | 22 | (let ((cl-ppcre:*use-bmh-matchers* nil)) |
a9dd0664 VS |
23 | (reduce (lambda (str rex-pair) (cl-ppcre:regex-replace-all (first rex-pair) str (second rex-pair))) |
24 | (cons str '(("\\[ " "[") (" \\]" "]") ("\\( " "(") (" \\)" ")")))))) | |
25 | ||
cf460f93 VS |
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)))))) | |
7a7d6c73 | 32 | |
4525e3cd | 33 | (defmacro test-ps-js (testname parenscript javascript &key (js-target-version *js-target-version*)) |
5af33a27 | 34 | `(test ,testname () |
4525e3cd VS |
35 | (is (string= (normalize-js-code (let ((*js-target-version* ,js-target-version)) |
36 | (ps-doc* ',parenscript))) | |
5af33a27 | 37 | (normalize-js-code ,javascript))))) |
eb17f15c HH |
38 | |
39 | (defun run-tests() | |
711dd89e HH |
40 | (format t "Running reference tests:~&") |
41 | (run! 'ref-tests) | |
42 | (format t "Running other tests:~&") | |
5aa10005 RD |
43 | (run! 'ps-tests) |
44 | (format t "Running Package System tests:~&") | |
45 | (run! 'package-system-tests)) |