diff options
Diffstat (limited to 'test-suite/tests/texinfo.test')
-rw-r--r-- | test-suite/tests/texinfo.test | 430 |
1 files changed, 430 insertions, 0 deletions
diff --git a/test-suite/tests/texinfo.test b/test-suite/tests/texinfo.test new file mode 100644 index 000000000..6f7d4c7d8 --- /dev/null +++ b/test-suite/tests/texinfo.test @@ -0,0 +1,430 @@ +;;;; texinfo.test -*- scheme -*- +;;;; +;;;; Copyright (C) 2010, 2011, 2012, 2013, 2014 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 "@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."))) + ) |