Commit | Line | Data |
---|---|---|
500f6a47 AW |
1 | ;; -*- scheme -*- |
2 | ;; guile-lib | |
3 | ;; Copyright (C) 2004, 2009 Andy Wingo <wingo at pobox dot com> | |
4 | ||
5 | ;; This program is free software; you can redistribute it and/or | |
6 | ;; modify it under the terms of the GNU General Public License as | |
7 | ;; published by the Free Software Foundation; either version 2 of | |
8 | ;; the License, or (at your option) any later version. | |
9 | ;; | |
10 | ;; This program is distributed in the hope that it will be useful, | |
11 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
13 | ;; GNU General Public License for more details. | |
14 | ;; | |
15 | ;; You should have received a copy of the GNU General Public License | |
16 | ;; along with this program; if not, contact: | |
17 | ;; | |
18 | ;; Free Software Foundation Voice: +1-617-542-5942 | |
19 | ;; 59 Temple Place - Suite 330 Fax: +1-617-542-2652 | |
20 | ;; Boston, MA 02111-1307, USA gnu@gnu.org | |
21 | ||
22 | ;;; Commentary: | |
23 | ;; | |
24 | ;; Unit tests for (sxml transform). | |
25 | ;; | |
26 | ;;; Code: | |
27 | ||
28 | (define-module (test-suite sxml-transform) | |
29 | #:use-module (test-suite lib) | |
30 | #:use-module (sxml transform)) | |
31 | ||
32 | (let* ((tree '(root (n1 (n11) "s12" (n13)) | |
33 | "s2" | |
34 | (n2 (n21) "s22") | |
35 | (n3 (n31 (n311)) | |
36 | "s32" | |
37 | (n33 (n331) "s332" (n333)) | |
38 | "s34")))) | |
39 | (define (test pred-begin pred-end expected) | |
40 | (pass-if expected | |
41 | (equal? expected (car (replace-range pred-begin pred-end (list tree)))))) | |
42 | ||
43 | ;; Remove one node, "s2" | |
44 | (test | |
45 | (lambda (node) | |
46 | (and (equal? node "s2") '())) | |
47 | (lambda (node) (list node)) | |
48 | '(root (n1 (n11) "s12" (n13)) | |
49 | (n2 (n21) "s22") | |
50 | (n3 (n31 (n311)) "s32" (n33 (n331) "s332" (n333)) "s34"))) | |
51 | ||
52 | ;; Replace one node, "s2" with "s2-new" | |
53 | (test | |
54 | (lambda (node) | |
55 | (and (equal? node "s2") '("s2-new"))) | |
56 | (lambda (node) (list node)) | |
57 | '(root (n1 (n11) "s12" (n13)) | |
58 | "s2-new" | |
59 | (n2 (n21) "s22") | |
60 | (n3 (n31 (n311)) "s32" (n33 (n331) "s332" (n333)) "s34"))) | |
61 | ||
62 | ;; Replace one node, "s2" with "s2-new" and its brother (n-new "s") | |
63 | (test | |
64 | (lambda (node) | |
65 | (and (equal? node "s2") '("s2-new" (n-new "s")))) | |
66 | (lambda (node) (list node)) | |
67 | '(root (n1 (n11) "s12" (n13)) | |
68 | "s2-new" (n-new "s") | |
69 | (n2 (n21) "s22") | |
70 | (n3 (n31 (n311)) "s32" (n33 (n331) "s332" (n333)) "s34"))) | |
71 | ||
72 | ;; Remove everything from "s2" onward | |
73 | (test | |
74 | (lambda (node) | |
75 | (and (equal? node "s2") '())) | |
76 | (lambda (node) #f) | |
77 | '(root (n1 (n11) "s12" (n13)))) | |
78 | ||
79 | ;; Remove everything from "n1" onward | |
80 | (test | |
81 | (lambda (node) | |
82 | (and (pair? node) (eq? 'n1 (car node)) '())) | |
83 | (lambda (node) #f) | |
84 | '(root)) | |
85 | ||
86 | ;; Replace from n1 through n33 | |
87 | (test | |
88 | (lambda (node) | |
89 | (and (pair? node) | |
90 | (eq? 'n1 (car node)) | |
91 | (list node '(n1* "s12*")))) | |
92 | (lambda (node) | |
93 | (and (pair? node) | |
94 | (eq? 'n33 (car node)) | |
95 | (list node))) | |
96 | '(root | |
97 | (n1 (n11) "s12" (n13)) | |
98 | (n1* "s12*") | |
99 | (n3 | |
100 | (n33 (n331) "s332" (n333)) | |
101 | "s34")))) |