From 6fa2b3164bc06af4340957abd8644006a2d464ad Mon Sep 17 00:00:00 2001
From: Ludovic Courtès
Date: Wed, 7 Jan 2009 01:38:28 +0100
Subject: Add AST unit tests.

* tests/Makefile.am (TESTS): Add `ast.test'.
  (CLEANFILES): Add `ast.log'.
---
 tests/Makefile.am |   4 +--
 tests/ast.test    | 105 ++++++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 107 insertions(+), 2 deletions(-)
 create mode 100644 tests/ast.test

diff --git a/tests/Makefile.am b/tests/Makefile.am
index 50d1381..913e871 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 = readers/rss-2.test
+TESTS = ast.test readers/rss-2.test
 
 EXTRA_DIST = $(TESTS)
 
-CLEANFILES = rss-2.log
+CLEANFILES = ast.log rss-2.log
diff --git a/tests/ast.test b/tests/ast.test
new file mode 100644
index 0000000..cb18e3f
--- /dev/null
+++ b/tests/ast.test
@@ -0,0 +1,105 @@
+;;; Excercise the AST 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 ast)
+  :use-module (ice-9 match)
+  :use-module (skribilo ast)
+  :use-module (skribilo package base)
+  :use-module (srfi srfi-1)
+  :use-module (srfi srfi-64)
+  :use-module (ice-9 match))
+
+(define (tree-map proc tree)
+  ;; Map PROC over TREE.
+  (let loop ((tree tree))
+    (cond ((pair? tree)
+           (map loop tree))
+          ((null? tree)
+           tree)
+          (else
+           (proc tree)))))
+
+
+(test-begin "ast")
+
+(test-assert "document"
+  (let ((doc (document #:title "Foo")))
+    (and (document? doc)
+         (ast? doc)
+         (node? doc)
+         (container? doc)
+         (markup? doc)
+         (is-markup? doc 'document)
+         (string=? (markup-option doc #:title) "Foo"))))
+
+(test-assert "document + chapter"
+  (let* ((doc  (document #:title "Foo" (chapter #:title "Bar" "Blah.")))
+         (body (markup-body doc)))
+    (and (pair? body)
+         (let ((ch (car body)))
+           (and (is-markup? ch 'chapter)
+                (container? ch)
+                (ast? ch)
+                (node? ch)
+                (string=? (markup-option ch #:title) "Bar")
+                (let ((body (markup-body ch)))
+                  (and (pair? body)
+                       (string=? (car body) "Blah.")
+                       (null? (cdr body))))))
+         (null? (cdr body)))))
+
+(test-assert "`find-down' returns the empty list"
+  (let* ((doc (document (chapter (section)) (chapter (section))))
+         (lst (find-down (lambda (n) (is-markup? n 'chapter)) doc)))
+    (null? lst)))
+
+(test-assert "`find-down' returns a tree"
+  (let* ((doc (document (chapter (section)) (chapter (section))))
+         (lst (find-down (lambda (n) (is-markup? n 'chapter))
+                         (markup-body doc))))
+    (and (pair? lst)
+         (= (length lst) 2)
+         (every (lambda (n) (is-markup? n 'chapter))
+                (map car lst)))))
+
+(test-assert "`find-down' returns an ordered tree"
+  (let* ((doc (document (chapter #:ident "0" (section #:ident "1"))
+                        (chapter #:ident "2" (section #:ident "3"))))
+         (lst (find-down markup? (markup-body doc))))
+    (and (pair? lst)
+         (= (length lst) 2)
+         (equal? (tree-map markup-markup lst)
+                 '((chapter (section)) (chapter (section))))
+         (equal? (tree-map markup-ident lst)
+                 '(("0" ("1")) ("2" ("3")))))))
+
+(test-assert "`search-down' searches in depth, returns an ordered list"
+  (let* ((doc (document (chapter (section #:ident "0"))
+                        (chapter (section #:ident "1"))))
+         (lst (search-down (lambda (n) (is-markup? n 'section)) doc)))
+    (and (pair? lst)
+         (= (length lst) 2)
+         (every (lambda (n) (is-markup? n 'section)) lst)
+         (equal? (map markup-ident lst)
+                 (map number->string (iota 2))))))
+
+(test-end "ast")
+
+
+(exit (= (test-runner-fail-count (test-runner-current)) 0))
-- 
cgit v1.2.3