aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorPip Cet2025-06-20 06:01:41 +0000
committerPip Cet2025-06-20 06:09:24 +0000
commitb6cf7c094293589c6180fe5cee7405285d9a545d (patch)
tree7059f2beb60581ae81e57cf341fba0dc3e17e2ca
parent6181e0cec5158c5b66bf861c32e49674b2a110e9 (diff)
downloademacs-b6cf7c094293589c6180fe5cee7405285d9a545d.tar.gz
emacs-b6cf7c094293589c6180fe5cee7405285d9a545d.zip
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.
-rw-r--r--lisp/emacs-lisp/cl-extra.el18
-rw-r--r--test/lisp/emacs-lisp/cl-extra-tests.el9
2 files changed, 20 insertions, 7 deletions
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index 1fe0411062f..4a9819a2039 100644
--- 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."
494 (let* ((i (cl-callf (lambda (x) (% (1+ x) 55)) (cl--random-state-i state))) 494 (let* ((i (cl-callf (lambda (x) (% (1+ x) 55)) (cl--random-state-i state)))
495 (j (cl-callf (lambda (x) (% (1+ x) 55)) (cl--random-state-j state))) 495 (j (cl-callf (lambda (x) (% (1+ x) 55)) (cl--random-state-j state)))
496 (n (aset vec i (logand 8388607 (- (aref vec i) (aref vec j)))))) 496 (n (aset vec i (logand 8388607 (- (aref vec i) (aref vec j))))))
497 (if (integerp lim) 497 (cond
498 (if (<= lim 512) (% n lim) 498 ((natnump lim)
499 (if (> lim 8388607) (setq n (+ (ash n 9) (cl-random 512 state)))) 499 (if (<= lim 512) (% n lim)
500 (let ((mask 1023)) 500 (if (> lim 8388607) (setq n (+ (ash n 9) (cl-random 512 state))))
501 (while (< mask (1- lim)) (setq mask (1+ (+ mask mask)))) 501 (let ((mask 1023))
502 (if (< (setq n (logand n mask)) lim) n (cl-random lim state)))) 502 (while (< mask (1- lim)) (setq mask (1+ (+ mask mask))))
503 (* (/ n '8388608e0) lim))))) 503 (if (< (setq n (logand n mask)) lim) n (cl-random lim state)))))
504 ((< 0 lim 1.0e+INF)
505 (* (/ n '8388608e0) lim))
506 (t
507 (error "Limit %S not supported by cl-random" lim))))))
504 508
505;;;###autoload 509;;;###autoload
506(defun cl-make-random-state (&optional state) 510(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 6280be06cbb..5290ed9d04e 100644
--- a/test/lisp/emacs-lisp/cl-extra-tests.el
+++ b/test/lisp/emacs-lisp/cl-extra-tests.el
@@ -438,6 +438,15 @@
438 (my-foo most-positive-fixnum))) 438 (my-foo most-positive-fixnum)))
439 ) 439 )
440 440
441(ert-deftest cl-extra-test-random ()
442 (should-error (cl-random -1))
443 (should-error (cl-random -0.5))
444 (should-error (cl-random -1.0e+INF))
445 (should-error (cl-random 0))
446 (should-error (cl-random 0.0))
447 (should-error (cl-random -0.0))
448 (should-error (cl-random 1.0e+INF))
449 (should (eql (cl-random 1) 0)))
441 450
442 451
443;;; cl-extra-tests.el ends here 452;;; cl-extra-tests.el ends here