1(test-begin "srfi-109")
2
3(cond-expand
4 (kawa
5  ;; Using 3-operand datum->syntax enables line numbers in reporting.
6  (define-syntax strtest
7    (lambda (form)
8      (syntax-case form ()
9        ;; We need to use the rest1 and rest2 variables since the Kawa reader
10        ;; currently only attaches line-numbers to pairs, and the quoted and
11        ;; evaluated sub-forms aren't guaranteed to be lists.
12        ((strtest value . rest1)
13         (syntax-case #'rest1 ()
14           ((quoted . rest2)
15            (syntax-case #'rest2 ()
16              ((evaluated)
17               #`(begin
18                   #,(datum->syntax form #'(test-equal quoted (quote value))
19                                    #'rest1)
20                   #,(datum->syntax form #'(test-equal evaluated value)
21                                    #'rest2)))))))))))
22 (else
23  (define-syntax strtest
24    (syntax-rules ()
25      ((strtest string quoted evaluated)
26       (begin
27         (test-equal quoted (quote string))
28         (test-equal evaluated string)))))))
29
30(strtest &{abc}
31         '($string$ "abc")
32         "abc")
33(strtest &{ab&(+ 3 4)xz}
34         '($string$ "ab" $<<$ (+ 3 4) $>>$ "xz")
35         "ab7xz")
36(strtest &{ab&[(+ 3 4)]xz}
37         '($string$ "ab" $<<$ (+ 3 4) $>>$ "xz")
38         "ab7xz")
39;; Literal nested braces.
40(strtest &{ab{x}{}c{{d}}}
41         '($string$ "ab{x}{}c{{d}}")
42         "ab{x}{}c{{d}}")
43;; Literal nested braces with enclosed expression.
44(strtest &{ab{&[(+ 5 7)]c}z}
45         '($string$ "ab{" $<<$ (+ 5 7) $>>$ "c}z")
46         "ab{12c}z")
47(strtest &{ab&[3 4]xzy}
48         '($string$ "ab" $<<$ 3 4 $>>$ "xzy")
49         "ab34xzy")
50(strtest &{_&lbrace;_&rbrace;_&gt;_&lt;_&quot;_&apos;_}
51         '($string$ "_" $entity$:lbrace "_" $entity$:rbrace "_" $entity$:gt
52                    "_" $entity$:lt "_" $entity$:quot "_" $entity$:apos "_")
53         "_{_}_>_<_\"_'_")
54
55(strtest &{_&alarm;_&backspace;_&delete;_&escape;_&newline;_&null;_&return;_&space;_&tab;_}
56         '($string$ "_" $entity$:alarm "_" $entity$:backspace
57                    "_" $entity$:delete "_" $entity$:escape "_" $entity$:newline
58                    "_" $entity$:null "_" $entity$:return "_" $entity$:space
59                    "_" $entity$:tab "_")
60         "_\a_\b_\x7f;_\x1b;_\n_\x0;_\r_ _\t_")
61
62(strtest &{a
63b}
64         '($string$ "a\nb")
65         "a\nb")
66
67(strtest &{_&#64;_&#x3f;_&#125;_}
68         '($string$ "_@_?_}_")
69         "_@_?_}_")
70
71(strtest &{abc&#|comment|#xyz} '($string$ "abcxyz") "abcxyz")
72
73(strtest &{abc
74    &|def
75    &| klm}
76         '($string$ "abc\ndef\n klm")
77         "abc\ndef\n klm")
78
79(strtest &{
80    &|def
81    &| klm}
82         '($string$ "def\n klm")
83         "def\n klm")
84
85;; Next line is supposed to have trailing whitespace - should be ignored.
86(strtest &{
87    &|def
88    &| klm}
89         '($string$ "def\n klm")
90         "def\n klm")
91
92(test-equal
93 "\n  ab\n  cd\n"
94 (test-read-eval-string "&{\n  ab\n  cd\n}"))
95
96(test-equal
97 " ab\n cd\n"
98 (test-read-eval-string "&{\n &| ab\n &| cd\n}"))
99
100(test-equal
101 "\n\n ab\n cd\n"
102 (test-read-eval-string "&{\n\n &| ab\n &| cd\n}"))
103
104(test-equal
105 "\n ab\n cd\n"
106 (test-read-eval-string "&{&#||#\n &| ab\n &| cd\n}"))
107
108(test-equal
109 "\n ab\n cd\n"
110 (test-read-eval-string "&{&[]\n &| ab\n &| cd\n}"))
111
112(test-equal
113 " ab\n cd\n"
114 (test-read-eval-string "&{   \n &| ab\n &| cd\n}"))
115
116(test-equal
117 "line1\nline2\n"
118 (test-read-eval-string "&{
119     &|line1
120     &|line2
121     &|}"))
122
123(test-equal
124 "line1\nline2\n"
125 (test-read-eval-string "&{\n     &|line1\n     &|line2\n}"))
126
127(test-equal
128 " k \n ab\n cd\n"
129 (test-read-eval-string "&{ k \n &| ab\n &| cd\n}"))
130
131(test-equal
132 "   \n ab\n cd\n"
133 (test-read-eval-string "&{ &space; \n &| ab\n &| cd\n}"))
134
135(strtest &{&space;
136    &|def
137    &| klm}
138         '($string$ $entity$:space "\ndef\n klm")
139         " \ndef\n klm")
140
141(strtest &{abc&-
142  def&-
143  &| klm}
144         '($string$ "abc  def klm")
145         "abc  def klm")
146
147(strtest &{<&[(string-length "a/b/c")]>}
148         '($string$ "<" $<<$ (string-length "a/b/c")  $>>$ ">")
149         "<5>")
150
151(strtest &{m&[3]&[4]n}
152         '($string$ "m" $<<$ 3 $>>$ $<<$ 4 $>>$ "n")
153         "m34n")
154
155;; Some tests using format
156(strtest &{abc&~3d(+ 4 5)z}
157         '($string$ "abc" ($format$ "~3d" (+ 4 5)) "z")
158         "abc  9z")
159
160(strtest &{A&~{[]<&[[5 6 7]]>&~}[]Z}
161         '($string$ "A" ($format$ "~{") "<" $<<$ ($bracket-list$ 5 6 7)
162                    $>>$ ">" ($format$ "~}") "Z")
163         "A<5><6><7>Z")
164
165;; Same as above, but with ellided empty []
166(strtest &{A&~{<&[[5 6 7]]>&~}Z}
167         '($string$ "A" ($format$ "~{") "<" $<<$ ($bracket-list$ 5 6 7)
168                    $>>$ ">" ($format$ "~}") "Z")
169         "A<5><6><7>Z")
170
171(strtest &{[&~{&[[5 6 7]]&~^_&~}]}
172         '($string$ "[" ($format$ "~{") $<<$ ($bracket-list$ 5 6 7)
173                    $>>$ ($format$ "~^") "_" ($format$ "~}") "]")
174         "[5_6_7]")
175
176(strtest &{[&~{&[[]]&~^_&~}]}
177         '($string$ "[" ($format$ "~{") $<<$ ($bracket-list$)
178                    $>>$ ($format$ "~^") "_" ($format$ "~}") "]")
179         "[]")
180
181(strtest &{_&~4t~w["qwerty"]_}
182         '($string$ "_" ($format$ "~4t~w" "qwerty") "_")
183         &{_   "qwerty"_})
184
185(cond-expand (kawa
186              (strtest &{X&[@(list 3 4)]Y}
187                       '($string$ "X" $<<$ ($splice$ (list 3 4)) $>>$ "Y")
188                       "X34Y")
189              (strtest &{X&~w[@(list "x" "y")]Y}
190                       '($string$ "X" ($format$ "~w" ($splice$ (list "x" "y")))
191                                  "Y")
192                       &{X"x"Y})
193              (strtest &{X&~w[@(list "x" "y")]&~w[]Y}
194                       '($string$ "X" ($format$ "~w" ($splice$ (list "x" "y")))
195                                  ($format$ "~w") "Y")
196                       &{X"x""y"Y})
197              ))
198
199(test-end)
200