From f9db71e1bc0e135b07b164190dbd34ab7b7d3b3a Mon Sep 17 00:00:00 2001
From: David Lichteblau <david@lichteblau.com>
Date: Tue, 15 Apr 2008 19:21:04 +0200
Subject: [PATCH] Some xsl:number fixes

---
 TEST        |  9 ++++-----
 number.lisp | 55 +++++++++++++++++++++++++++++++++----------------------
 2 files changed, 37 insertions(+), 27 deletions(-)

diff --git a/TEST b/TEST
index d338476..dadcaf4 100644
--- a/TEST
+++ b/TEST
@@ -11337,8 +11337,7 @@ PASS BVTs_bvt060 [Mixed]
   Expected output (1): MSFT_Conformance_Tests/BVTs/BVTs_bvt060.saxon
   Actual output: MSFT_Conformance_Tests/BVTs/BVTs_bvt060.xuriella
 
-FAIL BVTs_bvt061 [Mixed]: arithmetic error DIVISION-BY-ZERO signalled
-Operation was SB-KERNEL::DIVISION, operands (5 0).
+FAIL BVTs_bvt061 [Mixed]: output doesn't match
   Stylesheet: MSFT_Conformance_Tests/BVTs/num.noindent-xsl
   Data: MSFT_Conformance_Tests/BVTs/data.xml
   Expected output (1): MSFT_Conformance_Tests/BVTs/BVTs_bvt061.saxon
@@ -15625,7 +15624,7 @@ FAIL Number__91026 [XSLT-Result-Tree]: output doesn't match
   Expected output (1): MSFT_Conformance_Tests/Number/Number__91026.saxon
   Actual output: MSFT_Conformance_Tests/Number/Number__91026.xuriella
 
-FAIL Number__91027 [XSLT-Result-Tree]: output doesn't match
+PASS Number__91027 [XSLT-Result-Tree]
   Stylesheet: MSFT_Conformance_Tests/Number/91027.noindent-xsl
   Data: MSFT_Conformance_Tests/Number/91027.xml
   Expected output (1): MSFT_Conformance_Tests/Number/Number__91027.saxon
@@ -15681,7 +15680,7 @@ PASS Number_format01 [XSLT-Result-Tree]
   Expected output (1): MSFT_Conformance_Tests/Number/Number_format01.saxon
   Actual output: MSFT_Conformance_Tests/Number/Number_format01.xuriella
 
-FAIL Number_NaNOrInvalidValue [XSLT-Result-Tree]: output doesn't match
+PASS Number_NaNOrInvalidValue [XSLT-Result-Tree]
   Stylesheet: MSFT_Conformance_Tests/Number/xslt_xsl_number_invalid_value.noindent-xsl
   Data: MSFT_Conformance_Tests/Number/foo.xml
   Expected output (1): MSFT_Conformance_Tests/Number/Number_NaNOrInvalidValue.saxon
@@ -19454,4 +19453,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 2841/3081 tests (3 expected failures, 237 unexpected failures).
+Passed 2843/3081 tests (3 expected failures, 235 unexpected failures).
diff --git a/number.lisp b/number.lisp
index ee8b54d..a992cab 100644
--- a/number.lisp
+++ b/number.lisp
@@ -29,6 +29,16 @@
 
 (in-package :xuriella)
 
+(defun xsl-number-value (y)
+  (let ((x (xpath:number-value y)))
+    (if (or (< x 0.5)
+            (xpath::nan-p x)
+            (xpath::inf-p x)
+            (>= x (expt 2 31))          ;-(
+            )
+        (xpath:string-value x)
+        (round (xpath::xnum-round x)))))
+
 (define-instruction xsl:number (args env)
   (destructuring-bind (&key level count from value format lang letter-value
                             grouping-separator grouping-size)
@@ -44,12 +54,7 @@
           (grouping-size (and grouping-size (compile-avt grouping-size env))))
       (lambda (ctx)
         (let ((value              (when value
-                                    (let ((x
-                                           (xpath:number-value
-                                            (funcall value ctx))))
-                                      (if (xpath::nan-p x)
-                                          x
-                                          (round (xpath::xnum-round x))))))
+                                    (xsl-number-value (funcall value ctx))))
               (format             (funcall format ctx))
               (lang               (funcall lang ctx))
               (letter-value       (funcall letter-value ctx))
@@ -58,19 +63,21 @@
               (grouping-size      (when grouping-size
                                     (xpath:number-value
                                      (funcall grouping-size ctx)))))
-          (write-text
-           (format-number-list
-            (if value
-		(list value)
-                (compute-number-list (or level "single")
-                                     (xpath::context-node ctx)
-                                     count
-                                     from))
-            format
-            lang
-            letter-value
-            grouping-separator
-            grouping-size)))))))
+          (if (stringp value)
+              (write-text value)
+              (write-text
+               (format-number-list
+                (if value
+                    (list value)
+                    (compute-number-list (or level "single")
+                                         (xpath::context-node ctx)
+                                         count
+                                         from))
+                format
+                lang
+                letter-value
+                grouping-separator
+                grouping-size))))))))
 
 (defun pattern-thunk-matches-p (pattern-thunk node)
   (xpath:matching-value pattern-thunk node))
@@ -206,7 +213,8 @@
      for i from (1- (length str)) downto 0
      do
        (write-char c stream)
-       (when (and (zerop (mod i size)) (plusp i))
+       (when (and (plusp size)
+                  (and (zerop (mod i size)) (plusp i)))
 	 (write-string separator stream))))
 
 ;;; fixme: unicode support
@@ -257,8 +265,11 @@
                         str)
                   conses)
             (setf current-text nil)))))
-    (when current-text
-      (setf suffix current-text))
+    (cond
+      (current-text
+       (setf suffix current-text))
+      ((null conses)
+       (setf suffix prefix)))
     (unless conses
       (setf conses (list (cons nil "1"))))
     (let* ((tail-cons (car conses))
-- 
2.11.4.GIT