summaryrefslogtreecommitdiff
path: root/test-suite/tests/texinfo.test
diff options
context:
space:
mode:
Diffstat (limited to 'test-suite/tests/texinfo.test')
-rw-r--r--test-suite/tests/texinfo.test430
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.")))
+ )