* bug#68232: [PATCH] Fix range-intersection implementation
@ 2024-01-03 3:30 Zachary Romero
2024-01-11 20:56 ` Stefan Kangas
0 siblings, 1 reply; 3+ messages in thread
From: Zachary Romero @ 2024-01-03 3:30 UTC (permalink / raw)
To: 68232
[-- Attachment #1: Type: text/plain, Size: 2133 bytes --]
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/openssl@1.1/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/openssl@1.1/lib
-L/usr/local/lib -F/usr/local/Frameworks
-Wl,-headerpad_max_install_names
-isysroot/Library/Developer/CommandLineTools/SDKs/MacOSX12.sdk''
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Fix-range-intersection-implementation.patch --]
[-- Type: text/patch, Size: 4027 bytes --]
From b26e822e815c97686e9b7c5e712332eef78ba039 Mon Sep 17 00:00:00 2001
From: Zachary Romero <zacromero@posteo.net>
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)
^ permalink raw reply related [flat|nested] 3+ messages in thread
* bug#68232: [PATCH] Fix range-intersection implementation
2024-01-03 3:30 bug#68232: [PATCH] Fix range-intersection implementation Zachary Romero
@ 2024-01-11 20:56 ` Stefan Kangas
2024-01-12 2:44 ` zacromero
0 siblings, 1 reply; 3+ messages in thread
From: Stefan Kangas @ 2024-01-11 20:56 UTC (permalink / raw)
To: Zachary Romero; +Cc: 68232, Lars Magne Ingebrigtsen
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?
^ permalink raw reply [flat|nested] 3+ messages in thread
* bug#68232: [PATCH] Fix range-intersection implementation
2024-01-11 20:56 ` Stefan Kangas
@ 2024-01-12 2:44 ` zacromero
0 siblings, 0 replies; 3+ messages in thread
From: zacromero @ 2024-01-12 2:44 UTC (permalink / raw)
To: Stefan Kangas; +Cc: 68232, Lars Magne Ingebrigtsen
[-- 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)
^ permalink raw reply related [flat|nested] 3+ messages in thread
end of thread, other threads:[~2024-01-12 2:44 UTC | newest]
Thread overview: 3+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2024-01-03 3:30 bug#68232: [PATCH] Fix range-intersection implementation Zachary Romero
2024-01-11 20:56 ` Stefan Kangas
2024-01-12 2:44 ` zacromero
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).