aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2023-02-12 22:44:25 +0100
committerHugo Hörnquist <hugo@lysator.liu.se>2023-09-11 19:58:54 +0200
commit0c1d9a9856f12641424b7abaeb9f3960c91b9332 (patch)
treecdf3d3e31bf52b895595a9174b00a4be4ff7f733
parentAdd comment about bad stream error. (diff)
downloadcalp-0c1d9a9856f12641424b7abaeb9f3960c91b9332.tar.gz
calp-0c1d9a9856f12641424b7abaeb9f3960c91b9332.tar.xz
Fix seeding of UUIDs.
-rw-r--r--module/hnh/util/uuid.scm14
-rw-r--r--tests/test/uuid.scm5
2 files changed, 9 insertions, 10 deletions
diff --git a/module/hnh/util/uuid.scm b/module/hnh/util/uuid.scm
index 68455243..8e0434e3 100644
--- a/module/hnh/util/uuid.scm
+++ b/module/hnh/util/uuid.scm
@@ -1,19 +1,19 @@
(define-module (hnh util uuid)
:use-module (ice-9 format)
- :export (uuid uuid-v4))
+ :export (seed uuid uuid-v4))
-(define %seed (random-state-from-platform))
+(define seed (make-parameter (random-state-from-platform)))
(define (uuid-v4)
(define version 4)
(define variant #b10)
(format #f "~8'0x-~4'0x-~4'0x-~4'0x-~12'0x"
- (random (ash 1 (* 4 8)) %seed)
- (random (ash 1 (* 4 4)) %seed)
+ (random (ash 1 (* 4 8)) (seed))
+ (random (ash 1 (* 4 4)) (seed))
(logior (ash version (* 4 3))
- (random (1- (ash 1 (* 4 3))) %seed))
+ (random (1- (ash 1 (* 4 3))) (seed)))
(logior (ash variant (+ 2 (* 4 3)))
- (random (ash 1 (+ 2 (* 4 3))) %seed))
- (random (ash 1 (* 4 12)) %seed)))
+ (random (ash 1 (+ 2 (* 4 3))) (seed)))
+ (random (ash 1 (* 4 12)) (seed))))
(define uuid uuid-v4)
diff --git a/tests/test/uuid.scm b/tests/test/uuid.scm
index 6a2bd92a..1cedb59e 100644
--- a/tests/test/uuid.scm
+++ b/tests/test/uuid.scm
@@ -4,9 +4,8 @@
:use-module (srfi srfi-88)
:use-module (hnh util uuid))
-(set! (@@ (hnh util uuid) %seed)
- (seed->random-state 0))
(test-equal "UUIDv4 fixed seed"
"d19c9347-9a85-4432-a876-5fb9c0d24d2b"
- (uuid-v4))
+ (parameterize ((seed (seed->random-state 0)))
+ (uuid-v4)))