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 in 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.

(cherry picked from commit b6cf7c094293589c6180fe5cee7405285d9a545d)

diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index de7caab6b29b1db69011f22bc5e8ab5dea50a9c7..52d85ed76dd789fbccd576591328ce64325e6d04 100644 (file)
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -494,13 +494,17 @@ Optional second arg STATE is a random-state object."
     (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 6280be06cbba17798f67ace2141044ae6b43a70b..5290ed9d04ed364126899565860632604c99a2b8 100644 (file)
--- a/test/lisp/emacs-lisp/cl-extra-tests.el
+++ b/test/lisp/emacs-lisp/cl-extra-tests.el
@@ -438,6 +438,15 @@
                 (my-foo most-positive-fixnum)))
   )
 
+(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