diff options
author | Ludovic Courtès | 2009-05-25 14:07:36 +0200 |
---|---|---|
committer | Ludovic Courtès | 2009-05-25 14:28:59 +0200 |
commit | f698471f9de9a5b0f853a014fccba1f2aff1b4dd (patch) | |
tree | e7d036d34b5b14bce95a8671912095e470b817c2 | |
parent | 2e55c630201ff50c6fef40f281eecffd6414280b (diff) | |
download | skribilo-f698471f9de9a5b0f853a014fccba1f2aff1b4dd.tar.gz skribilo-f698471f9de9a5b0f853a014fccba1f2aff1b4dd.tar.lz skribilo-f698471f9de9a5b0f853a014fccba1f2aff1b4dd.zip |
Add `resolve' unit tests.
* tests/Makefile.am (TESTS): Add `resolve.test'.
(CLEANFILES): Add `resolve.log'.
-rw-r--r-- | tests/Makefile.am | 4 | ||||
-rw-r--r-- | tests/resolve.test | 131 |
2 files changed, 133 insertions, 2 deletions
diff --git a/tests/Makefile.am b/tests/Makefile.am index 913e871..bd4349f 100644 --- a/tests/Makefile.am +++ b/tests/Makefile.am @@ -1,8 +1,8 @@ TESTS_ENVIRONMENT = \ $(GUILE) -L $(top_srcdir)/src/guile -L $(top_builddir)/src/guile -TESTS = ast.test readers/rss-2.test +TESTS = ast.test readers/rss-2.test resolve.test EXTRA_DIST = $(TESTS) -CLEANFILES = ast.log rss-2.log +CLEANFILES = ast.log resolve.log rss-2.log diff --git a/tests/resolve.test b/tests/resolve.test new file mode 100644 index 0000000..0e29614 --- /dev/null +++ b/tests/resolve.test @@ -0,0 +1,131 @@ +;;; Excercise the `resolve' routines. -*- Scheme -*- +;;; +;;; Copyright (C) 2009 Ludovic Courtès <ludo@gnu.org> +;;; +;;; This file is part of Skribilo. +;;; +;;; Skribilo 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. +;;; +;;; Skribilo 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 program. If not, see <http://www.gnu.org/licenses/>. + +(define-module (tests resolve) + :use-module (skribilo ast) + :use-module (skribilo engine) + :use-module (skribilo resolve) + :use-module (skribilo package base) + :use-module (srfi srfi-64)) + +(define %engine + (find-engine 'base)) + + +(test-begin "resolve") + +(test-assert "parents" + (let* ((doc (document #:title "Doc" + (chapter #:title "C" + (section #:title "S" + (p "par"))))) + (ch (car (markup-body doc))) + (sec (car (markup-body ch))) + (par (car (markup-body sec)))) + (and (is-markup? ch 'chapter) + (eq? (ast-parent ch) 'unspecified) + (begin + (resolve! doc %engine '()) + (and (eq? (ast-parent ch) doc) + (eq? (ast-parent sec) ch) + (eq? (ast-parent par) sec)))))) + +(test-assert "unresolved node in body" + (let* ((resolved? #f) + (doc (document #:title "Doc" + (resolve (lambda (n e env) + (set! resolved? #t)))))) + (and (not resolved?) + (begin + (resolve! doc %engine '()) + resolved?)))) + +(test-assert "unresolved node in unresolved node in body" + (let* ((resolved? #f) + (doc (document #:title "Doc" + (resolve (lambda (n e env) + (resolve (lambda (n e env) + (set! resolved? #t)))))))) + (and (not resolved?) + (begin + (resolve! doc %engine '()) + resolved?)))) + +(test-assert "unresolved node in options" + (let* ((resolved? #f) + (doc (document #:title + (resolve (lambda (n e env) + (set! resolved? #t))) + "body..."))) + (and (not resolved?) + (begin + (resolve! doc %engine '()) + resolved?)))) + +(test-assert "unresolved node in processor body" + (let* ((resolved? #f) + (doc (document #:title + (processor #:combinator (lambda (e1 e2) e1) + (resolve (lambda (n e env) + (set! resolved? #t))))))) + (and (not resolved?) + (begin + (resolve! doc %engine '()) + resolved?)))) + +(test-assert "unresolved node product has a parent" + (let* ((doc (document #:title "Doc" + (resolve (lambda (n e env) + (chapter #:title "C")))))) + (resolve! doc %engine '()) + + (let ((ch (car (markup-body doc)))) + (and (is-markup? ch 'chapter) + (eq? (ast-parent ch) doc))))) + +(test-assert "node bindings" + (let* ((doc (document #:title "Doc" + (chapter #:title "C" #:ident "c" + (section #:title "S" #:ident "s")))) + (ch (car (markup-body doc))) + (sec (car (markup-body ch)))) + (and (not (document-lookup-node doc "c")) + (not (document-lookup-node doc "s")) + (begin + (resolve! doc %engine '()) + (and (eq? (document-lookup-node doc "c") ch) + (eq? (document-lookup-node doc "s") sec)))))) + +(test-assert "unresolved node bindings" + ;; Make sure nodes returned by `unresolved' nodes are eventually bound. + (let* ((doc (document #:title "Doc" + (resolve (lambda (n e env) + (chapter #:title "C" #:ident "c" + (section #:title "S" #:ident "s"))))))) + (and (not (document-lookup-node doc "c")) + (not (document-lookup-node doc "s")) + (begin + (resolve! doc %engine '()) + (and (is-markup? (document-lookup-node doc "c") 'chapter) + (is-markup? (document-lookup-node doc "s") 'section)))))) + +(test-end "resolve") + + +(exit (= (test-runner-fail-count (test-runner-current)) 0)) |