diff options
Diffstat (limited to 'tests')
-rw-r--r-- | tests/cache.scm | 30 | ||||
-rw-r--r-- | tests/syscalls.scm | 13 |
2 files changed, 42 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 diff --git a/tests/syscalls.scm b/tests/syscalls.scm index 7cf67c060d..13f4f11721 100644 --- a/tests/syscalls.scm +++ b/tests/syscalls.scm @@ -383,6 +383,19 @@ (close-port file) result))))))))) +(test-equal "lock-file + unlock-file" + 'hello + (call-with-temporary-directory + (lambda (directory) + (let* ((file (in-vicinity directory "lock")) + (out (lock-file file #:wait? #f))) + (display "hello" out) + (unlock-file out) + (let* ((in (lock-file file "r0")) + (content (read in))) + (unlock-file in) + content))))) + (test-equal "set-thread-name" "Syscall Test" (let ((name (thread-name))) |