summaryrefslogtreecommitdiff
path: root/tests/ast.test
blob: 596d9d340134979ad3ab1c94f54e550f1d572816 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
;;; Excercise the AST routines.                  -*- Scheme -*-
;;;
;;; Copyright (C) 2009, 2012  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-assert "node-children"
  (let* ((doc (document
               (chapter #:ident "0" (section #:ident "s"))
               (list (chapter #:ident "1"))
               "hey"
               (list "foo"
                     (chapter #:ident "2"))))
         (lst (node-children doc)))
    (equal? (map markup-ident lst)
            '("0" "1" "2"))))

(test-end "ast")


(exit (= (test-runner-fail-count (test-runner-current)) 0))