mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
a43aa1bc79
* module/texinfo.scm (texi-command-specs): Add 'w'.
(space-significant?): Add it.
* module/texinfo/html.scm (tag-replacements): Add 'w'.
* test-suite/tests/texinfo.test ("test-texinfo->stexinfo"): Add test.
432 lines
16 KiB
Scheme
432 lines
16 KiB
Scheme
;;;; 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.")))
|
|
)
|