test-suite/tests/texinfo.test

   1 ;; -*- scheme -*-
   2 ;; guile-lib
   3 ;; Copyright (C) 2004, 2009 Andy Wingo <wingo at pobox dot com>
   4 ;; Copyright (C) 2001,2002 Oleg Kiselyov <oleg at pobox dot com>
   5
   6 ;; This program is free software; you can redistribute it and/or
   7 ;; modify it under the terms of the GNU General Public License as
   8 ;; published by the Free Software Foundation; either version 2 of
   9 ;; the License, or (at your option) any later version.
  10 ;;
  11 ;; This program 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
  14 ;; GNU General Public License for more details.
  15 ;;
  16 ;; You should have received a copy of the GNU General Public License
  17 ;; along with this program; if not, contact:
  18 ;;
  19 ;; Free Software Foundation           Voice:  +1-617-542-5942
  20 ;; 59 Temple Place - Suite 330        Fax:    +1-617-542-2652
  21 ;; Boston, MA  02111-1307,  USA       gnu@gnu.org
  22
  23 ;;; Commentary:
  24 ;;
  25 ;; Unit tests for (sxml texinfo). Adapted from xml.ssax.scm.
  26 ;;
  27 ;;; Code:
  28
  29 (define-module (test-suite texinfo)
  30   #:use-module (test-suite lib)
  31   #:use-module (texinfo))
  32
  33 (define exception:eof-while-reading-token
  34   '(parser-error . "^EOF while reading a token"))
  35 (define exception:wrong-character
  36   '(parser-error . "^Wrong character"))
  37 (define exception:eof-while-reading-char-data
  38   '(parser-error . "^EOF while reading char data"))
  39 (define exception:no-settitle
  40   '(parser-error . "^No \\\\n@settitle  found"))
  41 (define exception:unexpected-arg
  42   '(parser-error . "^@-command didn't expect more arguments"))
  43 (define exception:bad-enumerate
  44   '(parser-error . "^Invalid"))
  45
  46 (define nl (string #\newline))
  47
  48 (define texinfo:read-verbatim-body
  49   (@@ (texinfo) read-verbatim-body))
  50 (with-test-prefix "test-read-verbatim-body"
  51   (define (read-verbatim-body-from-string str)
  52     (define (consumer fragment foll-fragment seed)
  53       (cons* (if (equal? foll-fragment (string #\newline))
  54                  (string-append " NL" nl)
  55                  foll-fragment)
  56              fragment seed))
  57     (reverse
  58      (call-with-input-string
  59       str
  60       (lambda (port) (texinfo:read-verbatim-body port consumer '())))))
  61
  62   (pass-if (equal? '()
  63                    (read-verbatim-body-from-string "@end verbatim\n")))
  64
  65   ;; after @verbatim, the current position will always directly after
  66   ;; the newline.
  67   (pass-if-exception "@end verbatim needs a newline"
  68                      exception:eof-while-reading-token
  69                      (read-verbatim-body-from-string "@end verbatim"))
  70
  71   (pass-if (equal? '("@@end verbatim" " NL\n")
  72                    (read-verbatim-body-from-string "@@end verbatim\n@end verbatim\n")))
  73
  74   (pass-if (equal? '("@@@@faosfasf adsfas " " NL\n" " asf @foo{asdf}" " NL\n")
  75                    (read-verbatim-body-from-string
  76                     "@@@@faosfasf adsfas \n asf @foo{asdf}\n@end verbatim\n")))
  77
  78   (pass-if (equal? '("@end verbatim " " NL\n")
  79                    (read-verbatim-body-from-string "@end verbatim \n@end verbatim\n"))))
  80
  81 (define texinfo:read-arguments
  82   (@@ (texinfo) read-arguments))
  83 (with-test-prefix "test-read-arguments"
  84   (define (read-arguments-from-string str)
  85     (call-with-input-string
  86      str
  87      (lambda (port) (texinfo:read-arguments port #\}))))
  88
  89   (define (test str expected-res)
  90     (pass-if (equal? expected-res
  91                      (read-arguments-from-string str))))
  92
  93   (test "}" '())
  94   (test "foo}" '("foo"))
  95   (test "foo,bar}" '("foo" "bar"))
  96   (test "    foo     ,    bar  }" '("foo" "bar"))
  97   (test " foo ,   , bar }" '("foo" #f "bar"))
  98   (test "foo,,bar}" '("foo" #f "bar"))
  99   (pass-if-exception "need a } when reading arguments"
 100                      exception:eof-while-reading-token
 101                      (call-with-input-string
 102                       "foo,,bar"
 103                       (lambda (port) (texinfo:read-arguments port #\})))))
 104
 105 (define texinfo:complete-start-command
 106   (@@ (texinfo) complete-start-command))
 107 (with-test-prefix "test-complete-start-command"
 108   (define (test command str)
 109     (call-with-input-string
 110      str
 111      (lambda (port)
 112        (call-with-values
 113            (lambda ()
 114              (texinfo:complete-start-command command port))
 115          list))))
 116
 117   (pass-if (equal? '(section () EOL-TEXT)
 118                    (test 'section "foo bar baz bonzerts")))
 119   (pass-if (equal? '(deffnx ((category "Function") (name "foo") (arguments)) EOL-TEXT-ARGS)
 120                    (test 'deffnx "Function foo")))
 121   (pass-if-exception "@emph missing a start brace"
 122                      exception:wrong-character
 123                      (test 'emph "no brace here"))
 124   (pass-if (equal? '(emph () INLINE-TEXT)
 125                    (test 'emph "{foo bar baz bonzerts")))
 126   (pass-if (equal? '(ref ((node "foo bar") (section "baz") (info-file "bonzerts"))
 127                          INLINE-ARGS)
 128                    (test 'ref "{ foo bar ,,  baz, bonzerts}")))
 129   (pass-if (equal? '(node ((name "referenced node")) EOL-ARGS)
 130                    (test 'node " referenced node\n"))))
 131
 132 (define texinfo:read-char-data
 133   (@@ (texinfo) read-char-data))
 134 (define make-texinfo-token cons)
 135 (with-test-prefix "test-read-char-data"
 136   (let* ((code (make-texinfo-token 'START 'code))
 137          (ref (make-texinfo-token 'EMPTY 'ref))
 138          (title (make-texinfo-token 'LINE 'title))
 139          (node (make-texinfo-token 'EMPTY 'node))
 140          (eof-object (with-input-from-string "" read))
 141          (str-handler (lambda (fragment foll-fragment seed)
 142                         (if (string-null? foll-fragment)
 143                             (cons fragment seed)
 144                             (cons* foll-fragment fragment seed)))))
 145     (define (test str expect-eof? preserve-ws? expected-data expected-token)
 146       (call-with-values
 147           (lambda ()
 148             (call-with-input-string
 149              str
 150              (lambda (port)
 151                (texinfo:read-char-data
 152                 port expect-eof? preserve-ws? str-handler '()))))
 153         (lambda (seed token)
 154           (let ((result (reverse seed)))
 155             (pass-if (equal? expected-data result))
 156             (pass-if (equal? expected-token token))))))
 157
 158     ;; add some newline-related tests here
 159     (test "" #t #f '() eof-object)
 160     (test "foo bar baz" #t #f '("foo bar baz") eof-object)
 161     (pass-if-exception "eof reading char data"
 162                        exception:eof-while-reading-token
 163                        (test "" #f #f '() eof-object))
 164     (test "  " #t #f '("  ") eof-object)
 165     (test " @code{foo} " #f #f '(" ") code)
 166     (test " @code" #f #f '(" ") code)
 167     (test " {text here} asda" #f #f '(" ") (make-texinfo-token 'START '*braces*))
 168     (test " blah blah} asda" #f #f '(" blah blah") (make-texinfo-token 'END #f))))
 169
 170
 171 (with-test-prefix "test-texinfo->stexinfo"
 172   (define (test str expected-res)
 173     (pass-if (equal? expected-res
 174                      (call-with-input-string str texi->stexi))))
 175   (define (try-with-title title str)
 176     (call-with-input-string
 177      (string-append "foo bar baz\n@settitle " title "\n" str)
 178      texi->stexi))
 179   (define (test-with-title title str expected-res)
 180     (test (string-append "foo bar baz\n@settitle " title "\n" str)
 181           expected-res))
 182   (define (test-body str expected-res)
 183     (pass-if (equal? expected-res
 184                      (cddr (try-with-title "zog" str)))))
 185
 186   (define (list-intersperse src-l elem)
 187     (if (null? src-l) src-l
 188         (let loop ((l (cdr src-l)) (dest (cons (car src-l) '())))
 189           (if (null? l) (reverse dest)
 190               (loop (cdr l) (cons (car l) (cons elem dest)))))))
 191   (define (join-lines . lines)
 192     (apply string-append (list-intersperse lines "\n")))
 193
 194   (pass-if-exception "missing @settitle"
 195                      exception:no-settitle
 196                      (call-with-input-string "@dots{}\n" texi->stexi))
 197
 198   (test "\\input texinfo\n@settitle my title\n@dots{}\n"
 199         '(texinfo (% (title "my title")) (para (dots))))
 200   (test-with-title "my title" "@dots{}\n"
 201                    '(texinfo (% (title "my title")) (para (dots))))
 202   (test-with-title "my title" "@dots{}"
 203                    '(texinfo (% (title "my title")) (para (dots))))
 204
 205   (pass-if-exception "arg to @dots{}"
 206                      exception:unexpected-arg
 207                      (call-with-input-string
 208                       "foo bar baz\n@settitle my title\n@dots{arg}"
 209                       texi->stexi))
 210
 211   (test-body "@code{arg}"
 212              '((para (code "arg"))))
 213   (test-body "@code{     }"
 214              '((para (code))))
 215   (test-body "@code{ @code{}    }"
 216              '((para (code (code)))))
 217   (test-body "@code{  abc    @code{}    }"
 218              '((para (code "abc " (code)))))
 219   (test-body "@code{ arg               }"
 220              '((para (code "arg"))))
 221   (test-body "@example\n foo asdf  asd  sadf asd  \n@end example\n"
 222              '((example " foo asdf  asd  sadf asd  ")))
 223   (test-body (join-lines
 224               "@quotation"
 225               "@example"
 226               " foo asdf  asd  sadf asd  "
 227               "@end example"
 228               "@end quotation"
 229               "")
 230              '((quotation (example " foo asdf  asd  sadf asd  "))))
 231   (test-body (join-lines
 232               "@quotation"
 233               "@example"
 234               " foo asdf  @var{asd}  sadf asd  "
 235               "@end example"
 236               "@end quotation"
 237               "")
 238              '((quotation (example " foo asdf  " (var "asd") "  sadf asd  "))))
 239   (test-body (join-lines
 240               "@quotation"
 241               "@example"
 242               " foo asdf  @var{asd}  sadf asd  "
 243               ""
 244               "not in new para, this is an example"
 245               "@end example"
 246               "@end quotation"
 247               "")
 248              '((quotation
 249                 (example
 250                  " foo asdf  " (var "asd")
 251                  "  sadf asd  \n\nnot in new para, this is an example"))))
 252   (test-body (join-lines
 253               "@titlepage"
 254               "@quotation"
 255               " foo asdf  @var{asd}  sadf asd  "
 256               ""
 257               "should be in new para"
 258               "@end quotation"
 259               "@end titlepage"
 260               "")
 261              '((titlepage
 262                 (quotation (para "foo asdf " (var "asd") " sadf asd")
 263                            (para "should be in new para")))))
 264   (test-body (join-lines
 265               ""
 266               "@titlepage"
 267               ""
 268               "@quotation"
 269               " foo asdf  @var{asd}  sadf asd  "
 270               ""
 271               "should be in new para"
 272               ""
 273               ""
 274               "@end quotation"
 275               "@end titlepage"
 276               ""
 277               "@bye"
 278               ""
 279               "@foo random crap at the end"
 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               "random notes"
 287               "@quotation"
 288               " foo asdf  @var{asd}  sadf asd  "
 289               ""
 290               "should be in new para"
 291               ""
 292               ""
 293               "@end quotation"
 294               ""
 295               " hi mom"
 296               "")
 297              '((para "random notes")
 298                (quotation (para "foo asdf " (var "asd") " sadf asd")
 299                           (para "should be in new para"))
 300                (para "hi mom")))
 301   (test-body (join-lines
 302               "@enumerate"
 303               "@item one"
 304               "@item two"
 305               "@item three"
 306               "@end enumerate"
 307               )
 308              '((enumerate (item (para "one"))
 309                           (item (para "two"))
 310                           (item (para "three")))))
 311   (test-body (join-lines
 312               "@enumerate 44"
 313               "@item one"
 314               "@item two"
 315               "@item three"
 316               "@end enumerate"
 317               )
 318              '((enumerate (% (start "44"))
 319                           (item (para "one"))
 320                           (item (para "two"))
 321                           (item (para "three")))))
 322   (pass-if-exception "bad enumerate formatter"
 323                      exception:bad-enumerate
 324                      (try-with-title "foo" (join-lines
 325                                             "@enumerate string"
 326                                             "@item one"
 327                                             "@item two"
 328                                             "@item three"
 329                                             "@end enumerate"
 330                                             )))
 331   (pass-if-exception "bad itemize formatter"
 332                      exception:bad-enumerate
 333                      (try-with-title "foo" (join-lines
 334                                             "@itemize string"
 335                                             "@item one"
 336                                             "@item two"
 337                                             "@item three"
 338                                             "@end itemize"
 339                                             )))
 340   (test-body (join-lines
 341               "@itemize" ;; no formatter, should default to bullet
 342               "@item one"
 343               "@item two"
 344               "@item three"
 345               "@end itemize"
 346               )
 347              '((itemize (% (bullet (bullet)))
 348                         (item (para "one"))
 349                         (item (para "two"))
 350                         (item (para "three")))))
 351   (test-body (join-lines
 352               "@itemize @bullet"
 353               "@item one"
 354               "@item two"
 355               "@item three"
 356               "@end itemize"
 357               )
 358              '((itemize (% (bullet (bullet)))
 359                         (item (para "one"))
 360                         (item (para "two"))
 361                         (item (para "three")))))
 362   (test-body (join-lines
 363               "@itemize -"
 364               "@item one"
 365               "@item two"
 366               "@item three"
 367               "@end itemize"
 368               )
 369              '((itemize (% (bullet "-"))
 370                         (item (para "one"))
 371                         (item (para "two"))
 372                         (item (para "three")))))
 373   (test-body (join-lines
 374               "@table @code"
 375               "preliminary text -- should go in a pre-item para"
 376               "@item one"
 377               "item one text"
 378               "@item two"
 379               "item two text"
 380               ""
 381               "includes a paragraph"
 382               "@item three"
 383               "@end itemize"
 384               )
 385              '((table (% (formatter (code)))
 386                       (para "preliminary text -- should go in a pre-item para")
 387                       (entry (% (heading "one"))
 388                              (para "item one text"))
 389                       (entry (% (heading "two"))
 390                              (para "item two text")
 391                              (para "includes a paragraph"))
 392                       (entry (% (heading "three"))))))
 393   (test-body (join-lines
 394               "@chapter @code{foo} bar"
 395               "text that should be in a para"
 396               )
 397              '((chapter (code "foo") " bar")
 398                (para "text that should be in a para")))
 399   (test-body (join-lines
 400               "@deffnx Method foo bar @code{baz}"
 401               "text that should be in a para"
 402               )
 403              '((deffnx (% (category "Method")
 404                           (name "foo")
 405                           (arguments "bar " (code "baz"))))
 406                (para "text that should be in a para")))
 407   )