cbaines pushed a commit to branch master
in repository guix.
commit c9cd16c630ccba655b93ff32fd9a99570b4f5373
Author: Christopher Baines <m...@cbaines.net>
AuthorDate: Mon Feb 19 15:44:15 2024 +0000
store: database: Rename a couple of procedures.
These names should be more descriptive.
* guix/store/database.scm (path-id): Rename to select-valid-path-id.
(sqlite-register): Rename to register-valid-path.
(register-items): Update accordingly.
Change-Id: I6d4a14d4cde9d71ab34d6ffdbfbfde51b2c0e1db
---
guix/store/database.scm | 35 +++++++++++++++++---------------
tests/pack.scm | 2 +-
tests/store-database.scm | 53 ++++++++++++++++++++++++------------------------
3 files changed, 46 insertions(+), 44 deletions(-)
diff --git a/guix/store/database.scm b/guix/store/database.scm
index dea690ec76..58d3871e85 100644
--- a/guix/store/database.scm
+++ b/guix/store/database.scm
@@ -40,8 +40,10 @@
store-database-file
call-with-database
with-database
- path-id
- sqlite-register
+
+ valid-path-id
+
+ register-valid-path
register-items
%epoch
reset-timestamps
@@ -181,9 +183,9 @@ If FILE doesn't exist, create it and initialize it as a new
database. Pass
(vector-ref (sqlite-step-and-reset stmt)
0)))
-(define* (path-id db path)
- "If PATH exists in the 'ValidPaths' table, return its numerical
-identifier. Otherwise, return #f."
+(define (valid-path-id db path)
+ "If PATH exists in the 'ValidPaths' table, return its numerical identifier.
+Otherwise, return #f."
(let ((stmt (sqlite-prepare
db
"
@@ -249,7 +251,7 @@ Every store item in REFERENCES must already be registered."
(assert-integer "sqlite-register" (cut >= <> 0) #:time registration-time)
(define id
- (let ((existing-id (path-id db path)))
+ (let ((existing-id (valid-path-id db path)))
(if existing-id
(let ((stmt (sqlite-prepare
db
@@ -284,7 +286,8 @@ VALUES (:path, :hash, :time, :deriver, :size)"
;; Call 'path-id' on each of REFERENCES. This ensures we get a
;; "non-NULL constraint" failure if one of REFERENCES is unregistered.
(add-references db id
- (map (cut path-id db <>) references)))
+ (map (cut valid-path-id db <>) references)))
+
;;;
@@ -361,18 +364,18 @@ typically by adding them as temp-roots."
;; When TO-REGISTER is already registered, skip it. This makes a
;; significant differences when 'register-closures' is called
;; consecutively for overlapping closures such as 'system' and 'bootcfg'.
- (unless (path-id db to-register)
+ (unless (valid-path-id db to-register)
(let-values (((hash nar-size) (nar-sha256 real-file-name)))
(call-with-retrying-transaction db
(lambda ()
- (sqlite-register db #:path to-register
- #:references (store-info-references item)
- #:deriver (store-info-deriver item)
- #:hash (string-append
- "sha256:"
- (bytevector->base16-string hash))
- #:nar-size nar-size
- #:time registration-time))))))
+ (register-valid-path db #:path to-register
+ #:references (store-info-references item)
+ #:deriver (store-info-deriver item)
+ #:hash (string-append
+ "sha256:"
+ (bytevector->base16-string hash))
+ #:nar-size nar-size
+ #:time registration-time))))))
(let* ((prefix (format #f "registering ~a items" (length items)))
(progress (progress-reporter/bar (length items)
diff --git a/tests/pack.scm b/tests/pack.scm
index 55445ea1e9..40897a5589 100644
--- a/tests/pack.scm
+++ b/tests/pack.scm
@@ -209,7 +209,7 @@
(and (every valid-file?
'("α" "λ")
'("alpha" "lambda"))
- (integer? (path-id db #$tree)))))))))))
+ (integer? (valid-path-id db
#$tree)))))))))))
(built-derivations (list check))))
(unless store (test-skip 1))
diff --git a/tests/store-database.scm b/tests/store-database.scm
index d8f3ce8070..67d464386d 100644
--- a/tests/store-database.scm
+++ b/tests/store-database.scm
@@ -87,23 +87,22 @@
(lambda (db-file port)
(delete-file db-file)
(with-database db-file db
- (sqlite-register db
- #:path "/gnu/foo"
- #:references '()
- #:deriver "/gnu/foo.drv"
- #:hash (string-append "sha256:" (make-string 64 #\e))
- #:nar-size 1234)
- (sqlite-register db
- #:path "/gnu/bar"
- #:references '("/gnu/foo")
- #:deriver "/gnu/bar.drv"
- #:hash (string-append "sha256:" (make-string 64 #\a))
- #:nar-size 4321)
- (let ((path-id (@@ (guix store database) path-id)))
- (list (path-id db "/gnu/foo")
- (path-id db "/gnu/bar")))))))
+ (register-valid-path db
+ #:path "/gnu/foo"
+ #:references '()
+ #:deriver "/gnu/foo.drv"
+ #:hash (string-append "sha256:" (make-string 64
#\e))
+ #:nar-size 1234)
+ (register-valid-path db
+ #:path "/gnu/bar"
+ #:references '("/gnu/foo")
+ #:deriver "/gnu/bar.drv"
+ #:hash (string-append "sha256:" (make-string 64
#\a))
+ #:nar-size 4321)
+ (list (valid-path-id db "/gnu/foo")
+ (valid-path-id db "/gnu/bar"))))))
-(test-assert "sqlite-register with unregistered references"
+(test-assert "register-valid-path with unregistered references"
;; Make sure we get a "NOT NULL constraint failed: Refs.reference" error
;; when we try to add references that are not registered yet. Better safe
;; than sorry.
@@ -113,17 +112,17 @@
(catch 'sqlite-error
(lambda ()
(with-database db-file db
- (sqlite-register db #:path "/gnu/foo"
- #:references '("/gnu/bar")
- #:deriver "/gnu/foo.drv"
- #:hash (string-append "sha256:" (make-string 64
#\e))
- #:nar-size 1234))
+ (register-valid-path db #:path "/gnu/foo"
+ #:references '("/gnu/bar")
+ #:deriver "/gnu/foo.drv"
+ #:hash (string-append "sha256:" (make-string
64 #\e))
+ #:nar-size 1234))
#f)
(lambda args
(pk 'welcome-exception! args)
#t)))))
-(test-equal "sqlite-register with incorrect size"
+(test-equal "register-valid-path with incorrect size"
'out-of-range
(call-with-temporary-output-file
(lambda (db-file port)
@@ -131,11 +130,11 @@
(catch #t
(lambda ()
(with-database db-file db
- (sqlite-register db #:path "/gnu/foo"
- #:references '("/gnu/bar")
- #:deriver "/gnu/foo.drv"
- #:hash (string-append "sha256:" (make-string 64
#\e))
- #:nar-size -1234))
+ (register-valid-path db #:path "/gnu/foo"
+ #:references '("/gnu/bar")
+ #:deriver "/gnu/foo.drv"
+ #:hash (string-append "sha256:" (make-string
64 #\e))
+ #:nar-size -1234))
#f)
(lambda (key . _)
key)))))
