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.
21 (in-suite ref-tests)~%~%") ; a double-quote for emacs: "
23 (defun make-reference-tests-dot-lisp()
27 (with-open-file (out-stream +generate-file
+
29 :if-exists
:supersede
)
33 (trim-whitespace (str)
34 (string-trim '(#\Space
#\Tab
#\Newline
) str
))
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
))
41 (strip-indentation (str indentation
)
43 (js::string-join
(mapcar #'(lambda (str)
44 (if (> (length str
) indentation
)
45 (subseq str indentation
)
47 (js::string-split str
(list #\Newline
)))
52 (let* ((sep-pos (search "=>" built
))
53 (cr-before-sep (when sep-pos
54 (or (position #\Newline
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
)))))
66 (format t
"Ignoring:~a...~%" (left built
40)))
67 ((search "=>" (subseq built
(+ 1 sep-pos
)))
68 (format t
"Error , two separators found~%"))
69 ((and (string= heading
"regular-expression-literals")
70 (= 2 heading-count
)) ;requires cl-interpol reader
71 (format t
"Skipping regex-test two~&"))
72 ((and lisp-part javascript-part
)
73 (format out-stream
"(test-ps-js ~a-~a~% ~a~% \"~a\")~%~%"
75 (trim-whitespace lisp-part
)
76 (strip-indentation javascript-part js-indent-width
)))
77 (t (format t
"Error, should not be here~%"))))))
78 (format out-stream
+head
+)
79 (with-open-file (stream +reference-file
+ :direction
:input
)
80 (loop for line
= (read-line stream nil nil
)
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")
90 ((string= (left line
1) ";") 'skip-comment
)
91 ((empty-p (trim-whitespace line
))
93 (setf is-collecting nil
)
99 built
(concatenate 'string built
100 (when (not (empty-p built
))
103 (format out-stream
"~%(run-tests)~%")))))
107 ;; (make-reference-tests-dot-lisp)