Commit | Line | Data |
---|---|---|
94a05cdf | 1 | (in-package :js-test) |
eb17f15c HH |
2 | ;;Generates automatic tests from the reference |
3 | ||
3c393e09 HH |
4 | (defparameter +reference-file+ (merge-pathnames |
5 | (make-pathname :directory '(:relative :back "docs")) | |
6 | (make-pathname :name "reference" | |
7 | :type "lisp" | |
8 | :defaults *load-truename*))) | |
9 | ||
10 | ||
eb17f15c HH |
11 | (defparameter +generate-file+ (make-pathname :name "reference-tests" |
12 | :type "lisp" | |
13 | :defaults *load-truename*)) | |
14 | ||
15 | (defparameter +head+ "(in-package :js-test) | |
16 | ;; Tests of everything in the reference. | |
17 | ;; File is generated automatically from the text in reference.lisp by | |
18 | ;; the function make-reference-tests-dot-lisp in ref2test.lisp | |
19 | ;; so do not edit this file. | |
20 | (def-suite ref-tests) | |
21 | (in-suite ref-tests)~%~%") ; a double-quote for emacs: " | |
551080b7 | 22 | |
eb17f15c HH |
23 | (defun make-reference-tests-dot-lisp() |
24 | (let ((built "") | |
25 | heading | |
26 | heading-count) | |
27 | (with-open-file (out-stream +generate-file+ | |
28 | :direction :output | |
29 | :if-exists :supersede) | |
94a05cdf | 30 | (labels |
eb17f15c HH |
31 | ((empty-p (str) |
32 | (zerop (length str))) | |
33 | (trim-whitespace (str) | |
34 | (string-trim '(#\Space #\Tab #\Newline) str)) | |
35 | (left (str count) | |
36 | (subseq str 0 (min count (length str)))) | |
37 | (lispify-heading (heading) | |
38 | (remove-if (lambda (ch) (or (char= ch #\`)(char= ch #\'))) | |
39 | (substitute #\- #\Space (string-downcase (trim-whitespace heading)) | |
40 | :test #'char=))) | |
eb17f15c HH |
41 | (strip-indentation (str indentation) |
42 | (if indentation | |
43 | (js::string-join (mapcar #'(lambda (str) | |
44 | (if (> (length str) indentation) | |
45 | (subseq str indentation) | |
46 | str)) | |
47 | (js::string-split str (list #\Newline))) | |
48 | (string #\Newline)) | |
49 | str)) | |
50 | ||
51 | (make-test () | |
52 | (let* ((sep-pos (search "=>" built)) | |
53 | (cr-before-sep (when sep-pos | |
54 | (or (position #\Newline | |
55 | (left built sep-pos) | |
56 | :from-end t | |
57 | :test #'char=) | |
58 | 0))) | |
59 | (js-indent-width (when cr-before-sep | |
60 | (+ 2 (- sep-pos cr-before-sep)))) | |
61 | (lisp-part (and sep-pos (left built sep-pos))) | |
62 | (javascript-part (when cr-before-sep | |
63 | (subseq built (+ 1 cr-before-sep))))) | |
64 | (cond | |
65 | ((null sep-pos) | |
7a7d6c73 | 66 | (format t "Ignoring:~a...~%" (left built 40))) |
eb17f15c | 67 | ((search "=>" (subseq built (+ 1 sep-pos))) |
7a7d6c73 | 68 | (format t "Error , two separators found~%")) |
eb17f15c HH |
69 | ((and (string= heading "regular-expression-literals") |
70 | (= 2 heading-count)) ;requires cl-interpol reader | |
7a7d6c73 | 71 | (format t "Skipping regex-test two~&")) |
eb17f15c | 72 | ((and lisp-part javascript-part) |
3c393e09 | 73 | (format out-stream "(test-ps-js ~a-~a~% ~a~% \"~a\")~%~%" |
eb17f15c HH |
74 | heading heading-count |
75 | (trim-whitespace lisp-part) | |
7a7d6c73 HH |
76 | (strip-indentation javascript-part js-indent-width))) |
77 | (t (format t "Error, should not be here~%")))))) | |
eb17f15c HH |
78 | (format out-stream +head+) |
79 | (with-open-file (stream +reference-file+ :direction :input) | |
80 | (loop for line = (read-line stream nil nil) | |
81 | with is-collecting | |
82 | while line do | |
83 | (cond | |
84 | ((string= (left line 4) ";;;#") | |
85 | (setf heading (lispify-heading (subseq line 5))) | |
86 | (setf heading-count 0) | |
87 | (when (string= (trim-whitespace heading) | |
88 | "the-parenscript-compiler") | |
89 | (return))) | |
90 | ((string= (left line 1) ";") 'skip-comment) | |
91 | ((empty-p (trim-whitespace line)) | |
92 | (when is-collecting | |
93 | (setf is-collecting nil) | |
94 | (incf heading-count) | |
95 | (make-test) | |
96 | (setf built ""))) | |
97 | (t | |
98 | (setf is-collecting t | |
99 | built (concatenate 'string built | |
100 | (when (not (empty-p built)) | |
101 | (list #\Newline)) | |
102 | line)))))) | |
711dd89e | 103 | (format out-stream "~%(run-tests)~%"))))) |