martin/emacs
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Make cl-random behave consistently for unusual arguments (bug#75105)

Browse Source 
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.
This commit is contained in:
Pip Cet
2025-06-20 06:01:41 +00:00
parent 6181e0cec5
commit b6cf7c0942
2 changed files with 20 additions and 7 deletions
Download Patch File Download Diff File Expand all files Collapse all files

18
lisp/emacs-lisp/cl-extra.el
View File

@@ -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)

9
test/lisp/emacs-lisp/cl-extra-tests.el
View File

@@ -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