diff options
Diffstat (limited to 'test-suite/tests/sxml.simple.test')
-rw-r--r-- | test-suite/tests/sxml.simple.test | 135 |
1 files changed, 135 insertions, 0 deletions
diff --git a/test-suite/tests/sxml.simple.test b/test-suite/tests/sxml.simple.test new file mode 100644 index 000000000..e52ba319d --- /dev/null +++ b/test-suite/tests/sxml.simple.test @@ -0,0 +1,135 @@ +;;;; sxml.simple.test --- (sxml simple) -*- mode: scheme; coding: utf-8; -*- +;;;; +;;;; Copyright (C) 2010, 2013 Free Software Foundation, Inc. +;;;; +;;;; This library is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU Lesser General Public +;;;; License as published by the Free Software Foundation; either +;;;; version 3 of the License, or (at your option) any later version. +;;;; +;;;; This library is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;;; Lesser General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU Lesser General Public +;;;; License along with this library; if not, write to the Free Software +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +(define-module (test-sxml-simple) + #:use-module (test-suite lib) + #:use-module (sxml simple)) + +(define parser-error '(parser-error . "")) + +(define %xml-sample + ;; An XML sample without any space in between tags, to make it easier. + (string-append "<?xml version='1.0' encoding='utf-8'?>" + "<foo chbouib=\"yes\">" + "<bar/>" + "<baz>" + "<smurf one=\"1\"/>" + "</baz>" + "</foo>")) + + +(with-test-prefix "simple" + + (pass-if "xml->sxml" + (equal? (xml->sxml (open-input-string %xml-sample)) + '(*TOP* + (*PI* xml "version='1.0' encoding='utf-8'") + (foo (@ (chbouib "yes")) + (bar) + (baz (smurf (@ (one "1")))))))) + + (pass-if "xml->sxml->xml->sxml" + ;; Regression test for bug #29260. + (equal? (xml->sxml (open-input-string %xml-sample)) + (xml->sxml + (open-input-string + (with-output-to-string + (lambda () + (sxml->xml + (xml->sxml (open-input-string %xml-sample)))))))))) + +(with-test-prefix "namespaces" + (pass-if-equal + (xml->sxml "<foo xmlns=\"http://example.org/ns1\">text</foo>") + '(*TOP* (http://example.org/ns1:foo "text"))) + + (pass-if-equal + (xml->sxml "<foo xmlns=\"http://example.org/ns1\">text</foo>" + #:namespaces '((ns1 . "http://example.org/ns1"))) + '(*TOP* (ns1:foo "text"))) + + (pass-if-equal + (xml->sxml "<foo xmlns:bar=\"http://example.org/ns2\"><bar:baz/></foo>" + #:namespaces '((ns2 . "http://example.org/ns2"))) + '(*TOP* (foo (ns2:baz)))) + + (pass-if-equal + (xml->sxml "<foo><ns2:baz/></foo>" + #:namespaces '((ns2 . "http://example.org/ns2"))) + '(*TOP* (foo (ns2:baz)))) + + (pass-if-exception "namespace undeclared" parser-error + (xml->sxml "<foo><ns2:baz/></foo>" + #:namespaces '((ns2 . "http://example.org/ns2")) + #:declare-namespaces? #f))) + +(with-test-prefix "whitespace" + (pass-if-equal + (xml->sxml "<foo>\n<bar> Alfie the parrot! </bar>\n</foo>") + '(*TOP* (foo "\n" (bar " Alfie the parrot! ") "\n"))) + + (pass-if-equal + (xml->sxml "<foo>\n<bar> Alfie the parrot! </bar>\n</foo>" + #:trim-whitespace? #t) + '(*TOP* (foo (bar " Alfie the parrot! "))))) + +(with-test-prefix "parsed entities" + (pass-if-equal + '(*TOP* (foo "&")) + (xml->sxml "<foo>&</foo>")) + + (pass-if-exception "nbsp undefined" parser-error + (xml->sxml "<foo> </foo>")) + + (pass-if-equal + '(*TOP* (foo "\xA0")) + (xml->sxml "<foo> </foo>" + #:entities '((nbsp . "\xA0")))) + + (pass-if-equal + '(*TOP* (foo "\xA0")) + (xml->sxml "<foo> </foo>")) + + (let ((ents '())) + (pass-if-equal + (xml->sxml "<foo> &foo;</foo>" + #:default-entity-handler + (lambda (port name) + (case name + ((nbsp) "\xa0") + (else + (set! ents (cons name ents)) + "qux")))) + '(*TOP* (foo "\xa0 qux"))) + + (pass-if-equal + ents + '(foo)))) + +(with-test-prefix "doctype handlers" + (define (handle-foo docname systemid internal-subset) + (case docname + ((foo) + (values #:entities '((greets . "<i>Hello, world!</i>")))) + (else + (values)))) + + (pass-if-equal + (xml->sxml "<!DOCTYPE foo><p>&greets;</p>" + #:doctype-handler handle-foo) + '(*TOP* (p (i "Hello, world!"))))) |