guile/test-suite/tests/texinfo.test

;;;; texinfo.test                 -*- scheme -*-
;;;;
;;;; Copyright (C) 2010, 2011, 2012, 2013, 2014, 2020  Free Software Foundation, Inc.
;;;; Copyright (C) 2001,2002 Oleg Kiselyov <oleg at pobox dot com>
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 3 of the License, or (at your option) any later version.
;;;; 
;;;; This library is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;;; Lesser General Public License for more details.
;;;; 
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA

;;; Commentary:
;;
;; Unit tests for (sxml texinfo). Adapted from xml.ssax.scm.
;;
;;; Code:

(define-module (test-suite texinfo)
  #:use-module (test-suite lib)
  #:use-module (texinfo))

(define exception:eof-while-reading-token
  '(parser-error . "^EOF while reading a token"))
(define exception:wrong-character
  '(parser-error . "^Wrong character"))
(define exception:eof-while-reading-char-data
  '(parser-error . "^EOF while reading char data"))
(define exception:no-settitle
  '(parser-error . "^No \\\\n@settitle  found"))
(define exception:unexpected-arg
  '(parser-error . "^@-command didn't expect more arguments"))
(define exception:bad-enumerate
  '(parser-error . "^Invalid"))

(define nl (string #\newline))

(define texinfo:read-verbatim-body
  (@@ (texinfo) read-verbatim-body))
(with-test-prefix "test-read-verbatim-body"
  (define (read-verbatim-body-from-string str)
    (define (consumer fragment foll-fragment seed)
      (cons* (if (equal? foll-fragment (string #\newline))
                 (string-append " NL" nl)
                 foll-fragment)
             fragment seed))
    (reverse 
     (call-with-input-string
      str
      (lambda (port) (texinfo:read-verbatim-body port consumer '())))))

  (pass-if-equal '()
      (read-verbatim-body-from-string "@end verbatim\n"))

  ;; after @verbatim, the current position will always directly after
  ;; the newline.
  (pass-if-exception "@end verbatim needs a newline"
                     exception:eof-while-reading-token
                     (read-verbatim-body-from-string "@end verbatim"))

  (pass-if-equal '("@@end verbatim" " NL\n")
      (read-verbatim-body-from-string "@@end verbatim\n@end verbatim\n"))

  (pass-if-equal '("@@@@faosfasf adsfas " " NL\n" " asf @foo{asdf}" " NL\n")
      (read-verbatim-body-from-string
       "@@@@faosfasf adsfas \n asf @foo{asdf}\n@end verbatim\n"))

  (pass-if-equal '("@end verbatim " " NL\n")
      (read-verbatim-body-from-string "@end verbatim \n@end verbatim\n")))

(define texinfo:read-arguments
  (@@ (texinfo) read-arguments))
(with-test-prefix "test-read-arguments"
  (define (read-arguments-from-string str)
    (call-with-input-string
     str
     (lambda (port) (texinfo:read-arguments port #\}))))

  (define (test str expected-res)
    (pass-if-equal expected-res
        (read-arguments-from-string str)))

  (test "}" '())
  (test "foo}" '("foo"))
  (test "foo,bar}" '("foo" "bar"))
  (test "    foo     ,    bar  }" '("foo" "bar"))
  (test " foo ,   , bar }" '("foo" #f "bar"))
  (test "foo,,bar}" '("foo" #f "bar"))
  (pass-if-exception "need a } when reading arguments"
                     exception:eof-while-reading-token
                     (call-with-input-string
                      "foo,,bar"
                      (lambda (port) (texinfo:read-arguments port #\})))))

(define texinfo:complete-start-command
  (@@ (texinfo) complete-start-command))
(with-test-prefix "test-complete-start-command"
  (define (test command str)
    (call-with-input-string
     str
     (lambda (port)
       (call-with-values
           (lambda ()
             (texinfo:complete-start-command command port))
         list))))

  (pass-if-equal '(section () EOL-TEXT)
      (test 'section "foo bar baz bonzerts"))
  (pass-if-equal '(deffnx ((category "Function") (name "foo") (arguments)) EOL-TEXT-ARGS)
      (test 'deffnx "Function foo"))
  (pass-if-exception "@emph missing a start brace"
                     exception:wrong-character
                     (test 'emph "no brace here"))
  (pass-if-equal '(emph () INLINE-TEXT)
      (test 'emph "{foo bar baz bonzerts"))
  (pass-if-equal '(ref ((node "foo bar") (section "baz") (info-file "bonzerts"))
                       INLINE-ARGS)
      (test 'ref "{ foo bar ,,  baz, bonzerts}"))
  (pass-if-equal '(node ((name "referenced node")) EOL-ARGS)
      (test 'node " referenced node\n")))

(define texinfo:read-char-data
  (@@ (texinfo) read-char-data))
(define make-texinfo-token cons)
(with-test-prefix "test-read-char-data"
  (let* ((code (make-texinfo-token 'START 'code))
         (ref (make-texinfo-token 'EMPTY 'ref))
         (title (make-texinfo-token 'LINE 'title))
         (node (make-texinfo-token 'EMPTY 'node))
         (eof-object (with-input-from-string "" read))
         (str-handler (lambda (fragment foll-fragment seed)
                        (if (string-null? foll-fragment)
                            (cons fragment seed)
                            (cons* foll-fragment fragment seed)))))
    (define (test str expect-eof? preserve-ws? expected-data expected-token)
      (call-with-values
          (lambda ()
            (call-with-input-string
             str
             (lambda (port)
               (texinfo:read-char-data
                port expect-eof? preserve-ws? str-handler '()))))
        (lambda (seed token)
          (let ((result (reverse seed)))
            (pass-if-equal expected-data result)
            (pass-if-equal expected-token token)))))

    ;; add some newline-related tests here
    (test "" #t #f '() eof-object)
    (test "foo bar baz" #t #f '("foo bar baz") eof-object)
    (pass-if-exception "eof reading char data"
                       exception:eof-while-reading-token
                       (test "" #f #f '() eof-object))
    (test "  " #t #f '("  ") eof-object)
    (test " @code{foo} " #f #f '(" ") code)
    (test " @code" #f #f '(" ") code)
    (test " {text here} asda" #f #f '(" ") (make-texinfo-token 'START '*braces*))
    (test " blah blah} asda" #f #f '(" blah blah") (make-texinfo-token 'END #f))))
     

(with-test-prefix "test-texinfo->stexinfo"
  (define (test str expected-res)
    (pass-if-equal expected-res
        (call-with-input-string str texi->stexi)))
  (define (try-with-title title str)
    (call-with-input-string
     (string-append "foo bar baz\n@settitle " title "\n" str)
     texi->stexi))
  (define (test-with-title title str expected-res)
    (test (string-append "foo bar baz\n@settitle " title "\n" str)
          expected-res))
  (define (test-body str expected-res)
    (pass-if-equal str expected-res
      (cddr (try-with-title "zog" str))))

  (define (list-intersperse src-l elem)
    (if (null? src-l) src-l
        (let loop ((l (cdr src-l)) (dest (cons (car src-l) '())))
          (if (null? l) (reverse dest)
              (loop (cdr l) (cons (car l) (cons elem dest)))))))
  (define (join-lines . lines)
    (apply string-append (list-intersperse lines "\n")))

  (pass-if-exception "missing @settitle"
                     exception:no-settitle
                     (call-with-input-string "@dots{}\n" texi->stexi))

  (test "\\input texinfo\n@settitle my title\n@dots{}\n"
        '(texinfo (% (title "my title")) (para (dots))))
  (test-with-title "my title" "@dots{}\n"
                   '(texinfo (% (title "my title")) (para (dots))))
  (test-with-title "my title" "@dots{}"
                   '(texinfo (% (title "my title")) (para (dots))))

  (pass-if-exception "arg to @dots{}"
                     exception:unexpected-arg
                     (call-with-input-string
                      "foo bar baz\n@settitle my title\n@dots{arg}"
                      texi->stexi))

  (test-body "@code{arg}"
             '((para (code "arg"))))
  (test-body "@url{arg}"
             '((para (uref (% (url "arg"))))))
  (test-body "@url{@@}"
             '((para (uref (% (url "@"))))))
  (test-body "@url{@var{foo}}"
             '((para (uref (% (url (var "foo")))))))
  (test-body "@code{     }"
             '((para (code))))
  (test-body "@code{ @code{}    }"
             '((para (code (code)))))
  (test-body "@code{  abc    @code{}    }"
             '((para (code "abc " (code)))))
  (test-body "@code{ arg               }"
             '((para (code "arg"))))
  (test-body "@w{ arg with  spaces   }"
             '((para (w " arg with  spaces   "))))

  (test-body "@acronym{GNU}"
             '((para (acronym (% (acronym "GNU"))))))

  (test-body "@acronym{GNU, not unix}"
             '((para (acronym (% (acronym "GNU")
                                 (meaning "not unix"))))))

  (test-body "@acronym{GNU, @acronym{GNU}'s Not Unix}"
             '((para (acronym (% (acronym "GNU")
                                 (meaning (acronym (% (acronym "GNU")))
                                          "'s Not Unix"))))))

  (test-body "@example\n foo asdf  asd  sadf asd  \n@end example\n"
             '((example " foo asdf  asd  sadf asd  ")))
  (test-body "@example\n@{\n@}\n@end example\n"
             '((example "{\n}")))
  (test-body (join-lines
              "@quotation"
              "@example"
              " foo asdf  asd  sadf asd  "
              "@end example"
              "@end quotation"
              "")
             '((quotation (example " foo asdf  asd  sadf asd  "))))
  (test-body (join-lines
              "@quotation"
              "@example"
              " foo asdf  @var{asd}  sadf asd  "
              "@end example"
              "@end quotation"
              "")
             '((quotation (example " foo asdf  " (var "asd") "  sadf asd  "))))
  (test-body (join-lines
              "@quotation"
              "@example"
              " foo asdf  @var{asd}  sadf asd  "
              ""
              "not in new para, this is an example"
              "@end example"
              "@end quotation"
              "")
             '((quotation
                (example
                 " foo asdf  " (var "asd")
                 "  sadf asd  \n\nnot in new para, this is an example"))))
  (test-body (join-lines
              "@titlepage"
              "@quotation"
              " foo asdf  @var{asd}  sadf asd  "
              ""
              "should be in new para"
              "@end quotation"
              "@end titlepage"
              "")
             '((titlepage
                (quotation (para "foo asdf " (var "asd") " sadf asd")
                           (para "should be in new para")))))
  (test-body (join-lines
              ""
              "@titlepage"
              ""
              "@quotation"
              " foo asdf  @var{asd}  sadf asd  "
              ""
              "should be in new para"
              ""
              ""
              "@end quotation"
              "@end titlepage"
              ""
              "@bye"
              ""
              "@foo random crap at the end"
              "")
             '((titlepage
                (quotation (para "foo asdf " (var "asd") " sadf asd")
                           (para "should be in new para")))))
  (test-body (join-lines
              ""
              "random notes"
              "@quotation"
              " foo asdf  @var{asd}  sadf asd  "
              ""
              "should be in new para"
              ""
              ""
              "@end quotation"
              ""
              " hi mom"
              "")
             '((para "random notes")
               (quotation (para "foo asdf " (var "asd") " sadf asd")
                          (para "should be in new para"))
               (para "hi mom")))
  (test-body (join-lines
              "@enumerate"
              "@item one"
              "@item two"
              "@item three"
              "@end enumerate"
              )
             '((enumerate (item (para "one"))
                          (item (para "two"))
                          (item (para "three")))))
  (test-body (join-lines
              "@enumerate 44"
              "@item one"
              "@item two"
              "@item three"
              "@end enumerate"
              )
             '((enumerate (% (start "44"))
                          (item (para "one"))
                          (item (para "two"))
                          (item (para "three")))))
  (pass-if-exception "bad enumerate formatter"
                     exception:bad-enumerate
                     (try-with-title "foo" (join-lines
                                            "@enumerate string"
                                            "@item one"
                                            "@item two"
                                            "@item three"
                                            "@end enumerate"
                                            )))
  (pass-if-exception "bad itemize formatter"
                     exception:bad-enumerate
                     (try-with-title "foo" (join-lines
                                            "@itemize string"
                                            "@item one"
                                            "@item two"
                                            "@item three"
                                            "@end itemize"
                                            )))
  (test-body (join-lines
              "@itemize" ;; no formatter, should default to bullet
              "@item one"
              "@item two"
              "@item three"
              "@end itemize"
              )
             '((itemize (% (bullet (bullet)))
                        (item (para "one"))
                        (item (para "two"))
                        (item (para "three")))))
  (test-body (join-lines
              "@itemize @bullet"
              "@item one"
              "@item two"
              "@item three"
              "@end itemize"
              )
             '((itemize (% (bullet (bullet)))
                        (item (para "one"))
                        (item (para "two"))
                        (item (para "three")))))
  (test-body (join-lines
              "@itemize -"
              "@item one"
              "@item two"
              "@item three"
              "@end itemize"
              )
             '((itemize (% (bullet "-"))
                        (item (para "one"))
                        (item (para "two"))
                        (item (para "three")))))
  (test-body (join-lines
              "@table @code"
              "preliminary text -- should go in a pre-item para"
              "@item one"
              "item one text"
              "@item two"
              "item two text"
              ""
              "includes a paragraph"
              "@item three"
              "@end itemize"
              )
             '((table (% (formatter (code)))
                      (para "preliminary text -- should go in a pre-item para")
                      (entry (% (heading "one"))
                             (para "item one text"))
                      (entry (% (heading "two"))
                             (para "item two text")
                             (para "includes a paragraph"))
                      (entry (% (heading "three"))))))
  (test-body (join-lines
              "@chapter @code{foo} bar"
              "text that should be in a para"
              )
             '((chapter (code "foo") " bar")
               (para "text that should be in a para")))
  (test-body (join-lines
              "@deffnx Method foo bar @code{baz}"
              "text that should be in a para"
              )
             '((deffnx (% (category "Method")
                          (name "foo")
                          (arguments "bar " (code "baz"))))
               (para "text that should be in a para")))
  (test-body "@pxref{Locales, @code{setlocale}}"
             '((para (pxref (% (node "Locales")
                               (name (code "setlocale")))))))
  (test-body "Like this---e.g.@:, at colon."
             '((para "Like this---e.g.:, at colon.")))
  )