diff options
| author | Pip Cet | 2025-06-20 06:01:41 +0000 |
|---|---|---|
| committer | Pip Cet | 2025-06-20 06:09:24 +0000 |
| commit | b6cf7c094293589c6180fe5cee7405285d9a545d (patch) | |
| tree | 7059f2beb60581ae81e57cf341fba0dc3e17e2ca | |
| parent | 6181e0cec5158c5b66bf861c32e49674b2a110e9 (diff) | |
| download | emacs-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.el | 18 | ||||
| -rw-r--r-- | test/lisp/emacs-lisp/cl-extra-tests.el | 9 |
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 |