From 2ea2aac6e9d58a07c029504f94fb5015cd407e31 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 18 Apr 2017 22:07:49 +0200 Subject: Add (guix cache) and use it in (guix scripts substitute). * guix/cache.scm, tests/cache.scm: New files. * Makefile.am (MODULES, SCM_TESTS): Add them. * guix/scripts/substitute.scm (obsolete?): Remove. (remove-expired-cached-narinfos): Rename to... (cached-narinfo-expiration-time): ... this. Remove the removal part and only keep the expiration time part. (narinfo-cache-directories): Add optional 'directory' parameter and honor it. (maybe-remove-expired-cached-narinfo): Remove. (cached-narinfo-files): New procedure. (guix-substitute): Use 'maybe-remove-expired-cache-entries' instead of 'maybe-remove-expired-cached-narinfo'. --- tests/cache.scm | 81 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 81 insertions(+) create mode 100644 tests/cache.scm (limited to 'tests/cache.scm') diff --git a/tests/cache.scm b/tests/cache.scm new file mode 100644 index 0000000000..0e1e08b693 --- /dev/null +++ b/tests/cache.scm @@ -0,0 +1,81 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2017 Ludovic Courtès +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(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)) + +(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") + +;;; Local Variables: +;;; eval: (put 'test-cache-cleanup 'scheme-indent-function 1) +;;; End: -- cgit 1.4.1 From 25a49294caf2386e65fc1b12a2508324be0b1cc2 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 22 Apr 2017 14:40:51 +0200 Subject: cache: Work around 'time-monotonic' bug in Guile 2.2.2. * guix/cache.scm (time-monotonic) [guile-2.2]: New variable. * tests/cache.scm (time-monotonic) [guile-2.2]: Likewise. * guix/build/download.scm (time-monotonic) [guile-2.2]: Adjust comment: it's a 2.2.2 bug. --- guix/build/download.scm | 5 ++--- guix/cache.scm | 7 +++++++ tests/cache.scm | 7 +++++++ 3 files changed, 16 insertions(+), 3 deletions(-) (limited to 'tests/cache.scm') diff --git a/guix/build/download.scm b/guix/build/download.scm index 6563341b9f..67a8952599 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -142,9 +142,8 @@ Otherwise return STORE-PATH." (cond-expand (guile-2.2 - ;; Guile 2.2.0 to 2.2.2 included has a bug whereby 'time-monotonic' objects - ;; have seconds and nanoseconds swapped (fixed in Guile commit 886ac3e). - ;; Work around it. + ;; Guile 2.2.2 has a bug whereby 'time-monotonic' objects have seconds and + ;; nanoseconds swapped (fixed in Guile commit 886ac3e). Work around it. (define time-monotonic time-tai)) (else #t)) diff --git a/guix/cache.scm b/guix/cache.scm index 077b0780bd..1dc0083f1d 100644 --- a/guix/cache.scm +++ b/guix/cache.scm @@ -33,6 +33,13 @@ ;;; ;;; Code: +(cond-expand + (guile-2.2 + ;; Guile 2.2.2 has a bug whereby 'time-monotonic' objects have seconds and + ;; nanoseconds swapped (fixed in Guile commit 886ac3e). Work around it. + (define time-monotonic time-tai)) + (else #t)) + (define (obsolete? date now ttl) "Return #t if DATE is obsolete compared to NOW + TTL seconds." (time>? (subtract-duration now (make-time time-duration 0 ttl)) diff --git a/tests/cache.scm b/tests/cache.scm index 0e1e08b693..e46cdd816d 100644 --- a/tests/cache.scm +++ b/tests/cache.scm @@ -24,6 +24,13 @@ #:use-module ((guix utils) #:select (call-with-temporary-directory)) #:use-module (ice-9 match)) +(cond-expand + (guile-2.2 + ;; Guile 2.2.2 has a bug whereby 'time-monotonic' objects have seconds and + ;; nanoseconds swapped (fixed in Guile commit 886ac3e). Work around it. + (define time-monotonic time-tai)) + (else #t)) + (test-begin "cache") (test-equal "remove-expired-cache-entries" -- cgit 1.4.1