Add xmllint shell-out for normalizing xml trees.

Used by the serialization format tests which work on xml. Ensures that
they don't fail due to whitespace mismatchs.

I however still need to ensure that all components are arranged in the
correct order, and that namespace prefixes match. This could be
improved.

1 files changed, 27 insertions, 0 deletions

diff --git a/module/hnh/test/xmllint.scm b/module/hnh/test/xmllint.scm
new file mode 100644
index 00000000..95362607
--- /dev/null
+++ b/module/hnh/test/xmllint.scm
@@ -0,0 +1,27 @@
+(define-module (hnh test xmllint)
+  :use-module (srfi srfi-1)
+  :use-module (srfi srfi-71)
+  :use-module (srfi srfi-88)
+  :use-module ((rnrs io ports) :select (get-string-all))
+  :use-module ((hnh util) :select (begin1))
+  :export (xmllint)
+  )
+
+
+(define (xmllint str)
+  (let ((in* out (car+cdr (pipe)))
+        (in out* (car+cdr (pipe)))
+        (cmdline (string-split "xmllint --format -" #\space)))
+    (define pid
+     (spawn (car cmdline) cmdline
+            input: in*
+            output: out*))
+    (close-port in*)
+    (close-port out*)
+
+    (display str out)
+    (force-output out)
+    (close-port out)
+
+    (begin1 (get-string-all in)
+            (close-port in))))