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-02-21 19:42:32 +0100
commitcb85237316820c6174bbdbf7a73feaca416f507f (patch)
tree498f3726b851880a6931e4cf9ec1dbed414867cc
parentFix IPv6-binding without hot-patching guile. (diff)
downloadcalp-cb85237316820c6174bbdbf7a73feaca416f507f.tar.gz
calp-cb85237316820c6174bbdbf7a73feaca416f507f.tar.xz
Fix seeding of UUIDs.
-rw-r--r--module/hnh/util/uuid.scm14
-rw-r--r--tests/test/uuid.scm14
2 files changed, 17 insertions, 11 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..b73db5f4 100644
--- a/tests/test/uuid.scm
+++ b/tests/test/uuid.scm
@@ -4,9 +4,15 @@
: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))
+ (let ((version (version)))
+ (cond ((string=? version "2.2.7")
+ "d19c9347-9a85-4432-a876-5fb9c0d24d2b")
+ ((string=? version "3.0.9")
+ "d19c9347-9a85-4432-a876-5fb9c0d24d2b")
+ (else
+ "Randomness isn't stable between guile versions")))
+ (begin
+ (parameterize ((seed (seed->random-state 0)))
+ (uuid-v4))))