;;;; texinfo.test -*- scheme -*- ;;;; ;;;; Copyright (C) 2010, 2011, 2012, 2013, 2014 Free Software Foundation, Inc. ;;;; Copyright (C) 2001,2002 Oleg Kiselyov ;;;; ;;;; 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 "@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."))) )