From 9ca40a2b90607cd33577644c5cd5d38ae5fe1354 Mon Sep 17 00:00:00 2001
From: Raymond Toy <toy.raymond@gmail.com>
Date: Thu, 28 Aug 2014 19:37:32 -0700
Subject: [PATCH] Fix round-quotient-bound to handle exclusive bounds better.

All the tests should pass now.
---
 src/compiler/srctran.lisp | 33 ++++++++++++++++++++++++++-------
 1 file changed, 26 insertions(+), 7 deletions(-)

diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index c2e1a83f5..14c353c10 100644
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -1768,13 +1768,32 @@
   (flet ((round-it (quot)
 	   (let ((lo (interval-low quot))
 		 (hi (interval-high quot)))
-	     (setf lo (if lo
-			  (round (bound-value lo))
-			  nil))
-	     ;; For the upper bound, we need to be careful
-	     (setf hi (if hi
-			  (round (bound-value hi))
-			  nil))
+	     (when lo
+		 ;; Need to handle carefully the case where the lower
+		 ;; bound is exclusive.  This is only a problem when
+		 ;; the remainder is exactly +1/2 where the quotient
+		 ;; has been rounded down. In this case, quotient
+		 ;; should be one higher.  For example (round 2.5) ->
+		 ;; 2, 0.5, but (round 2.500001) -> 3, -0.49999.
+	       (multiple-value-bind (q r)
+		   (round (bound-value lo))
+		 (setf lo
+		       (if (and (consp lo) (= r 1/2))
+			   (1+ q)
+			   q))))
+	     (when hi
+	       (multiple-value-bind (q r)
+		   (round (bound-value hi))
+		 ;; Need to handle carefully the case where the upper
+		 ;; bound is exclusive.  This is only a problem when
+		 ;; the remainder is exactly -1/2 where the quotient
+		 ;; has been rounded up. In this case, quotient should
+		 ;; be one less. For example but (round 1.5) -> 2,
+		 ;; -0.5 but (round 1.49999) -> 1, .49999.
+		 (setf hi
+		       (if (and (= r -1/2) (consp hi))
+			   (1- q)
+			   q))))
 	     (make-interval :low lo :high hi))))
     (case (interval-range-info quot)
       (+
-- 
GitLab