From 12ba80ce43a8f837b9d4ae58ac39613558fe4835 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Tue, 18 Apr 2023 19:33:37 +0200 Subject: 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. --- module/hnh/test/xmllint.scm | 27 +++++++++++++++++++++++++++ 1 file changed, 27 insertions(+) create mode 100644 module/hnh/test/xmllint.scm (limited to 'module/hnh/test/xmllint.scm') 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)))) -- cgit v1.2.3