aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2023-12-09 00:21:18 +0100
committerHugo Hörnquist <hugo@lysator.liu.se>2023-12-09 00:59:16 +0100
commitefeb731d9b17b33b51e081bdff4d93325bf249a9 (patch)
tree3f3bfc98bb614fe3e2b2099d83d2b2c6c3e1a2fe
parentRework namespaced sxml type. Still incomplete. (diff)
downloadcalp-efeb731d9b17b33b51e081bdff4d93325bf249a9.tar.gz
calp-efeb731d9b17b33b51e081bdff4d93325bf249a9.tar.xz
Fix sxml namespaced util.
-rw-r--r--module/sxml/namespaced/util.scm19
-rw-r--r--tests/unit/sxml/sxml-namespaced-util.scm36
2 files changed, 19 insertions, 36 deletions
diff --git a/module/sxml/namespaced/util.scm b/module/sxml/namespaced/util.scm
index e05f2fa1..9a4e72d7 100644
--- a/module/sxml/namespaced/util.scm
+++ b/module/sxml/namespaced/util.scm
@@ -3,7 +3,7 @@
:use-module (srfi srfi-1)
:use-module ((ice-9 control) :select (call/ec))
:export (xml-element-hash-key
- find-element
+ find-child
element-matches?
root-element
))
@@ -13,12 +13,10 @@
(cons (xml-element-namespace tag)
(xml-element-tagname tag)))
-(define (find-element target list)
+(define (find-child target list)
(define target* (xml-element-hash-key target))
- (find (lambda (x) (and (list? x)
- (not (null? x))
- (xml-element? (car x))
- (equal? target* (xml-element-hash-key (car x)))))
+ (find (lambda (x) (and (xml-element? x)
+ (equal? target* (xml-element-hash-key x))))
list))
@@ -27,12 +25,3 @@
(equal?
(xml-element-hash-key target-el)
(xml-element-hash-key (car tree)))))
-
-
-(define (root-element tree)
- (cond ((and (eq? '*TOP* (car tree))
- (pi-element? (cadr tree)))
- (caddr tree))
- ((eq? '*TOP* (car tree))
- (cadr tree))
- (else tree)))
diff --git a/tests/unit/sxml/sxml-namespaced-util.scm b/tests/unit/sxml/sxml-namespaced-util.scm
index 6f48105f..bc29e21d 100644
--- a/tests/unit/sxml/sxml-namespaced-util.scm
+++ b/tests/unit/sxml/sxml-namespaced-util.scm
@@ -7,36 +7,30 @@
(test-equal "XML Hash key"
(cons 'a ns)
- (xml-element-hash-key (xml 'a ns)))
+ (xml-element-hash-key ((xml 'a ns))))
(test-group "Find element"
- (let ((el `(,(xml ns 'a))))
+ (let ((el ((xml ns 'a))))
(test-eq "Found element is the source element"
el
- (find-element
- (car el)
- `((,(xml ns 'b)) ,el (,(xml ns 'a))))))
+ (find-child
+ el
+ (xml-element-children
+ ((xml ns 'b)
+ el ((xml ns 'a)))))))
;; TODO Test "find" failure
)
(test-group "Element Match"
(test-assert "Positive element match"
- (element-matches? (xml 'a ns)
- (list (xml 'a ns)
- "Content here")))
+ (element-matches? ((xml 'a ns))
+ (list
+ ((xml 'a ns)
+ "Content here"))))
(test-assert "Negative element match"
- (not (element-matches? (xml 'a ns)
- (list (xml 'b ns)
- "Content here")))))
-
-(let ((el `(,(xml 'a) "Content")))
- (test-group "root-element"
- (test-equal "With PI"
- el (root-element `(*TOP* ,(pi-element 'doctype "HTML") ,el)))
- (test-equal "Without PI"
- el (root-element `(*TOP* ,el)))
-
- (test-equal "Bare"
- el (root-element el))))
+ (not (element-matches? ((xml 'a ns))
+ (list
+ ((xml 'b ns)
+ "Content here"))))))
'((sxml namespaced util))