test-suite/tests/texinfo.test

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