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