Commit | Line | Data |
---|---|---|
de9df04a AW |
1 | ;;;; texinfo.test -*- scheme -*- |
2 | ;;;; | |
c52ce75a | 3 | ;;;; Copyright (C) 2010, 2011, 2012, 2013 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 | ||
c52ce75a LC |
59 | (pass-if-equal '() |
60 | (read-verbatim-body-from-string "@end verbatim\n")) | |
500f6a47 AW |
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")) | |
500f6a47 | 67 | |
c52ce75a LC |
68 | (pass-if-equal '("@@end verbatim" " NL\n") |
69 | (read-verbatim-body-from-string "@@end verbatim\n@end verbatim\n")) | |
500f6a47 | 70 | |
c52ce75a LC |
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"))) | |
500f6a47 AW |
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) | |
c52ce75a LC |
87 | (pass-if-equal expected-res |
88 | (read-arguments-from-string str))) | |
500f6a47 AW |
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 | ||
c52ce75a LC |
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")) | |
500f6a47 AW |
118 | (pass-if-exception "@emph missing a start brace" |
119 | exception:wrong-character | |
120 | (test 'emph "no brace here")) | |
c52ce75a LC |
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"))) | |
500f6a47 AW |
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))) | |
c52ce75a LC |
152 | (pass-if-equal expected-data result) |
153 | (pass-if-equal expected-token token))))) | |
500f6a47 AW |
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) | |
c52ce75a LC |
170 | (pass-if-equal expected-res |
171 | (call-with-input-string str texi->stexi))) | |
500f6a47 AW |
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) | |
c52ce75a LC |
180 | (pass-if-equal str expected-res |
181 | (cddr (try-with-title "zog" str)))) | |
500f6a47 AW |
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 | 210 | (test-body "@url{arg}" |
fd99e505 | 211 | '((para (uref (% (url "arg")))))) |
500f6a47 AW |
212 | (test-body "@code{ }" |
213 | '((para (code)))) | |
214 | (test-body "@code{ @code{} }" | |
215 | '((para (code (code))))) | |
216 | (test-body "@code{ abc @code{} }" | |
217 | '((para (code "abc " (code))))) | |
218 | (test-body "@code{ arg }" | |
219 | '((para (code "arg")))) | |
be52f329 AW |
220 | |
221 | (test-body "@acronym{GNU}" | |
222 | '((para (acronym (% (acronym "GNU")))))) | |
223 | ||
224 | (test-body "@acronym{GNU, not unix}" | |
225 | '((para (acronym (% (acronym "GNU") | |
226 | (meaning "not unix")))))) | |
227 | ||
228 | (test-body "@acronym{GNU, @acronym{GNU}'s Not Unix}" | |
229 | '((para (acronym (% (acronym "GNU") | |
230 | (meaning (acronym (% (acronym "GNU"))) | |
231 | "'s Not Unix")))))) | |
232 | ||
500f6a47 AW |
233 | (test-body "@example\n foo asdf asd sadf asd \n@end example\n" |
234 | '((example " foo asdf asd sadf asd "))) | |
235 | (test-body (join-lines | |
236 | "@quotation" | |
237 | "@example" | |
238 | " foo asdf asd sadf asd " | |
239 | "@end example" | |
240 | "@end quotation" | |
241 | "") | |
242 | '((quotation (example " foo asdf asd sadf asd ")))) | |
243 | (test-body (join-lines | |
244 | "@quotation" | |
245 | "@example" | |
246 | " foo asdf @var{asd} sadf asd " | |
247 | "@end example" | |
248 | "@end quotation" | |
249 | "") | |
250 | '((quotation (example " foo asdf " (var "asd") " sadf asd ")))) | |
251 | (test-body (join-lines | |
252 | "@quotation" | |
253 | "@example" | |
254 | " foo asdf @var{asd} sadf asd " | |
255 | "" | |
256 | "not in new para, this is an example" | |
257 | "@end example" | |
258 | "@end quotation" | |
259 | "") | |
260 | '((quotation | |
261 | (example | |
262 | " foo asdf " (var "asd") | |
263 | " sadf asd \n\nnot in new para, this is an example")))) | |
264 | (test-body (join-lines | |
265 | "@titlepage" | |
266 | "@quotation" | |
267 | " foo asdf @var{asd} sadf asd " | |
268 | "" | |
269 | "should be in new para" | |
270 | "@end quotation" | |
271 | "@end titlepage" | |
272 | "") | |
273 | '((titlepage | |
274 | (quotation (para "foo asdf " (var "asd") " sadf asd") | |
275 | (para "should be in new para"))))) | |
276 | (test-body (join-lines | |
277 | "" | |
278 | "@titlepage" | |
279 | "" | |
280 | "@quotation" | |
281 | " foo asdf @var{asd} sadf asd " | |
282 | "" | |
283 | "should be in new para" | |
284 | "" | |
285 | "" | |
286 | "@end quotation" | |
287 | "@end titlepage" | |
288 | "" | |
289 | "@bye" | |
290 | "" | |
291 | "@foo random crap at the end" | |
292 | "") | |
293 | '((titlepage | |
294 | (quotation (para "foo asdf " (var "asd") " sadf asd") | |
295 | (para "should be in new para"))))) | |
296 | (test-body (join-lines | |
297 | "" | |
298 | "random notes" | |
299 | "@quotation" | |
300 | " foo asdf @var{asd} sadf asd " | |
301 | "" | |
302 | "should be in new para" | |
303 | "" | |
304 | "" | |
305 | "@end quotation" | |
306 | "" | |
307 | " hi mom" | |
308 | "") | |
309 | '((para "random notes") | |
310 | (quotation (para "foo asdf " (var "asd") " sadf asd") | |
311 | (para "should be in new para")) | |
312 | (para "hi mom"))) | |
313 | (test-body (join-lines | |
314 | "@enumerate" | |
315 | "@item one" | |
316 | "@item two" | |
317 | "@item three" | |
318 | "@end enumerate" | |
319 | ) | |
320 | '((enumerate (item (para "one")) | |
321 | (item (para "two")) | |
322 | (item (para "three"))))) | |
323 | (test-body (join-lines | |
324 | "@enumerate 44" | |
325 | "@item one" | |
326 | "@item two" | |
327 | "@item three" | |
328 | "@end enumerate" | |
329 | ) | |
330 | '((enumerate (% (start "44")) | |
331 | (item (para "one")) | |
332 | (item (para "two")) | |
333 | (item (para "three"))))) | |
334 | (pass-if-exception "bad enumerate formatter" | |
335 | exception:bad-enumerate | |
336 | (try-with-title "foo" (join-lines | |
337 | "@enumerate string" | |
338 | "@item one" | |
339 | "@item two" | |
340 | "@item three" | |
341 | "@end enumerate" | |
342 | ))) | |
343 | (pass-if-exception "bad itemize formatter" | |
344 | exception:bad-enumerate | |
345 | (try-with-title "foo" (join-lines | |
346 | "@itemize string" | |
347 | "@item one" | |
348 | "@item two" | |
349 | "@item three" | |
350 | "@end itemize" | |
351 | ))) | |
352 | (test-body (join-lines | |
353 | "@itemize" ;; no formatter, should default to bullet | |
354 | "@item one" | |
355 | "@item two" | |
356 | "@item three" | |
357 | "@end itemize" | |
358 | ) | |
359 | '((itemize (% (bullet (bullet))) | |
360 | (item (para "one")) | |
361 | (item (para "two")) | |
362 | (item (para "three"))))) | |
363 | (test-body (join-lines | |
364 | "@itemize @bullet" | |
365 | "@item one" | |
366 | "@item two" | |
367 | "@item three" | |
368 | "@end itemize" | |
369 | ) | |
370 | '((itemize (% (bullet (bullet))) | |
371 | (item (para "one")) | |
372 | (item (para "two")) | |
373 | (item (para "three"))))) | |
374 | (test-body (join-lines | |
375 | "@itemize -" | |
376 | "@item one" | |
377 | "@item two" | |
378 | "@item three" | |
379 | "@end itemize" | |
380 | ) | |
381 | '((itemize (% (bullet "-")) | |
382 | (item (para "one")) | |
383 | (item (para "two")) | |
384 | (item (para "three"))))) | |
385 | (test-body (join-lines | |
386 | "@table @code" | |
387 | "preliminary text -- should go in a pre-item para" | |
388 | "@item one" | |
389 | "item one text" | |
390 | "@item two" | |
391 | "item two text" | |
392 | "" | |
393 | "includes a paragraph" | |
394 | "@item three" | |
395 | "@end itemize" | |
396 | ) | |
397 | '((table (% (formatter (code))) | |
398 | (para "preliminary text -- should go in a pre-item para") | |
399 | (entry (% (heading "one")) | |
400 | (para "item one text")) | |
401 | (entry (% (heading "two")) | |
402 | (para "item two text") | |
403 | (para "includes a paragraph")) | |
404 | (entry (% (heading "three")))))) | |
405 | (test-body (join-lines | |
406 | "@chapter @code{foo} bar" | |
407 | "text that should be in a para" | |
408 | ) | |
409 | '((chapter (code "foo") " bar") | |
410 | (para "text that should be in a para"))) | |
411 | (test-body (join-lines | |
412 | "@deffnx Method foo bar @code{baz}" | |
413 | "text that should be in a para" | |
414 | ) | |
415 | '((deffnx (% (category "Method") | |
416 | (name "foo") | |
417 | (arguments "bar " (code "baz")))) | |
418 | (para "text that should be in a para"))) | |
797b2aa6 LC |
419 | (test-body "@pxref{Locales, @code{setlocale}}" |
420 | '((para (pxref (% (node "Locales") | |
421 | (name (code "setlocale"))))))) | |
500f6a47 | 422 | ) |