Commit | Line | Data |
---|---|---|
7337d56d LC |
1 | ;;;; reader.test --- Exercise the reader. -*- Scheme -*- |
2 | ;;;; | |
ef4cbc08 | 3 | ;;;; Copyright (C) 1999, 2001, 2002, 2003, 2007, 2008 Free Software Foundation, Inc. |
7337d56d LC |
4 | ;;;; Jim Blandy <jimb@red-bean.com> |
5 | ;;;; | |
6 | ;;;; This library is free software; you can redistribute it and/or | |
7 | ;;;; modify it under the terms of the GNU Lesser General Public | |
8 | ;;;; License as published by the Free Software Foundation; either | |
53befeb7 NJ |
9 | ;;;; version 3 of the License, or (at your option) any later version. |
10 | ;;;; | |
7337d56d LC |
11 | ;;;; This library is distributed in the hope that it will be useful, |
12 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
14 | ;;;; Lesser General Public License for more details. | |
53befeb7 | 15 | ;;;; |
7337d56d LC |
16 | ;;;; You should have received a copy of the GNU Lesser General Public |
17 | ;;;; License along with this library; if not, write to the Free Software | |
18 | ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA | |
19 | ||
20 | (define-module (test-suite reader) | |
21 | :use-module (test-suite lib)) | |
22 | ||
0c76ebbd | 23 | |
ef9709da | 24 | (define exception:eof |
ba1b2226 | 25 | (cons 'read-error "end of file$")) |
ef9709da | 26 | (define exception:unexpected-rparen |
ba1b2226 | 27 | (cons 'read-error "unexpected \")\"$")) |
7337d56d LC |
28 | (define exception:unterminated-block-comment |
29 | (cons 'read-error "unterminated `#! ... !#' comment$")) | |
30 | (define exception:unknown-character-name | |
31 | (cons 'read-error "unknown character name .*$")) | |
32 | (define exception:unknown-sharp-object | |
33 | (cons 'read-error "Unknown # object: .*$")) | |
34 | (define exception:eof-in-string | |
35 | (cons 'read-error "end of file in string constant$")) | |
36 | (define exception:illegal-escape | |
37 | (cons 'read-error "illegal character in escape sequence: .*$")) | |
6ed0c41a AW |
38 | (define exception:missing-expression |
39 | (cons 'read-error "no expression after #;")) | |
7337d56d | 40 | |
ef9709da | 41 | |
6b4113af DH |
42 | (define (read-string s) |
43 | (with-input-from-string s (lambda () (read)))) | |
0c76ebbd | 44 | |
7337d56d LC |
45 | (define (with-read-options opts thunk) |
46 | (let ((saved-options (read-options))) | |
47 | (dynamic-wind | |
48 | (lambda () | |
49 | (read-options opts)) | |
50 | thunk | |
51 | (lambda () | |
52 | (read-options saved-options))))) | |
53 | ||
54 | \f | |
6b4113af DH |
55 | (with-test-prefix "reading" |
56 | (pass-if "0" | |
57 | (equal? (read-string "0") 0)) | |
58 | (pass-if "1++i" | |
59 | (equal? (read-string "1++i") '1++i)) | |
60 | (pass-if "1+i+i" | |
61 | (equal? (read-string "1+i+i") '1+i+i)) | |
62 | (pass-if "1+e10000i" | |
b7d22e03 KR |
63 | (equal? (read-string "1+e10000i") '1+e10000i)) |
64 | ||
65 | ;; At one time the arg list for "Unknown # object: ~S" didn't make it out | |
66 | ;; of read.c. Check that `format' can be applied to this error. | |
67 | (pass-if "error message on bad #" | |
68 | (catch #t | |
69 | (lambda () | |
70 | (read-string "#ZZZ") | |
71 | ;; oops, this # is supposed to be unrecognised | |
72 | #f) | |
73 | (lambda (key subr message args rest) | |
74 | (apply format #f message args) | |
75 | ;; message and args are ok | |
7337d56d LC |
76 | #t))) |
77 | ||
78 | (pass-if "block comment" | |
79 | (equal? '(+ 1 2 3) | |
80 | (read-string "(+ 1 #! this is a\ncomment !# 2 3)"))) | |
06974184 | 81 | |
454866e0 LC |
82 | (pass-if "block comment finishing s-exp" |
83 | (equal? '(+ 2) | |
84 | (read-string "(+ 2 #! a comment\n!#\n) "))) | |
85 | ||
7337d56d LC |
86 | (pass-if "unprintable symbol" |
87 | ;; The reader tolerates unprintable characters for symbols. | |
88 | (equal? (string->symbol "\001\002\003") | |
d41668fa LC |
89 | (read-string "\001\002\003"))) |
90 | ||
91 | (pass-if "CR recognized as a token delimiter" | |
92 | ;; In 1.8.3, character 0x0d was not recognized as a delimiter. | |
1ffa6923 LC |
93 | (equal? (read-string "one\x0dtwo") 'one)) |
94 | ||
95 | (pass-if "returned strings are mutable" | |
96 | ;; Per R5RS Section 3.4, "Storage Model", `read' is supposed to return | |
97 | ;; mutable objects. | |
98 | (let ((str (with-input-from-string "\"hello, world\"" read))) | |
99 | (string-set! str 0 #\H) | |
100 | (string=? str "Hello, world")))) | |
7337d56d LC |
101 | |
102 | \f | |
6b4113af DH |
103 | (pass-if-exception "radix passed to number->string can't be zero" |
104 | exception:out-of-range | |
105 | (number->string 10 0)) | |
106 | (pass-if-exception "radix passed to number->string can't be one either" | |
107 | exception:out-of-range | |
108 | (number->string 10 1)) | |
ef9709da | 109 | |
7337d56d | 110 | \f |
ef9709da DH |
111 | (with-test-prefix "mismatching parentheses" |
112 | (pass-if-exception "opening parenthesis" | |
113 | exception:eof | |
114 | (read-string "(")) | |
115 | (pass-if-exception "closing parenthesis following mismatched opening" | |
116 | exception:unexpected-rparen | |
117 | (read-string ")")) | |
118 | (pass-if-exception "opening vector parenthesis" | |
119 | exception:eof | |
120 | (read-string "#(")) | |
121 | (pass-if-exception "closing parenthesis following mismatched vector opening" | |
122 | exception:unexpected-rparen | |
123 | (read-string ")"))) | |
7337d56d LC |
124 | |
125 | \f | |
126 | (with-test-prefix "exceptions" | |
127 | ||
128 | ;; Reader exceptions: although they are not documented, they may be relied | |
129 | ;; on by some programs, hence these tests. | |
130 | ||
131 | (pass-if-exception "unterminated block comment" | |
132 | exception:unterminated-block-comment | |
133 | (read-string "(+ 1 #! comment\n...")) | |
134 | (pass-if-exception "unknown character name" | |
135 | exception:unknown-character-name | |
136 | (read-string "#\\theunknowncharacter")) | |
137 | (pass-if-exception "unknown sharp object" | |
138 | exception:unknown-sharp-object | |
139 | (read-string "#?")) | |
140 | (pass-if-exception "eof in string" | |
141 | exception:eof-in-string | |
142 | (read-string "\"the string that never ends")) | |
143 | (pass-if-exception "illegal escape in string" | |
144 | exception:illegal-escape | |
145 | (read-string "\"some string \\???\""))) | |
146 | ||
147 | \f | |
148 | (with-test-prefix "read-options" | |
149 | (pass-if "case-sensitive" | |
150 | (not (eq? 'guile 'GuiLe))) | |
151 | (pass-if "case-insensitive" | |
152 | (eq? 'guile | |
153 | (with-read-options '(case-insensitive) | |
154 | (lambda () | |
155 | (read-string "GuiLe"))))) | |
156 | (pass-if "prefix keywords" | |
157 | (eq? #:keyword | |
158 | (with-read-options '(keywords prefix case-insensitive) | |
159 | (lambda () | |
160 | (read-string ":KeyWord"))))) | |
ef4cbc08 LC |
161 | (pass-if "prefix non-keywords" |
162 | (symbol? (with-read-options '(keywords prefix) | |
163 | (lambda () | |
164 | (read-string "srfi88-keyword:"))))) | |
165 | (pass-if "postfix keywords" | |
166 | (eq? #:keyword | |
167 | (with-read-options '(keywords postfix) | |
168 | (lambda () | |
169 | (read-string "keyword:"))))) | |
5d660052 MG |
170 | (pass-if "long postfix keywords" |
171 | (eq? #:keyword0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789 | |
172 | (with-read-options '(keywords postfix) | |
173 | (lambda () | |
174 | (read-string "keyword0123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789:"))))) | |
ef4cbc08 LC |
175 | (pass-if "`:' is not a postfix keyword (per SRFI-88)" |
176 | (eq? ': | |
177 | (with-read-options '(keywords postfix) | |
178 | (lambda () | |
179 | (read-string ":"))))) | |
7337d56d LC |
180 | (pass-if "no positions" |
181 | (let ((sexp (with-read-options '() | |
182 | (lambda () | |
183 | (read-string "(+ 1 2 3)"))))) | |
184 | (and (not (source-property sexp 'line)) | |
185 | (not (source-property sexp 'column))))) | |
186 | (pass-if "positions" | |
187 | (let ((sexp (with-read-options '(positions) | |
188 | (lambda () | |
189 | (read-string "(+ 1 2 3)"))))) | |
492faee1 LC |
190 | (and (equal? (source-property sexp 'line) 0) |
191 | (equal? (source-property sexp 'column) 0)))) | |
192 | (pass-if "positions on quote" | |
193 | (let ((sexp (with-read-options '(positions) | |
194 | (lambda () | |
195 | (read-string "'abcde"))))) | |
7337d56d LC |
196 | (and (equal? (source-property sexp 'line) 0) |
197 | (equal? (source-property sexp 'column) 0))))) | |
198 | ||
6ed0c41a AW |
199 | (with-test-prefix "#;" |
200 | (for-each | |
201 | (lambda (pair) | |
202 | (pass-if (car pair) | |
203 | (equal? (with-input-from-string (car pair) read) (cdr pair)))) | |
204 | ||
205 | '(("#;foo 10". 10) | |
206 | ("#;(10 20 30) foo" . foo) | |
207 | ("#; (10 20 30) foo" . foo) | |
208 | ("#;\n10\n20" . 20))) | |
209 | ||
210 | (pass-if "#;foo" | |
211 | (eof-object? (with-input-from-string "#;foo" read))) | |
212 | ||
213 | (pass-if-exception "#;" | |
214 | exception:missing-expression | |
215 | (with-input-from-string "#;" read)) | |
216 | (pass-if-exception "#;(" | |
217 | exception:eof | |
218 | (with-input-from-string "#;(" read))) | |
219 | ||
e3c5df53 AW |
220 | (with-test-prefix "#'" |
221 | (for-each | |
222 | (lambda (pair) | |
223 | (pass-if (car pair) | |
224 | (equal? (with-input-from-string (car pair) read) (cdr pair)))) | |
225 | ||
226 | '(("#'foo". (syntax foo)) | |
227 | ("#`foo" . (quasisyntax foo)) | |
228 | ("#,foo" . (unsyntax foo)) | |
229 | ("#,@foo" . (unsyntax-splicing foo))))) | |
230 | ||
231 |