Subject: [PATCH] Fix range-intersection implementation

From: Zachary Romero <[email-masked]>
Date: Wed, 03 Jan 2024 03:30:56 +0000

Tags: patch

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.

In GNU Emacs 29.0.90 (build 1, x86_64-apple-darwin21.6.0, NS
 appkit-2113.60 Version 12.6 (Build 21G115)) of 2023-04-26 built on
 MacBook-Pro.local
Windowing system distributor 'Apple', version 10.3.2113
System Description:  macOS 12.6

Configured using:
 'configure --disable-dependency-tracking --disable-silent-rules
 --enable-locallisppath=/usr/local/share/emacs/site-lisp
 --infodir=/usr/local/Cellar/emacs-plus@29/29.0.60/share/info/emacs
 --prefix=/usr/local/Cellar/emacs-plus@29/29.0.60 --with-xml2
 --with-gnutls --with-native-compilation --without-compress-install
 --with-dbus --without-imagemagick --with-modules --with-rsvg
 --with-xwidgets --with-ns --disable-ns-self-contained 'CFLAGS=-Os -w
 -pipe -march=nehalem -mmacosx-version-min=12
 -isysroot/Library/Developer/CommandLineTools/SDKs/MacOSX12.sdk
 -DFD_SETSIZE=10000 -DDARWIN_UNLIMITED_SELECT'
 'CPPFLAGS=-I/usr/local/opt/zlib/include -I/usr/local/opt/jpeg/include
 -I/usr/local/opt/icu4c/include -I/usr/local/opt/[email-masked]/include
 -F/usr/local/Frameworks
 -isysroot/Library/Developer/CommandLineTools/SDKs/MacOSX12.sdk'
 'LDFLAGS=-L/usr/local/opt/zlib/lib -L/usr/local/opt/jpeg/lib
 -L/usr/local/opt/icu4c/lib -L/usr/local/opt/[email-masked]/lib
 -L/usr/local/lib -F/usr/local/Frameworks
 -Wl,-headerpad_max_install_names
 -isysroot/Library/Developer/CommandLineTools/SDKs/MacOSX12.sdk''

>From b26e822e815c97686e9b7c5e712332eef78ba039 Mon Sep 17 00:00:00 2001
From: Zachary Romero <[email-masked]>
Date: Tue, 12 Dec 2023 21:33:18 -0700
Subject: [PATCH] Fix range-intersection implementation

---
 lisp/emacs-lisp/range.el | 81 +++++++++++++++++++---------------------
 1 file changed, 38 insertions(+), 43 deletions(-)

diff --git a/lisp/emacs-lisp/range.el b/lisp/emacs-lisp/range.el
index f441c240a27..f30a1638ab1 100644
--- a/lisp/emacs-lisp/range.el
+++ b/lisp/emacs-lisp/range.el
@@ -89,50 +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))q
-                       (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))
--
2.37.0 (Apple Git-136)