From 43f3d10a1f5d4ef2bb80d7f0e32d170f8e69a5ac Mon Sep 17 00:00:00 2001 From: David Lichteblau Date: Sun, 13 Apr 2008 17:28:58 +0200 Subject: [PATCH] More encoding tweaks --- TEST | 163 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++--- test.lisp | 31 ++++++++++-- xslt.lisp | 38 +++++++++------ 3 files changed, 205 insertions(+), 27 deletions(-) diff --git a/TEST b/TEST index 82008bd..f47f57e 100644 --- a/TEST +++ b/TEST @@ -1,3 +1,156 @@ +; in: +; LAMBDA (#:G2393 #:G2394 #:G2395 #:G2396 #:G2397 #:G2398 #:G2399 #:G2400 +; #:G2401 #:G2408 #:G2409) +; (IF (TYPEP SB-PCL::.ARG1. 'XPATH::DOM-NAMESPACE) #:G2393 #:G2394) +; +; note: deleting unreachable code + +; (TYPEP SB-PCL::.ARG1. 'XPATH::DOM-NAMESPACE) +; --> SB-C::%INSTANCE-TYPEP +; ==> +; SB-PCL::.ARG1. +; +; note: deleting unreachable code +; +; compilation unit finished +; printed 2 notes +; in: +; LAMBDA (#:G2439 #:G2440 #:G2441 #:G2442 #:G2443 #:G2444 #:G2445 #:G2446 +; #:G2447 #:G2448 #:G2449 #:G2450 ...) +; (TYPEP SB-PCL::.ARG2. 'CXML-STP-IMPL::STP-NAMESPACE) +; --> SB-C::%INSTANCE-TYPEP +; ==> +; SB-PCL::.ARG2. +; +; note: deleting unreachable code + +; (IF (TYPEP SB-PCL::.ARG2. 'XPATH::DOM-NAMESPACE) #:G2439 #:G2440) +; +; note: deleting unreachable code + +; (IF (TYPEP SB-PCL::.ARG1. 'XPATH::DOM-NAMESPACE) +; (IF (TYPEP SB-PCL::.ARG2. 'XURIELLA::STRIPPING-NODE) +; (IF (TYPEP SB-PCL::.ARG2. 'CXML-STP-IMPL::STP-NAMESPACE) +; (IF (TYPEP SB-PCL::.ARG2. 'XPATH::DOM-NAMESPACE) #:G2439 #:G2440) +; (IF (TYPEP SB-PCL::.ARG2. 'XPATH::DOM-NAMESPACE) #:G2441 +; #:G2442)) +; (IF (TYPEP SB-PCL::.ARG2. 'CXML-STP-IMPL::STP-NAMESPACE) +; (IF (TYPEP SB-PCL::.ARG2. 'XPATH::DOM-NAMESPACE) #:G2443 #:G2444) +; (IF (TYPEP SB-PCL::.ARG2. 'XPATH::DOM-NAMESPACE) #:G2445 +; #:G2446))) +; (IF (TYPEP SB-PCL::.ARG2. 'XURIELLA::STRIPPING-NODE) +; (IF (TYPEP SB-PCL::.ARG2. 'CXML-STP-IMPL::STP-NAMESPACE) #:G2447 +; #:G2448) +; (IF (TYPEP SB-PCL::.ARG2. 'CXML-STP-IMPL::STP-NAMESPACE) #:G2449 +; #:G2450))) +; +; note: deleting unreachable code + +; (TYPEP SB-PCL::.ARG2. 'XPATH::DOM-NAMESPACE) +; --> SB-C::%INSTANCE-TYPEP +; ==> +; SB-PCL::.ARG2. +; +; note: deleting unreachable code +; +; note: deleting unreachable code + +; (TYPEP SB-PCL::.ARG1. 'XPATH::DOM-NAMESPACE) +; --> SB-C::%INSTANCE-TYPEP +; ==> +; SB-PCL::.ARG1. +; +; note: deleting unreachable code + +; (TYPEP SB-PCL::.ARG2. 'XURIELLA::STRIPPING-NODE) +; --> SB-C::%INSTANCE-TYPEP +; ==> +; SB-PCL::.ARG2. +; +; note: deleting unreachable code + +; (TYPEP SB-PCL::.ARG2. 'CXML-STP-IMPL::STP-NAMESPACE) +; --> SB-C::%INSTANCE-TYPEP +; ==> +; SB-PCL::.ARG2. +; +; note: deleting unreachable code + +; (TYPEP SB-PCL::.ARG2. 'XPATH::DOM-NAMESPACE) +; --> SB-C::%INSTANCE-TYPEP +; ==> +; SB-PCL::.ARG2. +; +; note: deleting unreachable code +; +; note: deleting unreachable code + +; (TYPEP SB-PCL::.ARG2. 'CXML-STP-IMPL::STP-NAMESPACE) +; --> SB-C::%INSTANCE-TYPEP +; ==> +; SB-PCL::.ARG2. +; +; note: deleting unreachable code + +; (TYPEP SB-PCL::.ARG2. 'XPATH::DOM-NAMESPACE) +; --> SB-C::%INSTANCE-TYPEP +; ==> +; SB-PCL::.ARG2. +; +; note: deleting unreachable code +; +; note: deleting unreachable code + +; (TYPEP SB-PCL::.ARG2. 'XURIELLA::STRIPPING-NODE) +; --> SB-C::%INSTANCE-TYPEP +; ==> +; SB-PCL::.ARG2. +; +; note: deleting unreachable code + +; (TYPEP SB-PCL::.ARG2. 'CXML-STP-IMPL::STP-NAMESPACE) +; --> SB-C::%INSTANCE-TYPEP +; ==> +; SB-PCL::.ARG2. +; +; note: deleting unreachable code +; +; note: deleting unreachable code + +; (TYPEP SB-PCL::.ARG2. 'XURIELLA::STRIPPING-NODE) +; --> SB-C::%INSTANCE-TYPEP +; ==> +; SB-PCL::.ARG2. +; +; note: deleting unreachable code + +; (TYPEP SB-PCL::.ARG2. 'XPATH::DOM-NAMESPACE) +; --> SB-C::%INSTANCE-TYPEP +; ==> +; SB-PCL::.ARG2. +; +; note: deleting unreachable code +; +; note: deleting unreachable code +; +; compilation unit finished +; printed 19 notes +; in: +; LAMBDA (#:G2543 #:G2544 #:G2545 #:G2546 #:G2547 #:G2548 #:G2549 #:G2550 +; #:G2554 #:G2555) +; (TYPEP SB-PCL::.ARG0. 'RUNES::OCTET-VECTOR-YSTREAM) +; --> SB-C::%INSTANCE-TYPEP +; ==> +; SB-PCL::.ARG0. +; +; note: deleting unreachable code + +; (IF (TYPEP SB-PCL::.ARG0. 'RUNES::OCTET-VECTOR-YSTREAM) #:G2543 #:G2544) +; +; note: deleting unreachable code +; +; compilation unit finished +; printed 2 notes PASS attribset_attribset01 [XSLT-Result-Tree] Stylesheet: Xalan_Conformance_Tests/attribset/attribset01.noindent-xsl Data: Xalan_Conformance_Tests/attribset/attribset01.xml @@ -6410,7 +6563,7 @@ WARNING: comparison failed: Corrupted UTF-8 input (initial byte was #b10100111) WARNING: comparison failed: Corrupted UTF-8 input (initial byte was #b10010110) -FAIL output_output22 [XSLT-Result-Tree]: output doesn't match +KNOWNFAIL output_output22 [XSLT-Result-Tree]: output doesn't match Stylesheet: Xalan_Conformance_Tests/output/output22.noindent-xsl Data: Xalan_Conformance_Tests/output/output22.xml Expected output (1): Xalan_Conformance_Tests/output/output_output22.saxon @@ -11123,15 +11276,13 @@ PASS BVTs_bvt015 [Mixed]: raised an xslt-error as expected Expected output (1): MSFT_Conformance_Tests/BVTs/BVTs_bvt015.saxon Actual output: MSFT_Conformance_Tests/BVTs/BVTs_bvt015.xuriella -FAIL BVTs_bvt017 [Mixed]: condition of incorrect type: -Unable to encode character code point 32000 as :ISO-8859-1. +PASS BVTs_bvt017 [Mixed]: raised an xslt-error as expected Stylesheet: MSFT_Conformance_Tests/BVTs/encoding00.noindent-xsl Data: MSFT_Conformance_Tests/BVTs/data.xml Expected output (1): MSFT_Conformance_Tests/BVTs/BVTs_bvt017.saxon Actual output: MSFT_Conformance_Tests/BVTs/BVTs_bvt017.xuriella -FAIL BVTs_bvt018 [Mixed]: condition of incorrect type: -Unable to encode character code point 218 as :ISO-8859-5. +PASS BVTs_bvt018 [Mixed]: raised an xslt-error as expected Stylesheet: MSFT_Conformance_Tests/BVTs/encoding01.noindent-xsl Data: MSFT_Conformance_Tests/BVTs/data.xml Expected output (1): MSFT_Conformance_Tests/BVTs/BVTs_bvt018.saxon @@ -19462,4 +19613,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 2831/3082 tests. +Passed 2834/3082 tests. diff --git a/test.lisp b/test.lisp index 03a025b..898a146 100644 --- a/test.lisp +++ b/test.lisp @@ -77,6 +77,7 @@ (defun map-original-tests (run-test source &key (test (constantly t))) (let ((total 0) (pass 0) + (known 0) major-path) (loop while (klacks:find-event source :start-element) @@ -95,11 +96,16 @@ (test-case (parse-original-test major-path ))) (when (funcall test test-case) (incf total) - (when (funcall run-test test-case) - (incf pass))))) + (ecase (funcall run-test test-case) + ((nil)) + ((t) + (incf pass)) + (:known-failure + (incf known)))))) (t (klacks:skip source :start-element)))) - (format t "~&Passed ~D/~D tests.~%" pass total))) + (format t "~&Passed ~D/~D tests (~D known failures).~%" + pass total known))) (defun parse-original-test (major-path ) (let* ((file-path @@ -352,6 +358,13 @@ "Namespace-alias__91782" "AttributeSets__91038")) +(defparameter *known-failures* + '( + ;; uses EBCDIC-CP-IT (whatever that is), but Babel's only got EBCDIC-US. + ;; Doesn't actually test any differences between the two, so it's + ;; probably just there to annoy us. + "output_output22")) + (defun run-tests (&key filter (directory *tests-directory*)) (when (typep filter '(or string cons)) (setf filter (cl-ppcre:create-scanner filter))) @@ -797,8 +810,16 @@ (write-string (replace-junk (strip-addresses - (format nil "~&~:[FAIL~;PASS~] ~A [~A]~?~%" - ok + (format nil "~&~A ~A [~A]~?~%" + (cond + (ok "PASS") + ((find (test-id test) + *known-failures* + :test #'equal) + (setf ok :known-failure) + "KNOWNFAIL") + (t + "FAIL")) (test-id test) (test-category test) fmt diff --git a/xslt.lisp b/xslt.lisp index d6e5e63..776b7bb 100644 --- a/xslt.lisp +++ b/xslt.lisp @@ -86,15 +86,21 @@ (,doit) ,@clauses))))) -(defmacro with-xpath-errors ((&optional) &body body) - `(handler-bind - ((xpath:xpath-error - (lambda (c) - (xslt-error "~A" c)))) - ,@body)) +(defmacro with-resignalled-errors ((&optional) &body body) + `(invoke-with-resignalled-errors (lambda () ,@body))) + +(defun invoke-with-resignalled-errors (fn) + (handler-bind + ((xpath:xpath-error + (lambda (c) + (xslt-error "~A" c))) + (babel-encodings:character-encoding-error + (lambda (c) + (xslt-error "~A" c)))) + (funcall fn))) (defun compile-xpath (xpath &optional env) - (with-xpath-errors () + (with-resignalled-errors () (xpath:compile-xpath xpath env))) (defmacro with-stack-limit ((&optional) &body body) @@ -592,7 +598,7 @@ (parse-1-stylesheet env stylesheet stream uri-resolver))))) (defun parse-stylesheet (designator &key uri-resolver) - (with-xpath-errors () + (with-resignalled-errors () (xpath:with-namespaces ((nil #.*xsl*)) (let* ((*import-priority* 0) (xpath:*allow-variables-in-patterns* nil) @@ -1251,9 +1257,9 @@ (lambda (c) (xslt-error "cannot parse stylesheet: ~A" c)))) (parse-stylesheet stylesheet)))) - (invoke-with-output-sink - (lambda () - (with-xpath-errors () + (with-resignalled-errors () + (invoke-with-output-sink + (lambda () (let* ((*documents* (make-hash-table :test 'equal)) (xpath:*navigator* (or navigator :default-navigator)) (puri:*strict-parse* nil) @@ -1299,9 +1305,9 @@ ;; everywhere instead of EVALUATE, so let's paper over that ;; at a central place to be sure: (xpath::with-float-traps-masked () - (apply-templates ctx :mode *default-mode*))))) - (stylesheet-output-specification stylesheet) - output)) + (apply-templates ctx :mode *default-mode*)))) + (stylesheet-output-specification stylesheet) + output))) (defun find-attribute-set (local-name uri) (or (gethash (cons local-name uri) (stylesheet-attribute-sets *stylesheet*)) @@ -1540,7 +1546,7 @@ 0.5))) (defun parse-xpath (str) - (with-xpath-errors () + (with-resignalled-errors () (xpath:parse-xpath str))) (defun parse-key-pattern (str) @@ -1555,7 +1561,7 @@ `(:union ,@parsed)))) (defun parse-pattern (str) - (with-xpath-errors () + (with-resignalled-errors () (cdr (xpath::parse-pattern-expression str)))) (defun compile-value-thunk (value env) -- 2.11.4.GIT