From c8498f9cb8cd01dba63c37069007fcb7333f8cbb Mon Sep 17 00:00:00 2001
From: David Lichteblau <david@lichteblau.com>
Date: Sat, 26 Apr 2008 15:40:02 +0200
Subject: [PATCH] entity-resolver fixes

---
 TEST      | 10 ++--------
 test.lisp | 22 +++++++++++++++-------
 xslt.lisp | 10 ++++++----
 3 files changed, 23 insertions(+), 19 deletions(-)

diff --git a/TEST b/TEST
index 821cdae..4d75525 100644
--- a/TEST
+++ b/TEST
@@ -13392,13 +13392,7 @@ PASS Import__91155 [XSLT-Structure]: raised an xslt-error as expected
   Expected output (1): MSFT_Conformance_Tests/Import/Import__91155.saxon
   Actual output: MSFT_Conformance_Tests/Import/Import__91155.xuriella
 
-FAIL Import__91156 [XSLT-Structure]: condition of incorrect type: 
-error while parsing arguments to DESTRUCTURING-BIND:
-  invalid number of elements in
-    ("webxtest")
-  to satisfy lambda list
-    (CXML::HOST CXML::DEVICE):
-  exactly 2 expected, but 1 found
+PASS Import__91156 [XSLT-Structure]
   Stylesheet: MSFT_Conformance_Tests/Import/91156.noindent-xsl
   Data: MSFT_Conformance_Tests/Import/books.xml
   Expected output (1): MSFT_Conformance_Tests/Import/Import__91156.saxon
@@ -19388,4 +19382,4 @@ PASS XSLTFunctions_DocumentFuncWithEmptyArg [Mixed]
   Expected output (1): MSFT_Conformance_Tests/XSLTFunctions/XSLTFunctions_DocumentFuncWithEmptyArg.saxon
   Actual output: MSFT_Conformance_Tests/XSLTFunctions/XSLTFunctions_DocumentFuncWithEmptyArg.xuriella
 
-Passed 2931/3080 tests (3 expected failures, 146 unexpected failures).
+Passed 2932/3080 tests (3 expected failures, 145 unexpected failures).
diff --git a/test.lisp b/test.lisp
index 3284dd7..0b9042e 100644
--- a/test.lisp
+++ b/test.lisp
@@ -810,13 +810,21 @@
                       (declare (ignore c))
                       (setf output-method :html))))
       (labels ((uri-resolver (uri)
-                 (if (search "%5c%5c%5c%5cwebxtest%5c%5cmanagedshadow%5c%5cmanaged_b2%5c%5ctestdata%5c%5cxslt%5c%5celement%5c%5cxslt_element_NSShared.xml"
-                             uri)
-                     (cxml::pathname-to-uri
-                      (merge-pathnames
-                       "MSFT_Conformance_Tests/Elements/xslt_element_NSShared.xml"
-                       *tests-directory*))
-                     uri))
+                 (let ((str (puri:render-uri uri nil)))
+                   (cond
+                     ((search "%5c%5c%5c%5cwebxtest%5c%5cmanagedshadow%5c%5cmanaged_b2%5c%5ctestdata%5c%5cxslt%5c%5celement%5c%5cxslt_element_NSShared.xml"
+                              str)
+                      (cxml::pathname-to-uri
+                       (merge-pathnames
+                        "MSFT_Conformance_Tests/Elements/xslt_element_NSShared.xml"
+                        *tests-directory*)))
+                     ((search "webxtest/testcases/91156a.xsl" str)
+                      (cxml::pathname-to-uri
+                       (merge-pathnames
+                        "MSFT_Conformance_Tests/Import/91156a.xsl"
+                        *tests-directory*)))
+                     (t
+                      uri))))
                (doit ()
                  (with-open-file (s actual
                                     :if-exists :rename-and-delete
diff --git a/xslt.lisp b/xslt.lisp
index c5d0f41..e581c9c 100644
--- a/xslt.lisp
+++ b/xslt.lisp
@@ -541,7 +541,7 @@
                                        (xslt-error "include without href"))
                                    (stp:base-uri include)))
              (uri (if uri-resolver
-                      (funcall uri-resolver (puri:render-uri uri nil))
+                      (funcall uri-resolver uri)
                       uri))
              (str (puri:render-uri uri nil))
              (pathname
@@ -674,7 +674,7 @@
 
 (defun parse-imported-stylesheet (env stylesheet uri uri-resolver)
   (let* ((uri (if uri-resolver
-                  (funcall uri-resolver (puri:render-uri uri nil))
+                  (funcall uri-resolver uri)
                   uri))
          (str (puri:render-uri uri nil))
          (pathname
@@ -1221,7 +1221,7 @@
           (puri:merge-uris uri-string (or base-uri "")))
          (resolved-uri
           (if *uri-resolver*
-              (funcall *uri-resolver* (puri:render-uri absolute-uri nil))
+              (funcall *uri-resolver* absolute-uri)
               absolute-uri))
          (pathname
           (handler-case
@@ -1399,6 +1399,8 @@
                  ""))
               ""))))))
 
+;; FIXME: should there be separate uri-resolver arguments for stylesheet
+;; and data?
 (defun apply-stylesheet
     (stylesheet source-designator
      &key output parameters uri-resolver navigator)
@@ -1408,7 +1410,7 @@
               ((cxml:xml-parse-error
                 (lambda (c)
                   (xslt-error "cannot parse stylesheet: ~A" c))))
-            (parse-stylesheet stylesheet))))
+            (parse-stylesheet stylesheet :uri-resolver uri-resolver))))
   (with-resignalled-errors ()
     (invoke-with-output-sink
      (lambda ()
-- 
2.11.4.GIT