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