Have `sxml->xml' handle `*TOP*' nodes (bug #29260).

* module/sxml/simple.scm (universal-sxslt-rules): Add handler for
  `*TOP*'.  Suggested by Stefan Israelsson Tampe at
  <https://savannah.gnu.org/bugs/index.php?29260>.

* test-suite/Makefile.am (SCM_TESTS): Add `sxml.simple.test'.

* test-suite/tests/sxml.simple.test: New file.

* THANKS: Add Stefan.

diff --git a/THANKS b/THANKS
index cdab840..8593a79 100644 (file)
--- a/THANKS
+++ b/THANKS
@@ -60,6 +60,7 @@ For fixes or providing information which led to a fix:
             Sam Hocevar
        Patrick Horgan
            Ales Hvezda
+         Stefan Israelsson Tampe
           Peter Ivanyi
        Wolfgang Jaehrling
          Aubrey Jaffer

diff --git a/module/sxml/simple.scm b/module/sxml/simple.scm
index a1b4854..115098c 100644 (file)
--- a/module/sxml/simple.scm
+++ b/module/sxml/simple.scm
@@ -1,6 +1,6 @@
 ;;;; (sxml simple) -- a simple interface to the SSAX parser
 ;;;;
-;;;;   Copyright (C) 2009  Free Software Foundation, Inc.
+;;;;   Copyright (C) 2009, 2010  Free Software Foundation, Inc.
 ;;;;    Modified 2004 by Andy Wingo <wingo at pobox dot com>.
 ;;;;    Originally written by Oleg Kiselyov <oleg at pobox dot com> as SXML-to-HTML.scm.
 ;;;; 
@@ -46,6 +46,7 @@ into a form suitable for XML serialization by @code{(sxml transform)}'s
   `((@ 
      ((*default* . ,(lambda (attr-key . value) ((enattr attr-key) value))))
      . ,(lambda (trigger . value) (list '@ value)))
+    (*TOP*       . ,(lambda (tag . xml) xml))
     (*ENTITY*    . ,(lambda (tag name) (list "&" name ";")))
     (*PI*    . ,(lambda (pi tag str) (list "<?" tag " " str "?>")))
     ;; Is this right for entities? I don't have a reference for

diff --git a/test-suite/Makefile.am b/test-suite/Makefile.am
index eed9618..0f49d05 100644 (file)
--- a/test-suite/Makefile.am
+++ b/test-suite/Makefile.am
@@ -107,6 +107,7 @@ SCM_TESTS = tests/00-initial-env.test               \
            tests/strings.test                  \
            tests/structs.test                  \
            tests/sxml.fold.test                \
+           tests/sxml.simple.test              \
            tests/sxml.ssax.test                \
            tests/sxml.transform.test           \
            tests/sxml.xpath.test               \

diff --git a/test-suite/tests/sxml.simple.test b/test-suite/tests/sxml.simple.test
new file mode 100644 (file)
index 0000000..623f13e
--- /dev/null
+++ b/test-suite/tests/sxml.simple.test
@@ -0,0 +1,52 @@
+;;;; sxml.simple.test --- (sxml simple)  -*- mode: scheme; coding: utf-8; -*-
+;;;;
+;;;;   Copyright (C) 2010 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 %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>"))
+
+\f
+(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))))))))))