Commit | Line | Data |
---|---|---|
de9df04a AW |
1 | ;;;; texinfo.test -*- scheme -*- |
2 | ;;;; | |
31d59769 | 3 | ;;;; Copyright (C) 2010, 2011 Free Software Foundation, Inc. |
de9df04a AW |
4 | ;;;; Copyright (C) 2001,2002 Oleg Kiselyov <oleg at pobox dot 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 | |
9 | ;;;; version 3 of the License, or (at your option) any later version. | |
10 | ;;;; | |
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. | |
15 | ;;;; | |
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 | |
500f6a47 AW |
19 | |
20 | ;;; Commentary: | |
21 | ;; | |
22 | ;; Unit tests for (sxml texinfo). Adapted from xml.ssax.scm. | |
23 | ;; | |
24 | ;;; Code: | |
25 | ||
26 | (define-module (test-suite texinfo) | |
27 | #:use-module (test-suite lib) | |
28 | #:use-module (texinfo)) | |
29 | ||
30 | (define exception:eof-while-reading-token | |
31 | '(parser-error . "^EOF while reading a token")) | |
32 | (define exception:wrong-character | |
33 | '(parser-error . "^Wrong character")) | |
34 | (define exception:eof-while-reading-char-data | |
35 | '(parser-error . "^EOF while reading char data")) | |
36 | (define exception:no-settitle | |
37 | '(parser-error . "^No \\\\n@settitle found")) | |
38 | (define exception:unexpected-arg | |
39 | '(parser-error . "^@-command didn't expect more arguments")) | |
40 | (define exception:bad-enumerate | |
41 | '(parser-error . "^Invalid")) | |
42 | ||
43 | (define nl (string #\newline)) | |
44 | ||
45 | (define texinfo:read-verbatim-body | |
46 | (@@ (texinfo) read-verbatim-body)) | |
47 | (with-test-prefix "test-read-verbatim-body" | |
48 | (define (read-verbatim-body-from-string str) | |
49 | (define (consumer fragment foll-fragment seed) | |
50 | (cons* (if (equal? foll-fragment (string #\newline)) | |
51 | (string-append " NL" nl) | |
52 | foll-fragment) | |
53 | fragment seed)) | |
54 | (reverse | |
55 | (call-with-input-string | |
56 | str | |
57 | (lambda (port) (texinfo:read-verbatim-body port consumer '()))))) | |
58 | ||
59 | (pass-if (equal? '() | |
60 | (read-verbatim-body-from-string "@end verbatim\n"))) | |
61 | ||
62 | ;; after @verbatim, the current position will always directly after | |
63 | ;; the newline. | |
64 | (pass-if-exception "@end verbatim needs a newline" | |
65 | exception:eof-while-reading-token | |
66 | (read-verbatim-body-from-string "@end verbatim")) | |
67 | ||
68 | (pass-if (equal? '("@@end verbatim" " NL\n") | |
69 | (read-verbatim-body-from-string "@@end verbatim\n@end verbatim\n"))) | |
70 | ||
71 | (pass-if (equal? '("@@@@faosfasf adsfas " " NL\n" " asf @foo{asdf}" " NL\n") | |
72 | (read-verbatim-body-from-string | |
73 | "@@@@faosfasf adsfas \n asf @foo{asdf}\n@end verbatim\n"))) | |
74 | ||
75 | (pass-if (equal? '("@end verbatim " " NL\n") | |
76 | (read-verbatim-body-from-string "@end verbatim \n@end verbatim\n")))) | |
77 | ||
78 | (define texinfo:read-arguments | |
79 | (@@ (texinfo) read-arguments)) | |
80 | (with-test-prefix "test-read-arguments" | |
81 | (define (read-arguments-from-string str) | |
82 | (call-with-input-string | |
83 | str | |
84 | (lambda (port) (texinfo:read-arguments port #\})))) | |
85 | ||
86 | (define (test str expected-res) | |
87 | (pass-if (equal? expected-res | |
88 | (read-arguments-from-string str)))) | |
89 | ||
90 | (test "}" '()) | |
91 | (test "foo}" '("foo")) | |
92 | (test "foo,bar}" '("foo" "bar")) | |
93 | (test " foo , bar }" '("foo" "bar")) | |
94 | (test " foo , , bar }" '("foo" #f "bar")) | |
95 | (test "foo,,bar}" '("foo" #f "bar")) | |
96 | (pass-if-exception "need a } when reading arguments" | |
97 | exception:eof-while-reading-token | |
98 | (call-with-input-string | |
99 | "foo,,bar" | |
100 | (lambda (port) (texinfo:read-arguments port #\}))))) | |
101 | ||
102 | (define texinfo:complete-start-command | |
103 | (@@ (texinfo) complete-start-command)) | |
104 | (with-test-prefix "test-complete-start-command" | |
105 | (define (test command str) | |
106 | (call-with-input-string | |
107 | str | |
108 | (lambda (port) | |
109 | (call-with-values | |
110 | (lambda () | |
111 | (texinfo:complete-start-command command port)) | |
112 | list)))) | |
113 | ||
114 | (pass-if (equal? '(section () EOL-TEXT) | |
115 | (test 'section "foo bar baz bonzerts"))) | |
116 | (pass-if (equal? '(deffnx ((category "Function") (name "foo") (arguments)) EOL-TEXT-ARGS) | |
117 | (test 'deffnx "Function foo"))) | |
118 | (pass-if-exception "@emph missing a start brace" | |
119 | exception:wrong-character | |
120 | (test 'emph "no brace here")) | |
121 | (pass-if (equal? '(emph () INLINE-TEXT) | |
122 | (test 'emph "{foo bar baz bonzerts"))) | |
123 | (pass-if (equal? '(ref ((node "foo bar") (section "baz") (info-file "bonzerts")) | |
124 | INLINE-ARGS) | |
125 | (test 'ref "{ foo bar ,, baz, bonzerts}"))) | |
126 | (pass-if (equal? '(node ((name "referenced node")) EOL-ARGS) | |
127 | (test 'node " referenced node\n")))) | |
128 | ||
129 | (define texinfo:read-char-data | |
130 | (@@ (texinfo) read-char-data)) | |
131 | (define make-texinfo-token cons) | |
132 | (with-test-prefix "test-read-char-data" | |
133 | (let* ((code (make-texinfo-token 'START 'code)) | |
134 | (ref (make-texinfo-token 'EMPTY 'ref)) | |
135 | (title (make-texinfo-token 'LINE 'title)) | |
136 | (node (make-texinfo-token 'EMPTY 'node)) | |
137 | (eof-object (with-input-from-string "" read)) | |
138 | (str-handler (lambda (fragment foll-fragment seed) | |
139 | (if (string-null? foll-fragment) | |
140 | (cons fragment seed) | |
141 | (cons* foll-fragment fragment seed))))) | |
142 | (define (test str expect-eof? preserve-ws? expected-data expected-token) | |
143 | (call-with-values | |
144 | (lambda () | |
145 | (call-with-input-string | |
146 | str | |
147 | (lambda (port) | |
148 | (texinfo:read-char-data | |
149 | port expect-eof? preserve-ws? str-handler '())))) | |
150 | (lambda (seed token) | |
151 | (let ((result (reverse seed))) | |
152 | (pass-if (equal? expected-data result)) | |
153 | (pass-if (equal? expected-token token)))))) | |
154 | ||
155 | ;; add some newline-related tests here | |
156 | (test "" #t #f '() eof-object) | |
157 | (test "foo bar baz" #t #f '("foo bar baz") eof-object) | |
158 | (pass-if-exception "eof reading char data" | |
159 | exception:eof-while-reading-token | |
160 | (test "" #f #f '() eof-object)) | |
161 | (test " " #t #f '(" ") eof-object) | |
162 | (test " @code{foo} " #f #f '(" ") code) | |
163 | (test " @code" #f #f '(" ") code) | |
164 | (test " {text here} asda" #f #f '(" ") (make-texinfo-token 'START '*braces*)) | |
165 | (test " blah blah} asda" #f #f '(" blah blah") (make-texinfo-token 'END #f)))) | |
166 | ||
167 | ||
168 | (with-test-prefix "test-texinfo->stexinfo" | |
169 | (define (test str expected-res) | |
170 | (pass-if (equal? expected-res | |
171 | (call-with-input-string str texi->stexi)))) | |
172 | (define (try-with-title title str) | |
173 | (call-with-input-string | |
174 | (string-append "foo bar baz\n@settitle " title "\n" str) | |
175 | texi->stexi)) | |
176 | (define (test-with-title title str expected-res) | |
177 | (test (string-append "foo bar baz\n@settitle " title "\n" str) | |
178 | expected-res)) | |
179 | (define (test-body str expected-res) | |
180 | (pass-if (equal? expected-res | |
181 | (cddr (try-with-title "zog" str))))) | |
182 | ||
183 | (define (list-intersperse src-l elem) | |
184 | (if (null? src-l) src-l | |
185 | (let loop ((l (cdr src-l)) (dest (cons (car src-l) '()))) | |
186 | (if (null? l) (reverse dest) | |
187 | (loop (cdr l) (cons (car l) (cons elem dest))))))) | |
188 | (define (join-lines . lines) | |
189 | (apply string-append (list-intersperse lines "\n"))) | |
190 | ||
191 | (pass-if-exception "missing @settitle" | |
192 | exception:no-settitle | |
193 | (call-with-input-string "@dots{}\n" texi->stexi)) | |
194 | ||
195 | (test "\\input texinfo\n@settitle my title\n@dots{}\n" | |
196 | '(texinfo (% (title "my title")) (para (dots)))) | |
197 | (test-with-title "my title" "@dots{}\n" | |
198 | '(texinfo (% (title "my title")) (para (dots)))) | |
199 | (test-with-title "my title" "@dots{}" | |
200 | '(texinfo (% (title "my title")) (para (dots)))) | |
201 | ||
202 | (pass-if-exception "arg to @dots{}" | |
203 | exception:unexpected-arg | |
204 | (call-with-input-string | |
205 | "foo bar baz\n@settitle my title\n@dots{arg}" | |
206 | texi->stexi)) | |
207 | ||
208 | (test-body "@code{arg}" | |
209 | '((para (code "arg")))) | |
31d59769 AW |
210 | ;; FIXME: Why no enclosing para here? Probably a bug. |
211 | (test-body "@url{arg}" | |
212 | '((uref (% (url "arg"))))) | |
500f6a47 AW |
213 | (test-body "@code{ }" |
214 | '((para (code)))) | |
215 | (test-body "@code{ @code{} }" | |
216 | '((para (code (code))))) | |
217 | (test-body "@code{ abc @code{} }" | |
218 | '((para (code "abc " (code))))) | |
219 | (test-body "@code{ arg }" | |
220 | '((para (code "arg")))) | |
221 | (test-body "@example\n foo asdf asd sadf asd \n@end example\n" | |
222 | '((example " foo asdf asd sadf asd "))) | |
223 | (test-body (join-lines | |
224 | "@quotation" | |
225 | "@example" | |
226 | " foo asdf asd sadf asd " | |
227 | "@end example" | |
228 | "@end quotation" | |
229 | "") | |
230 | '((quotation (example " foo asdf asd sadf asd ")))) | |
231 | (test-body (join-lines | |
232 | "@quotation" | |
233 | "@example" | |
234 | " foo asdf @var{asd} sadf asd " | |
235 | "@end example" | |
236 | "@end quotation" | |
237 | "") | |
238 | '((quotation (example " foo asdf " (var "asd") " sadf asd ")))) | |
239 | (test-body (join-lines | |
240 | "@quotation" | |
241 | "@example" | |
242 | " foo asdf @var{asd} sadf asd " | |
243 | "" | |
244 | "not in new para, this is an example" | |
245 | "@end example" | |
246 | "@end quotation" | |
247 | "") | |
248 | '((quotation | |
249 | (example | |
250 | " foo asdf " (var "asd") | |
251 | " sadf asd \n\nnot in new para, this is an example")))) | |
252 | (test-body (join-lines | |
253 | "@titlepage" | |
254 | "@quotation" | |
255 | " foo asdf @var{asd} sadf asd " | |
256 | "" | |
257 | "should be in new para" | |
258 | "@end quotation" | |
259 | "@end titlepage" | |
260 | "") | |
261 | '((titlepage | |
262 | (quotation (para "foo asdf " (var "asd") " sadf asd") | |
263 | (para "should be in new para"))))) | |
264 | (test-body (join-lines | |
265 | "" | |
266 | "@titlepage" | |
267 | "" | |
268 | "@quotation" | |
269 | " foo asdf @var{asd} sadf asd " | |
270 | "" | |
271 | "should be in new para" | |
272 | "" | |
273 | "" | |
274 | "@end quotation" | |
275 | "@end titlepage" | |
276 | "" | |
277 | "@bye" | |
278 | "" | |
279 | "@foo random crap at the end" | |
280 | "") | |
281 | '((titlepage | |
282 | (quotation (para "foo asdf " (var "asd") " sadf asd") | |
283 | (para "should be in new para"))))) | |
284 | (test-body (join-lines | |
285 | "" | |
286 | "random notes" | |
287 | "@quotation" | |
288 | " foo asdf @var{asd} sadf asd " | |
289 | "" | |
290 | "should be in new para" | |
291 | "" | |
292 | "" | |
293 | "@end quotation" | |
294 | "" | |
295 | " hi mom" | |
296 | "") | |
297 | '((para "random notes") | |
298 | (quotation (para "foo asdf " (var "asd") " sadf asd") | |
299 | (para "should be in new para")) | |
300 | (para "hi mom"))) | |
301 | (test-body (join-lines | |
302 | "@enumerate" | |
303 | "@item one" | |
304 | "@item two" | |
305 | "@item three" | |
306 | "@end enumerate" | |
307 | ) | |
308 | '((enumerate (item (para "one")) | |
309 | (item (para "two")) | |
310 | (item (para "three"))))) | |
311 | (test-body (join-lines | |
312 | "@enumerate 44" | |
313 | "@item one" | |
314 | "@item two" | |
315 | "@item three" | |
316 | "@end enumerate" | |
317 | ) | |
318 | '((enumerate (% (start "44")) | |
319 | (item (para "one")) | |
320 | (item (para "two")) | |
321 | (item (para "three"))))) | |
322 | (pass-if-exception "bad enumerate formatter" | |
323 | exception:bad-enumerate | |
324 | (try-with-title "foo" (join-lines | |
325 | "@enumerate string" | |
326 | "@item one" | |
327 | "@item two" | |
328 | "@item three" | |
329 | "@end enumerate" | |
330 | ))) | |
331 | (pass-if-exception "bad itemize formatter" | |
332 | exception:bad-enumerate | |
333 | (try-with-title "foo" (join-lines | |
334 | "@itemize string" | |
335 | "@item one" | |
336 | "@item two" | |
337 | "@item three" | |
338 | "@end itemize" | |
339 | ))) | |
340 | (test-body (join-lines | |
341 | "@itemize" ;; no formatter, should default to bullet | |
342 | "@item one" | |
343 | "@item two" | |
344 | "@item three" | |
345 | "@end itemize" | |
346 | ) | |
347 | '((itemize (% (bullet (bullet))) | |
348 | (item (para "one")) | |
349 | (item (para "two")) | |
350 | (item (para "three"))))) | |
351 | (test-body (join-lines | |
352 | "@itemize @bullet" | |
353 | "@item one" | |
354 | "@item two" | |
355 | "@item three" | |
356 | "@end itemize" | |
357 | ) | |
358 | '((itemize (% (bullet (bullet))) | |
359 | (item (para "one")) | |
360 | (item (para "two")) | |
361 | (item (para "three"))))) | |
362 | (test-body (join-lines | |
363 | "@itemize -" | |
364 | "@item one" | |
365 | "@item two" | |
366 | "@item three" | |
367 | "@end itemize" | |
368 | ) | |
369 | '((itemize (% (bullet "-")) | |
370 | (item (para "one")) | |
371 | (item (para "two")) | |
372 | (item (para "three"))))) | |
373 | (test-body (join-lines | |
374 | "@table @code" | |
375 | "preliminary text -- should go in a pre-item para" | |
376 | "@item one" | |
377 | "item one text" | |
378 | "@item two" | |
379 | "item two text" | |
380 | "" | |
381 | "includes a paragraph" | |
382 | "@item three" | |
383 | "@end itemize" | |
384 | ) | |
385 | '((table (% (formatter (code))) | |
386 | (para "preliminary text -- should go in a pre-item para") | |
387 | (entry (% (heading "one")) | |
388 | (para "item one text")) | |
389 | (entry (% (heading "two")) | |
390 | (para "item two text") | |
391 | (para "includes a paragraph")) | |
392 | (entry (% (heading "three")))))) | |
393 | (test-body (join-lines | |
394 | "@chapter @code{foo} bar" | |
395 | "text that should be in a para" | |
396 | ) | |
397 | '((chapter (code "foo") " bar") | |
398 | (para "text that should be in a para"))) | |
399 | (test-body (join-lines | |
400 | "@deffnx Method foo bar @code{baz}" | |
401 | "text that should be in a para" | |
402 | ) | |
403 | '((deffnx (% (category "Method") | |
404 | (name "foo") | |
405 | (arguments "bar " (code "baz")))) | |
406 | (para "text that should be in a para"))) | |
407 | ) |