1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889 |
- (define-module (test-cache)
- #:use-module (guix cache)
- #:use-module (srfi srfi-1)
- #:use-module (srfi srfi-19)
- #:use-module (srfi srfi-64)
- #:use-module ((guix utils) #:select (call-with-temporary-directory))
- #:use-module (ice-9 match))
- (cond-expand
- (guile-2.2
-
-
- (define time-monotonic time-tai))
- (else #t))
- (test-begin "cache")
- (test-equal "remove-expired-cache-entries"
- '("o" "l" "d")
- (let* ((removed '())
- (now (time-second (current-time time-monotonic)))
- (ttl 100)
- (stamp (match-lambda
- ((or "n" "e" "w") (+ now 100))
- ((or "o" "l" "d") (- now 100))))
- (delete (lambda (entry)
- (set! removed (cons entry removed)))))
- (remove-expired-cache-entries (reverse '("n" "e" "w"
- "o" "l" "d"))
- #:entry-expiration stamp
- #:delete-entry delete)
- removed))
- (define-syntax-rule (test-cache-cleanup cache exp ...)
- (call-with-temporary-directory
- (lambda (cache)
- (let* ((deleted '())
- (delete! (lambda (entry)
- (set! deleted (cons entry deleted)))))
- exp ...
- (maybe-remove-expired-cache-entries cache
- (const '("a" "b" "c"))
- #:entry-expiration (const 0)
- #:delete-entry delete!)
- (reverse deleted)))))
- (test-equal "maybe-remove-expired-cache-entries, first cleanup"
- '("a" "b" "c")
- (test-cache-cleanup cache))
- (test-equal "maybe-remove-expired-cache-entries, no cleanup needed"
- '()
- (test-cache-cleanup cache
- (call-with-output-file (string-append cache "/last-expiry-cleanup")
- (lambda (port)
- (display (+ (time-second (current-time time-monotonic)) 100)
- port)))))
- (test-equal "maybe-remove-expired-cache-entries, cleanup needed"
- '("a" "b" "c")
- (test-cache-cleanup cache
- (call-with-output-file (string-append cache "/last-expiry-cleanup")
- (lambda (port)
- (display 0 port)))))
- (test-end "cache")
|