[oct-cvs] Oct commit: oct qd.lisp rt-tests.lisp

[rtoy]

Update of /project/oct/cvsroot/oct
In directory clnet:/tmp/cvs-serv28447

Modified Files:
	qd.lisp rt-tests.lisp 
Log Message:
qd.lisp:
o Oops.  In INTEGER-DECODE-QD, the signs of the parts were not
  computed correctly when combining them into the final integer
  result.

rt-tests.lisp:
o Add a test for INTEGER-DECODE-QD.
o Use OCT as the package, not QD.


--- /project/oct/cvsroot/oct/qd.lisp	2007/10/13 15:34:51	1.55
+++ /project/oct/cvsroot/oct/qd.lisp	2007/10/15 15:45:33	1.56
@@ -1135,19 +1135,19 @@
     (multiple-value-bind (q1-int q1-exp q1-sign)
 	(integer-decode-float (qd-1 q))
       (setf q0-int (+ (ash q0-int (- q0-exp q1-exp))
-		      (* q1-sign q1-int)))
+		      (* q0-sign q1-sign q1-int)))
       (when (zerop (qd-2 q))
 	(return-from integer-decode-qd (values q0-int q1-exp q0-sign)))
       (multiple-value-bind (q2-int q2-exp q2-sign)
 	  (integer-decode-float (qd-2 q))
 	(setf q0-int (+ (ash q0-int (- q1-exp q2-exp))
-			(* q2-sign q2-int)))
+			(* q0-sign q2-sign q2-int)))
 	(when (zerop (qd-3 q))
 	  (return-from integer-decode-qd (values q0-int q2-exp q0-sign)))
 	(multiple-value-bind (q3-int q3-exp q3-sign)
 	    (integer-decode-float (qd-3 q))
 	  (values (+ (ash q0-int (- q2-exp q3-exp))
-		     (* q3-sign q3-int))
+		     (* q0-sign q3-sign q3-int))
 		  q3-exp
 		  q0-sign))))))
 
--- /project/oct/cvsroot/oct/rt-tests.lisp	2007/10/13 02:14:43	1.3
+++ /project/oct/cvsroot/oct/rt-tests.lisp	2007/10/15 15:45:33	1.4
@@ -51,7 +51,7 @@
 (rt:deftest oct.pi.machin
     (let* ((*standard-output* *null*)
 	   (val (make-instance 'qd-real :value (qdi::test2 nil)))
-	   (true qd:+pi+))
+	   (true oct:+pi+))
       (check-accuracy 213 val true))
   nil)
 
@@ -59,7 +59,7 @@
 (rt:deftest oct.pi.salamin-brent
     (let* ((*standard-output* *null*)
 	   (val (make-instance 'qd-real :value (qdi::test3 nil)))
-	   (true qd:+pi+))
+	   (true oct:+pi+))
       (check-accuracy 202 val true))
   nil)
 
@@ -67,7 +67,7 @@
 (rt:deftest oct.pi.borweign
     (let* ((*standard-output* *null*)
 	   (val (make-instance 'qd-real :value (qdi::test4 nil)))
-	   (true qd:+pi+))
+	   (true oct:+pi+))
       (check-accuracy 211 val true))
   nil)
 
@@ -545,3 +545,18 @@
 	   (true #q7.888609052210118054117285652830973804370994921943802079729680186943164342372119432861876389514693341738324702996270767390039172777809233288470357147q-31))
       (check-accuracy 211 y true))
   nil)
+
+;; If we screw up integer-decode-qd, printing is wrong.  Here is one
+;; case where integer-decode-qd was screwed up and printing the wrong
+;; thing.
+(rt:deftest oct.integer-decode.1
+    (multiple-value-bind (frac exp s)
+	(qdi:integer-decode-qd (qdi::%make-qd-d -0.03980126756814893d0
+						-2.7419792323327893d-18
+						0d0 0d0))
+      (unless (and (eql frac 103329998279901916046530991816704)
+		   (eql exp -111)
+		   (eql s -1))
+	(list frac exp s)))
+  nil)
+