Move sxml tests to own "namespace".

2 files changed, 0 insertions, 210 deletions

diff --git a/tests/unit/util/sxml-namespaced.scm b/tests/unit/util/sxml-namespaced.scm
deleted file mode 100644
index b2d55028..00000000
--- a/tests/unit/util/sxml-namespaced.scm
+++ /dev/null
@@ -1,172 +0,0 @@
-(define-module (test sxml-namespaced)
-  :use-module (srfi srfi-64)
-  :use-module (srfi srfi-64 test-error)
-  :use-module (srfi srfi-88)
-  :use-module (ice-9 match)
-  :use-module (sxml namespaced)
-  :use-module (hnh util state-monad)
-  )
-
-;;; TODO tests with attributes
-
-(define (ns x)
-  (string->symbol (format #f "http://example.com/~a" x)))
-
-(define (namespaced-symbol ns symb)
-  (string->symbol (format #f "~a:~a" ns symb)))
-
-
-
-(test-group "XML constructor utility procedure"
-  (test-equal "3 args"
-    (make-xml-element 'tagname 'namespace 'attributes)
-    (xml 'namespace 'tagname 'attributes))
-
-  (test-equal "2 args"
-    (make-xml-element 'tagname 'namespace '())
-    (xml 'namespace 'tagname))
-
-  (test-equal "1 args"
-    (make-xml-element 'tagname #f '())
-    (xml 'tagname)))
-
-
-
-(test-group "xml->namespaced-sxml"
-
-  (test-equal
-      `(*TOP* (,(xml 'tag)))
-    (xml->namespaced-sxml "<tag/>"))
-
-  (test-equal
-      `(*TOP* (,(xml 'ns1 'tag)))
-    (xml->namespaced-sxml "<tag xmlns='ns1'/>"))
-
-  (test-equal
-      `(*TOP* (,(xml 'ns2 'tag)))
-    (xml->namespaced-sxml "<x:tag xmlns='ns1' xmlns:x='ns2'/>"))
-
-  (test-equal
-      `(*TOP* (,(xml 'ns2 'tag)
-               (,(xml 'ns1 'tag))))
-    (xml->namespaced-sxml "<x:tag xmlns='ns1' xmlns:x='ns2'><tag/></x:tag>"))
-
-  (test-equal "PI are passed directly"
-      `(*TOP* ,(make-pi-element 'xml "encoding=\"utf-8\" version=\"1.0\"")
-              (,(xml 'tag)))
-      (xml->namespaced-sxml "<?xml encoding=\"utf-8\" version=\"1.0\"?><tag/>"))
-
-  (test-equal "Document with whitespace in it"
-    `(*TOP* ,(make-pi-element 'xml "")
-            (,(xml 'root)
-             " "
-             (,(xml 'a))
-             ))
-    (xml->namespaced-sxml "<?xml?><root> <a/></root>"
-                          trim-whitespace?: #f))
-
-  ;; TODO is this expected? xml->sxml discards it.
-  (test-equal "Whitespace before root is kept"
-    `(*TOP* ,(make-pi-element 'xml "")
-            (,(xml 'root)))
-    (xml->namespaced-sxml "<?xml?> <root/>")))
-
-
-
-;;; NOTE that sxml->namespaced-sxml currently ignores any existing xmlns
-;;; attributes, since xml->sxml doesn't have those.
-(test-group "sxml->namespaced-sxml"
-  (test-equal "Simplest"
-    `(,(xml 'a)) (sxml->namespaced-sxml '(a) '()))
-  (test-equal "With *TOP*"
-    `(*TOP* (,(xml 'a))) (sxml->namespaced-sxml '(*TOP* (a)) '()))
-  (test-equal "Simplest with namespace"
-    `(,(xml (ns 1) 'a))
-    (sxml->namespaced-sxml '(x:a)
-                           `((x . ,(ns 1)))))
-  (test-equal "With pi"
-    `(*TOP* ,(make-pi-element 'xml "test")
-            (,(xml 'a)))
-    (sxml->namespaced-sxml
-     `(*TOP*
-       (*PI* xml "test")
-       (a))
-     '()))
-  (test-error "With unknown namespace"
-    'missing-namespace
-    (sxml->namespaced-sxml '(x:a) '())))
-
-
-
-(test-group "namespaced-sxml->*"
-
-  ;; /namespaces is the most "primitive" one
-  (test-group "/namespaces"
-   (test-group "Without namespaces"
-       (call-with-values
-           (lambda ()
-             (namespaced-sxml->sxml/namespaces
-              `(*TOP*
-                (,(xml 'a)))))
-         (lambda (tree namespaces)
-           (test-equal `(*TOP* (a)) tree)
-           (test-equal '() namespaces))))
-
-   (test-group "With namespaces"
-     (call-with-values
-         (lambda ()
-           (namespaced-sxml->sxml/namespaces
-            `(*TOP*
-              (,(xml (ns 1) 'a)
-               (,(xml (ns 2) 'a))
-               (,(xml 'a))))))
-       (lambda (tree nss)
-         (test-eqv 2 (length nss))
-         (test-equal
-             `(*TOP*
-               (,(namespaced-symbol (assoc-ref nss (ns 1)) 'a)
-                (,(namespaced-symbol (assoc-ref nss (ns 2)) 'a))
-                (a)))
-           tree))))
-
-   (test-group "*PI*"
-     (call-with-values
-         (lambda ()
-           (namespaced-sxml->sxml/namespaces
-            `(*TOP*
-              ,(make-pi-element 'xml "test")
-              (,(xml 'a)))))
-       (lambda (tree namespaces)
-         (test-equal '() namespaces)
-         (test-equal `(*TOP* (*PI* xml "test")
-                             (a))
-           tree)))))
-
-  (test-group "namespaced-sxml->sxml"
-    (test-equal "Without namespaces"
-      '(*TOP* (a (@)))
-      (namespaced-sxml->sxml `(*TOP* (,(xml 'a)))))
-
-    (test-group "With namespaces"
-     (match (namespaced-sxml->sxml `(*TOP* (,(xml (ns 1) 'a))))
-       ;; (ns 1) hard coded to work with match
-       (`(*TOP* (,el (@ (,key "http://example.com/1"))))
-        (let ((el-pair  (string-split (symbol->string el) #\:))
-              (key-pair (string-split (symbol->string key) #\:)))
-          (test-equal "a" (cadr el-pair))
-          (test-equal "xmlns" (car key-pair))
-          (test-equal (car el-pair) (cadr key-pair))))
-       (any
-        (test-assert (format #f "Match failed: ~s" any) #f))))))
-
-;; (namespaced-sxml->xml)
-;; Literal strings
-
-
-(test-error "Namespaces x is missing, note error"
-  'parser-error
-  (xml->namespaced-sxml "<x:a xmlns:y=\"http://example.com/1\"><x:b/></x:a>"
-                        ; `((x . ,(ns 1)))
-                        ))
-
-'((sxml namespaced))
diff --git a/tests/unit/util/xml-namespace.scm b/tests/unit/util/xml-namespace.scm
deleted file mode 100644
index 2b6ea174..00000000
--- a/tests/unit/util/xml-namespace.scm
+++ /dev/null
@@ -1,38 +0,0 @@
-(define-module (test xml-namespace)
-  :use-module (srfi srfi-64)
-  :use-module (srfi srfi-88)
-  :use-module ((sxml namespace) :select (move-to-namespace)))
-
-(test-equal
-  "Move unnamespaced to namespace"
-  '(NEW:test)
-  (move-to-namespace '(test) '((#f . NEW))))
-
-(test-equal
-  "Swap namespaces"
-  '(b:a (a:b))
-  (move-to-namespace
-    '(a:a (b:b))
-    '((a . b) (b . a))))
-
-(test-equal
-  "Remove all namespaces"
-  '(a (b))
-  (move-to-namespace '(a:a (b:b)) #f))
-
-(test-equal
-  "Move everything to one namespace"
-  '(c:a (c:b))
-  (move-to-namespace '(a:a (b:b)) 'c))
-
-(test-equal
-  "Partial namespace change"
-  '(c:a (b:b))
-  (move-to-namespace '(a:a (b:b)) '((a . c))))
-
-(test-equal
-  "Remove specific namespace"
-  '(a:a (b))
-  (move-to-namespace '(a:a (b:b)) '((b . #f))))
-
-'((sxml namespace))