Add `resolve' unit tests.

* tests/Makefile.am (TESTS): Add `resolve.test'.
  (CLEANFILES): Add `resolve.log'.

1 files changed, 131 insertions, 0 deletions

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))