Subject: bug#75105: (cl-random -1.0e+INF)

From: Pip Cet <[email-masked]>
Date: Tue, 18 Feb 2025 13:05:03 +0000

Pip Cet <[email-masked]> writes:

> "Eli Zaretskii" <[email-masked]> writes:
>
>>> Cc: [email-masked], [email-masked], [email-masked]
>>> From: Stefan Kangas <[email-masked]>
>>> Date: Mon, 17 Feb 2025 22:17:34 +0000
>>>
>>> Mattias Engdegård <[email-masked]> writes:
>>>
>>> > 16 feb. 2025 kl. 01.50 skrev Pip Cet <[email-masked]>:
>>> >
>>> >> (cl-random 0.0) returns 0.0, but one could argue it should throw
>>> >
>>> > It definitely should throw, but perhaps it's not worth the incompatibility? Not sure, because existing code that passes 0.0 is likely buggy anyway.
>>> > Or we could say that it's just an ad-hoc extension, by vague analogy of (car nil) = nil.
>>
>> IMO, signaling an error is only justified if the call (cl-random 0.0)
>> cannot keep the contract of the function according to its doc string.
>> I don't think the value 0.0 it returns breaks the contract.
>
>   "Return a pseudo-random nonnegative number less than LIM, an integer or float.
> Optional second arg STATE is a random-state object."
>
> How is 0.0 a "nonnegative number less than 0.0"?  0.0 isn't less than
> 0.0.
>
> While most users will expect (cl-random 0.0) to return 0.0, which is the
> mathematically sensible thing to do for "a random number between 0.0 and
> 0.0, rounded down", that's not what the docstring currently describes.
>
> We'll just have to hope that no one "optimizes" (* x (cl-random 1.0)) to
> (cl-random x) and breaks existing code.
>
> Pip

Okay for master?

>From de403aa6aaf7525d8523fe620374bcc955cd4b79 Mon Sep 17 00:00:00 2001
From: Pip Cet <[email-masked]>
Subject: [PATCH] Make cl-random behave consistently for unusual arguments
 (bug#75105)

The old behavior was for (cl-random -1.0e+INF) to return NaN in about
one of eight million calls, and -1.0e+INF otherwise.  Other unusual
arguments were handled inconsistently as well.

* lisp/emacs-lisp/cl-extra.el (cl-random): Handle positive finite
arguments consistently, error for nonpositive or infinite arguments.
* test/lisp/emacs-lisp/cl-extra-tests.el (cl-extra-test-random): New
test.
---
 lisp/emacs-lisp/cl-extra.el            | 18 +++++++++++-------
 test/lisp/emacs-lisp/cl-extra-tests.el | 10 ++++++++++
 2 files changed, 21 insertions(+), 7 deletions(-)

diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index ab06682cf93..32b9dfd1aa0 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -494,13 +494,17 @@ cl-random
     (let* ((i (cl-callf (lambda (x) (% (1+ x) 55)) (cl--random-state-i state)))
 	   (j (cl-callf (lambda (x) (% (1+ x) 55)) (cl--random-state-j state)))
 	   (n (aset vec i (logand 8388607 (- (aref vec i) (aref vec j))))))
-      (if (integerp lim)
-	  (if (<= lim 512) (% n lim)
-	    (if (> lim 8388607) (setq n (+ (ash n 9) (cl-random 512 state))))
-	    (let ((mask 1023))
-	      (while (< mask (1- lim)) (setq mask (1+ (+ mask mask))))
-	      (if (< (setq n (logand n mask)) lim) n (cl-random lim state))))
-	(* (/ n '8388608e0) lim)))))
+      (cond
+       ((natnump lim)
+	(if (<= lim 512) (% n lim)
+	  (if (> lim 8388607) (setq n (+ (ash n 9) (cl-random 512 state))))
+	  (let ((mask 1023))
+	    (while (< mask (1- lim)) (setq mask (1+ (+ mask mask))))
+	    (if (< (setq n (logand n mask)) lim) n (cl-random lim state)))))
+       ((< 0 lim 1.0e+INF)
+        (* (/ n '8388608e0) lim))
+       (t
+        (error "Limit %S not supported by cl-random" lim))))))
 
 ;;;###autoload
 (defun cl-make-random-state (&optional state)
diff --git a/test/lisp/emacs-lisp/cl-extra-tests.el b/test/lisp/emacs-lisp/cl-extra-tests.el
index c524f77f2bb..1ca661cdc07 100644
--- a/test/lisp/emacs-lisp/cl-extra-tests.el
+++ b/test/lisp/emacs-lisp/cl-extra-tests.el
@@ -348,4 +348,14 @@ cl-extra-test-tailp
     (should (cl-tailp l l))
     (should (not (cl-tailp '(4 5) l)))))
 
+(ert-deftest cl-extra-test-random ()
+  (should-error (cl-random -1))
+  (should-error (cl-random -0.5))
+  (should-error (cl-random -1.0e+INF))
+  (should-error (cl-random 0))
+  (should-error (cl-random 0.0))
+  (should-error (cl-random -0.0))
+  (should-error (cl-random 1.0e+INF))
+  (should (eql (cl-random 1) 0)))
+
 ;;; cl-extra-tests.el ends here
-- 
2.48.1