1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
4 ;;; This file is part of GNU Guix.
6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
7 ;;; under the terms of the GNU General Public License as published by
8 ;;; the Free Software Foundation; either version 3 of the License, or (at
9 ;;; your option) any later version.
11 ;;; GNU Guix is distributed in the hope that it will be useful, but
12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ;;; GNU General Public License for more details.
16 ;;; You should have received a copy of the GNU General Public License
17 ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
19 (define-module (test-cache)
20 #:use-module (guix cache)
21 #:use-module (srfi srfi-1)
22 #:use-module (srfi srfi-19)
23 #:use-module (srfi srfi-64)
24 #:use-module ((guix utils) #:select (call-with-temporary-directory))
25 #:use-module (ice-9 match))
29 (test-equal "remove-expired-cache-entries"
32 (now (time-second (current-time time-monotonic)))
35 ((or "n" "e" "w") (+ now 100))
36 ((or "o" "l" "d") (- now 100))))
37 (delete (lambda (entry)
38 (set! removed (cons entry removed)))))
39 (remove-expired-cache-entries (reverse '("n" "e" "w"
41 #:entry-expiration stamp
42 #:delete-entry delete)
45 (define-syntax-rule (test-cache-cleanup cache exp ...)
46 (call-with-temporary-directory
49 (delete! (lambda (entry)
50 (set! deleted (cons entry deleted)))))
52 (maybe-remove-expired-cache-entries cache
53 (const '("a" "b" "c"))
54 #:entry-expiration (const 0)
55 #:delete-entry delete!)
58 (test-equal "maybe-remove-expired-cache-entries, first cleanup"
60 (test-cache-cleanup cache))
62 (test-equal "maybe-remove-expired-cache-entries, no cleanup needed"
64 (test-cache-cleanup cache
65 (call-with-output-file (string-append cache "/last-expiry-cleanup")
67 (display (+ (time-second (current-time time-monotonic)) 100)
70 (test-equal "maybe-remove-expired-cache-entries, cleanup needed"
72 (test-cache-cleanup cache
73 (call-with-output-file (string-append cache "/last-expiry-cleanup")
80 ;;; eval: (put 'test-cache-cleanup 'scheme-indent-function 1)