Commit | Line | Data |
---|---|---|
eb17f15c | 1 | (in-package :js-test) |
711dd89e | 2 | |
eb17f15c HH |
3 | ;; Testcases for parenscript |
4 | ||
cf460f93 VS |
5 | (defun normalize-whitespace (str) |
6 | (substitute #\Space #\Newline (substitute #\Space #\Tab str))) | |
eb17f15c | 7 | |
7a7d6c73 | 8 | (defun same-space-between-statements(code) |
cf460f93 VS |
9 | (cl-ppcre:regex-replace-all "\\s*;\\s*" code "; ")) |
10 | ||
11 | (defun remove-duplicate-spaces (str) | |
12 | (labels ((spacep (char) (and char (char= char #\Space))) | |
13 | (rds (list) | |
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))) | |
18 | ||
19 | (defun trim-spaces (str) | |
20 | (string-trim '(#\Space) str)) | |
21 | ||
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 '(("\\[ " "[") (" \\]" "]") ("\\( " "(") (" \\)" ")"))))) | |
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)))))) | |
7a7d6c73 | 32 | |
eb17f15c HH |
33 | (defmacro test-ps-js (testname parenscript javascript) |
34 | `(test ,testname () | |
7a7d6c73 HH |
35 | (setf js::*var-counter* 0) |
36 | ;; is-macro expands its argument again when reporting failures, so | |
37 | ;; the reported temporary js-variables get wrong if we don't evalute first. | |
9da682ca | 38 | (let ((generated-code (compile-script ',parenscript)) |
7a7d6c73 HH |
39 | (js-code ,javascript)) |
40 | (is (string= (normalize-js-code generated-code) | |
94a05cdf | 41 | (normalize-js-code js-code)))))) |
eb17f15c HH |
42 | |
43 | (defun run-tests() | |
711dd89e HH |
44 | (format t "Running reference tests:~&") |
45 | (run! 'ref-tests) | |
46 | (format t "Running other tests:~&") | |
47 | (run! 'ps-tests)) | |
48 |