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