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 &{_{_}_>_<_"_'_} 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 &{_@_?_}_} 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