1 ;;;; texinfo.test -*- scheme -*-
3 ;;;; Copyright (C) 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
4 ;;;; Copyright (C) 2001,2002 Oleg Kiselyov <oleg at pobox dot com>
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.
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.
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
22 ;; Unit tests for (sxml texinfo). Adapted from xml.ssax.scm.
26 (define-module (test-suite texinfo)
27 #:use-module (test-suite lib)
28 #:use-module (texinfo))
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"))
43 (define nl (string #\newline))
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)
55 (call-with-input-string
57 (lambda (port) (texinfo:read-verbatim-body port consumer '())))))
60 (read-verbatim-body-from-string "@end verbatim\n"))
62 ;; after @verbatim, the current position will always directly after
64 (pass-if-exception "@end verbatim needs a newline"
65 exception:eof-while-reading-token
66 (read-verbatim-body-from-string "@end verbatim"))
68 (pass-if-equal '("@@end verbatim" " NL\n")
69 (read-verbatim-body-from-string "@@end verbatim\n@end verbatim\n"))
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"))
75 (pass-if-equal '("@end verbatim " " NL\n")
76 (read-verbatim-body-from-string "@end verbatim \n@end verbatim\n")))
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
84 (lambda (port) (texinfo:read-arguments port #\}))))
86 (define (test str expected-res)
87 (pass-if-equal expected-res
88 (read-arguments-from-string str)))
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
100 (lambda (port) (texinfo:read-arguments port #\})))))
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
111 (texinfo:complete-start-command command port))
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"))
125 (test 'ref "{ foo bar ,, baz, bonzerts}"))
126 (pass-if-equal '(node ((name "referenced node")) EOL-ARGS)
127 (test 'node " referenced node\n")))
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)
141 (cons* foll-fragment fragment seed)))))
142 (define (test str expect-eof? preserve-ws? expected-data expected-token)
145 (call-with-input-string
148 (texinfo:read-char-data
149 port expect-eof? preserve-ws? str-handler '()))))
151 (let ((result (reverse seed)))
152 (pass-if-equal expected-data result)
153 (pass-if-equal expected-token token)))))
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))))
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)
176 (define (test-with-title title str expected-res)
177 (test (string-append "foo bar baz\n@settitle " title "\n" str)
179 (define (test-body str expected-res)
180 (pass-if-equal str expected-res
181 (cddr (try-with-title "zog" str))))
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")))
191 (pass-if-exception "missing @settitle"
192 exception:no-settitle
193 (call-with-input-string "@dots{}\n" texi->stexi))
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))))
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}"
208 (test-body "@code{arg}"
209 '((para (code "arg"))))
210 (test-body "@url{arg}"
211 '((para (uref (% (url "arg"))))))
212 (test-body "@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"))))
221 (test-body "@acronym{GNU}"
222 '((para (acronym (% (acronym "GNU"))))))
224 (test-body "@acronym{GNU, not unix}"
225 '((para (acronym (% (acronym "GNU")
226 (meaning "not unix"))))))
228 (test-body "@acronym{GNU, @acronym{GNU}'s Not Unix}"
229 '((para (acronym (% (acronym "GNU")
230 (meaning (acronym (% (acronym "GNU")))
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
238 " foo asdf asd sadf asd "
242 '((quotation (example " foo asdf asd sadf asd "))))
243 (test-body (join-lines
246 " foo asdf @var{asd} sadf asd "
250 '((quotation (example " foo asdf " (var "asd") " sadf asd "))))
251 (test-body (join-lines
254 " foo asdf @var{asd} sadf asd "
256 "not in new para, this is an example"
262 " foo asdf " (var "asd")
263 " sadf asd \n\nnot in new para, this is an example"))))
264 (test-body (join-lines
267 " foo asdf @var{asd} sadf asd "
269 "should be in new para"
274 (quotation (para "foo asdf " (var "asd") " sadf asd")
275 (para "should be in new para")))))
276 (test-body (join-lines
281 " foo asdf @var{asd} sadf asd "
283 "should be in new para"
291 "@foo random crap at the end"
294 (quotation (para "foo asdf " (var "asd") " sadf asd")
295 (para "should be in new para")))))
296 (test-body (join-lines
300 " foo asdf @var{asd} sadf asd "
302 "should be in new para"
309 '((para "random notes")
310 (quotation (para "foo asdf " (var "asd") " sadf asd")
311 (para "should be in new para"))
313 (test-body (join-lines
320 '((enumerate (item (para "one"))
322 (item (para "three")))))
323 (test-body (join-lines
330 '((enumerate (% (start "44"))
333 (item (para "three")))))
334 (pass-if-exception "bad enumerate formatter"
335 exception:bad-enumerate
336 (try-with-title "foo" (join-lines
343 (pass-if-exception "bad itemize formatter"
344 exception:bad-enumerate
345 (try-with-title "foo" (join-lines
352 (test-body (join-lines
353 "@itemize" ;; no formatter, should default to bullet
359 '((itemize (% (bullet (bullet)))
362 (item (para "three")))))
363 (test-body (join-lines
370 '((itemize (% (bullet (bullet)))
373 (item (para "three")))))
374 (test-body (join-lines
381 '((itemize (% (bullet "-"))
384 (item (para "three")))))
385 (test-body (join-lines
387 "preliminary text -- should go in a pre-item para"
393 "includes a paragraph"
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"
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"
415 '((deffnx (% (category "Method")
417 (arguments "bar " (code "baz"))))
418 (para "text that should be in a para")))