test-suite/tests/texinfo.test

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