bug#68232: [PATCH] Fix range-intersection implementation

[zacromero@posteo.net]

[-- Attachment #1: Type: text/plain, Size: 1213 bytes --]

Thanks for pointing me to the tests. Attached is an updated patch with 
the added test cases and the range tests all pass.

On 11.01.2024 21:56, Stefan Kangas wrote:
> Zachary Romero <zacromero@posteo.net> writes:
> 
>> Hello Emacs maintainers,
>> 
>> I was using the range package when I encountered a bug in the
>> implementation of range-intersection.  The bug seems to occur when the
>> ranges involve a mix of integers and cons pairs.  The following are 
>> some
>> cases where the current implementation fails to compute the correct
>> intersection:
>> 
>> (range-intersection '((1 . 10) 11) '((11 . 12)))
>> ;; Expects (11), returns nil
>> 
>> (range-intersection '(11 (13 . 15)) '((13 . 15)))
>> ;; Expects (13 . 15), returns nil
>> 
>> (range-intersection '(1 11 13 15) '((1 . 2) (10 . 20)))
>> ;; Expects (1 11 13 15), returns (1)
>> 
>> 
>> I also refactored this function using pcase to try to make the steps 
>> of
>> the algorithm more understandable.
>> 
>> Let me know you thoughts and if there's any further changes I should
>> make.
> 
> Thanks for the patch.  Could you please add tests for this as well?
> See the file range-tests.el.
> 
> Did you check that the existing tests all still pass?

[-- Attachment #2: 0001-fix-range-intersection-edge-cases.patch --]
[-- Type: application/octet-stream, Size: 5286 bytes --]

From 1beecd1296ff252b41df12d7c68dfb91b50341f2 Mon Sep 17 00:00:00 2001
From: Zachary Romero <zacromero@posteo.net>
Date: Thu, 11 Jan 2024 19:36:36 -0700
Subject: [PATCH] fix range intersection edge cases

---
 lisp/emacs-lisp/range.el            | 81 ++++++++++++++---------------
 test/lisp/emacs-lisp/range-tests.el | 14 +++++
 2 files changed, 52 insertions(+), 43 deletions(-)

diff --git a/lisp/emacs-lisp/range.el b/lisp/emacs-lisp/range.el
index 19a6da34acb..f27649146d6 100644
--- a/lisp/emacs-lisp/range.el
+++ b/lisp/emacs-lisp/range.el
@@ -89,49 +89,44 @@ range-difference
 
 (defun range-intersection (range1 range2)
   "Return intersection of RANGE1 and RANGE2."
-  (let* (out
-         (min1 (car range1))
-         (max1 (if (numberp min1)
-                   (if (numberp (cdr range1))
-                       (prog1 (cdr range1)
-                         (setq range1 nil)) min1)
-                 (prog1 (cdr min1)
-                   (setq min1 (car min1)))))
-         (min2 (car range2))
-         (max2 (if (numberp min2)
-                   (if (numberp (cdr range2))
-                       (prog1 (cdr range2)
-                         (setq range2 nil)) min2)
-                 (prog1 (cdr min2)
-                   (setq min2 (car min2))))))
-    (setq range1 (cdr range1)
-          range2 (cdr range2))
-    (while (and min1 min2)
-      (cond ((< max1 min2)              ; range1 precedes range2
-             (setq range1 (cdr range1)
-                   min1 nil))
-            ((< max2 min1)              ; range2 precedes range1
-             (setq range2 (cdr range2)
-                   min2 nil))
-            (t                     ; some sort of overlap is occurring
-             (let ((min (max min1 min2))
-                   (max (min max1 max2)))
-               (setq out (if (= min max)
-                             (cons min out)
-                           (cons (cons min max) out))))
-             (if (< max1 max2)          ; range1 ends before range2
-                 (setq min1 nil)        ; incr range1
-               (setq min2 nil))))       ; incr range2
-      (unless min1
-        (setq min1 (car range1)
-              max1 (if (numberp min1) min1
-                     (prog1 (cdr min1) (setq min1 (car min1))))
-              range1 (cdr range1)))
-      (unless min2
-        (setq min2 (car range2)
-              max2 (if (numberp min2) min2
-                     (prog1 (cdr min2) (setq min2 (car min2))))
-              range2 (cdr range2))))
+  (let ((out))
+    (while (and range1 range2)
+      (let* ((elt1 (car range1))
+             (elt2 (car range2)))
+        (pcase (list elt1 elt2)
+          (`((,min1 . ,max1) (,min2 . ,max2))
+           (let ((min (max min1 min2))
+                 (max (min max1 max2)))
+             (cond
+              ((< min max)
+               (setq out (cons (cons min max) out)))
+              ((= min max)
+               (setq out (cons min out))))
+             (if (< max1 max2)
+                 (setq range1 (cdr range1))
+               (setq range2 (cdr range2)))))
+          ((and `(,num1 (,min2 . ,max2))
+                (guard (numberp num1)))
+           (when (<= min2 num1 max2)
+             (setq out (cons num1 out)))
+           (if (< max2 num1)
+               (setq range2 (cdr range2))
+             (setq range1 (cdr range1))))
+          ((and `((,min1 . ,max1) ,num2)
+                (guard (numberp num2)))
+           (when (<= min1 num2 max1)
+             (setq out (cons num2 out)))
+           (if (< max1 num2)
+               (setq range1 (cdr range1))
+             (setq range2 (cdr range2))))
+          ((and `(,num1 ,num2)
+                (guard (and (numberp num1)
+                            (numberp num2))))
+           (when (= num1 num2)
+             (setq out (cons num1 out)))
+           (if (< num1 num2)
+               (setq range1 (cdr range1))
+             (setq range2 (cdr range2)))))))
     (cond ((cdr out)
            (nreverse out))
           ((numberp (car out))
diff --git a/test/lisp/emacs-lisp/range-tests.el b/test/lisp/emacs-lisp/range-tests.el
index c680ab5a9cd..dbfce0d8ddf 100644
--- a/test/lisp/emacs-lisp/range-tests.el
+++ b/test/lisp/emacs-lisp/range-tests.el
@@ -40,6 +40,20 @@ ranges
   (should (equal (range-intersection '((2 . 5) 9 (11 . 13))
                                      '((5 . 12)))
                  '(5 9 (11 . 12))))
+  (should (equal (range-intersection '(1 11 13 15)
+                                     '((1 . 2) (10 . 20)))
+                 '(1 11 13 15)))
+  (should (equal (range-intersection '(11 (13 . 15))
+                                     '((13 . 15)))
+                 '(13 . 15)))
+  (should (equal (range-intersection '((1 . 10) 11) '((11 . 12)))
+                 '(11)))
+  (should (equal (range-intersection '((2 . 5) 9 (11 . 13))
+                                     '((2 . 13)))
+                 '((2 . 5) 9 (11 . 13))))
+  (should (equal (range-intersection '((11 . 13))
+                                     '((2 . 10)))
+                 nil))
   (should (equal (range-add-list '((2 . 5) 9 (11 . 13))
                                  '(10 11 12 15 16 17))
                  '((2 . 5) (9 . 10) (11 . 13) (15 . 17))))
-- 
2.37.0 (Apple Git-136)