projects/guix·blob version-1.2.0 · refs

81 lines · 2.9 KiB

1;;; GNU Guix --- Functional package management for GNU
2;;; Copyright © 2017, 2020 Ludovic Courtès <[email protected]>
3;;;
4;;; This file is part of GNU Guix.
5;;;
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.
10;;;
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.
15;;;
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/>.
18
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))
26
27(test-begin "cache")
28
29(test-equal "remove-expired-cache-entries"
30 '("o" "l" "d")
31 (let* ((removed '())
32 (now (time-second (current-time time-monotonic)))
33 (ttl 100)
34 (stamp (match-lambda
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"
40 "o" "l" "d"))
41 #:entry-expiration stamp
42 #:delete-entry delete)
43 removed))
44
45(define-syntax-rule (test-cache-cleanup cache exp ...)
46 (call-with-temporary-directory
47 (lambda (cache)
48 (let* ((deleted '())
49 (delete! (lambda (entry)
50 (set! deleted (cons entry deleted)))))
51 exp ...
52 (maybe-remove-expired-cache-entries cache
53 (const '("a" "b" "c"))
54 #:entry-expiration (const 0)
55 #:delete-entry delete!)
56 (reverse deleted)))))
57
58(test-equal "maybe-remove-expired-cache-entries, first cleanup"
59 '("a" "b" "c")
60 (test-cache-cleanup cache))
61
62(test-equal "maybe-remove-expired-cache-entries, no cleanup needed"
63 '()
64 (test-cache-cleanup cache
65 (call-with-output-file (string-append cache "/last-expiry-cleanup")
66 (lambda (port)
67 (display (+ (time-second (current-time time-monotonic)) 100)
68 port)))))
69
70(test-equal "maybe-remove-expired-cache-entries, cleanup needed"
71 '("a" "b" "c")
72 (test-cache-cleanup cache
73 (call-with-output-file (string-append cache "/last-expiry-cleanup")
74 (lambda (port)
75 (display 0 port)))))
76
77(test-end "cache")
78
79;;; Local Variables:
80;;; eval: (put 'test-cache-cleanup 'scheme-indent-function 1)
81;;; End: