1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2017, 2020 Ludovic Courtès <ludo@gnu.org>
3 ;;; Copyright © 2022 Simon Tournier <zimon.toutoune@gmail.com>
5 ;;; This file is part of GNU Guix.
7 ;;; GNU Guix is free software; you can redistribute it and/or modify it
8 ;;; under the terms of the GNU General Public License as published by
9 ;;; the Free Software Foundation; either version 3 of the License, or (at
10 ;;; your option) any later version.
12 ;;; GNU Guix is distributed in the hope that it will be useful, but
13 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;;; GNU General Public License for more details.
17 ;;; You should have received a copy of the GNU General Public License
18 ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
20 (define-module (test-cache)
21 #:use-module (guix cache)
22 #:use-module (srfi srfi-1)
23 #:use-module (srfi srfi-19)
24 #:use-module (srfi srfi-64)
25 #:use-module ((guix utils) #:select (call-with-temporary-directory))
26 #:use-module (ice-9 match))
30 (test-equal "remove-expired-cache-entries"
33 (now (time-second (current-time time-monotonic)))
36 ((or "n" "e" "w") (+ now 100))
37 ((or "o" "l" "d") (- now 100))))
38 (delete (lambda (entry)
39 (set! removed (cons entry removed)))))
40 (remove-expired-cache-entries (reverse '("n" "e" "w"
42 #:entry-expiration stamp
43 #:delete-entry delete)
46 (define-syntax-rule (test-cache-cleanup cache exp ...)
47 (call-with-temporary-directory
50 (delete! (lambda (entry)
51 (set! deleted (cons entry deleted)))))
53 (maybe-remove-expired-cache-entries cache
54 (const '("a" "b" "c"))
55 #:entry-expiration (const 0)
56 #:delete-entry delete!)
59 (test-equal "maybe-remove-expired-cache-entries, first cleanup"
61 (test-cache-cleanup cache))
63 (test-equal "maybe-remove-expired-cache-entries, no cleanup needed"
65 (test-cache-cleanup cache
66 (call-with-output-file (string-append cache "/last-expiry-cleanup")
68 (display (+ (time-second (current-time time-monotonic)) 100)
71 (test-equal "maybe-remove-expired-cache-entries, cleanup needed"
73 (test-cache-cleanup cache
74 (call-with-output-file (string-append cache "/last-expiry-cleanup")
78 (test-equal "maybe-remove-expired-cache-entries, empty cache"
80 (test-cache-cleanup cache
81 (call-with-output-file (string-append cache "/last-expiry-cleanup")
85 (test-equal "maybe-remove-expired-cache-entries, corrupted cache"
87 (test-cache-cleanup cache
88 (call-with-output-file (string-append cache "/last-expiry-cleanup")
90 (display "1\"34657890" port)))))
95 ;;; eval: (put 'test-cache-cleanup 'scheme-indent-function 1)