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 +;;; +;;; 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 . + +(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