Commit | Line | Data |
---|---|---|
171bbab3 | 1 | (in-package :ps-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 | 33 | (defmacro test-ps-js (testname parenscript javascript) |
5aa10005 RD |
34 | (let ( |
35 | ;; (parenscript | |
36 | ;; `(progn | |
37 | ;; (defpackage parenscript-test | |
38 | ;; (:lisp-package :parenscript-test)) | |
39 | ;; ,parenscript))) | |
40 | ) | |
eb17f15c | 41 | `(test ,testname () |
7a7d6c73 | 42 | (setf js::*var-counter* 0) |
5aa10005 | 43 | |
7a7d6c73 HH |
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. | |
5aa10005 RD |
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))))))) | |
51 | ||
52 | (defmacro defpstest (testname (&key (optimize t) (enable-package-system t)) parenscript javascript) | |
53 | `(test ,testname | |
54 | (setf parenscript::*var-counter* 0) | |
55 | (let* ((parenscript::*enable-package-system* ,enable-package-system) | |
56 | (generated-code (compile-script ',parenscript)) | |
7a7d6c73 HH |
57 | (js-code ,javascript)) |
58 | (is (string= (normalize-js-code generated-code) | |
94a05cdf | 59 | (normalize-js-code js-code)))))) |
eb17f15c HH |
60 | |
61 | (defun run-tests() | |
711dd89e HH |
62 | (format t "Running reference tests:~&") |
63 | (run! 'ref-tests) | |
64 | (format t "Running other tests:~&") | |
5aa10005 RD |
65 | (run! 'ps-tests) |
66 | (format t "Running Package System tests:~&") | |
67 | (run! 'package-system-tests)) | |
711dd89e | 68 |