aboutsummaryrefslogtreecommitdiff
path: root/tests/cache.scm
diff options
context:
space:
mode:
Diffstat (limited to 'tests/cache.scm')
-rw-r--r--tests/cache.scm30
1 files changed, 29 insertions, 1 deletions
diff --git a/tests/cache.scm b/tests/cache.scm
index d495ace2bd..e8ad083d40 100644
--- a/tests/cache.scm
+++ b/tests/cache.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2017, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017, 2020, 2024 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2022 Simon Tournier <zimon.toutoune@gmail.com>
;;;
;;; This file is part of GNU Guix.
@@ -22,7 +22,9 @@
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-64)
+ #:use-module ((guix build syscalls) #:select (lock-file))
#:use-module ((guix utils) #:select (call-with-temporary-directory))
+ #:use-module ((rnrs io ports) #:select (get-string-all))
#:use-module (ice-9 match))
(test-begin "cache")
@@ -75,6 +77,32 @@
(lambda (port)
(display 0 port)))))
+(let ((pid #f))
+ (test-equal "maybe-remove-expired-cache-entries, cleanup needed but lock taken"
+ '()
+ (test-cache-cleanup cache
+ (let ((in+out (pipe)))
+ (match (primitive-fork)
+ (0 (dynamic-wind
+ (const #t)
+ (lambda ()
+ (close-port (car in+out))
+ (let ((port (lock-file
+ (string-append cache "/last-expiry-cleanup"))))
+ (display 0 port)
+ (display "done!\n" (cdr in+out))
+ (close-port (cdr in+out))
+ (sleep 100)))
+ (lambda ()
+ (primitive-exit 0))))
+ (n
+ (set! pid n)
+ (close-port (cdr in+out))
+ (pk 'chr (get-string-all (car in+out)))
+ (close-port (car in+out)))))))
+
+ (when pid (kill pid SIGKILL)))
+
(test-equal "maybe-remove-expired-cache-entries, empty cache"
'("a" "b" "c")
(test-cache-cleanup cache