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