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