2 ;;Generates automatic tests from the reference
4 (defparameter +this-dir
+ (asdf:component-pathname
(asdf:find-component
(asdf:find-system
:parenscript.test
) "t")))
5 (defparameter +reference-file
+ (merge-pathnames
6 (make-pathname :directory
'(:relative
:back
"docs")
11 (defparameter +generate-file
+ (make-pathname :name
"reference-tests"
13 :defaults
+this-dir
+))
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 (eval-when (:compile-toplevel :load-toplevel :execute)
21 (def-suite ref-tests))
22 (in-suite ref-tests)~%~%") ; a double-quote for emacs: "
24 (defun make-reference-tests-dot-lisp()
28 (with-open-file (out-stream +generate-file
+
30 :if-exists
:supersede
)
34 (trim-whitespace (str)
35 (string-trim '(#\Space
#\Tab
#\Newline
) str
))
37 (subseq str
0 (min count
(length str
))))
38 (lispify-heading (heading)
39 (remove-if (lambda (ch) (or (char= ch
#\
`)(char= ch
#\')))
40 (substitute #\-
#\Space
(string-downcase (trim-whitespace heading
))
42 (strip-indentation (str indentation
)
44 (js::string-join
(mapcar #'(lambda (str)
45 (if (> (length str
) indentation
)
46 (subseq str indentation
)
48 (js::string-split str
(list #\Newline
)))
53 (let* ((sep-pos (search "=>" built
))
54 (cr-before-sep (when sep-pos
55 (or (position #\Newline
60 (js-indent-width (when cr-before-sep
61 (+ 2 (- sep-pos cr-before-sep
))))
62 (lisp-part (and sep-pos
(left built sep-pos
)))
63 (javascript-part (when cr-before-sep
64 (subseq built
(+ 1 cr-before-sep
)))))
67 (format t
"Ignoring:~a...~%" (left built
40)))
68 ((search "=>" (subseq built
(+ 1 sep-pos
)))
69 (format t
"Error , two separators found~%"))
70 ((and (string= heading
"regular-expression-literals")
71 (= 3 heading-count
)) ;requires cl-interpol reader
72 (format t
"Skipping regex-test with cl-interpol&"))
73 ((and lisp-part javascript-part
)
74 (format out-stream
"(test-ps-js ~a-~a~% ~a~% \"~a\")~%~%"
76 (trim-whitespace lisp-part
)
77 (strip-indentation javascript-part js-indent-width
)))
78 (t (format t
"Error, should not be here~%"))))))
79 (format out-stream
+head
+)
80 (with-open-file (stream +reference-file
+ :direction
:input
)
81 (loop for line
= (read-line stream nil nil
)
85 ((string= (left line
4) ";;;#")
86 (setf heading
(lispify-heading (subseq line
5)))
87 (setf heading-count
0)
88 (when (string= (trim-whitespace heading
)
89 "the-parenscript-compiler")
91 ((string= (left line
1) ";") 'skip-comment
)
92 ((empty-p (trim-whitespace line
))
94 (setf is-collecting nil
)
100 built
(concatenate 'string built
101 (when (not (empty-p built
))
106 (make-reference-tests-dot-lisp)