blob: cb18e3f0859d1272750f8584ea396b135a61bb4a (
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
|
;;; 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))
|
