| 1 | (in-package "PS-TEST") |
| 2 | |
| 3 | (defun normalize-whitespace (str) |
| 4 | (substitute #\Space #\Newline (substitute #\Space #\Tab str))) |
| 5 | |
| 6 | (defun same-space-between-statements (code) |
| 7 | (let ((cl-ppcre:*use-bmh-matchers* nil)) |
| 8 | (cl-ppcre:regex-replace-all "\\s*;\\s*" code "; "))) |
| 9 | |
| 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))) |
| 17 | |
| 18 | (defun trim-spaces (str) |
| 19 | (string-trim '(#\Space) str)) |
| 20 | |
| 21 | (defun remove-spaces-near-brackets (str) |
| 22 | (let ((cl-ppcre:*use-bmh-matchers* nil)) |
| 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)))))) |
| 32 | |
| 33 | (defmacro test-ps-js (testname parenscript javascript &key (js-target-version *js-target-version*)) |
| 34 | `(test ,testname () |
| 35 | (is (string= (normalize-js-code (let ((*js-target-version* ,js-target-version)) |
| 36 | (ps-doc* ',parenscript))) |
| 37 | (normalize-js-code ,javascript))))) |
| 38 | |
| 39 | (defun run-tests() |
| 40 | (format t "Running reference tests:~&") |
| 41 | (run! 'ref-tests) |
| 42 | (format t "Running other tests:~&") |
| 43 | (run! 'ps-tests) |
| 44 | (format t "Running Package System tests:~&") |
| 45 | (run! 'package-system-tests)) |