tests/cache.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2017, 2020 Ludovic Courtès <ludo@gnu.org>
   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: