tests/cpio.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2015 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-cpio)
  20   #:use-module (guix cpio)
  21   #:use-module (guix tests)
  22   #:use-module ((guix build utils) #:select (which))
  23   #:use-module ((guix utils) #:select (call-with-temporary-output-file))
  24   #:use-module (ice-9 match)
  25   #:use-module (ice-9 popen)
  26   #:use-module (rnrs io ports)
  27   #:use-module (srfi srfi-1)
  28   #:use-module (srfi srfi-26)
  29   #:use-module (srfi srfi-64))
  30
  31 (define %cpio-program
  32   (which "cpio"))
  33
  34 \f
  35 (test-begin "cpio")
  36
  37 (test-assert "file->cpio-header + write-cpio-header + read-cpio-header"
  38   (let* ((file   (search-path %load-path "guix.scm"))
  39          (header (file->cpio-header file)))
  40     (call-with-values
  41         (lambda ()
  42           (open-bytevector-output-port))
  43       (lambda (port get-bv)
  44         (write-cpio-header header port)
  45         (let ((port (open-bytevector-input-port (get-bv))))
  46           (equal? header (read-cpio-header port)))))))
  47
  48 (unless %cpio-program (test-skip 1))
  49 (test-assert "bit-identical to GNU cpio's output"
  50   (call-with-temporary-output-file
  51    (lambda (link _)
  52      (delete-file link)
  53      (symlink "chbouib" link)
  54
  55      (let ((files (cons* "/"
  56                          (canonicalize-path
  57                           (dirname (search-path %load-path "guix.scm")))
  58                          link
  59                          (map (compose canonicalize-path
  60                                        (cut search-path %load-path <>))
  61                               '("guix.scm" "guix/build/syscalls.scm"
  62                                 "guix/packages.scm")))))
  63        (call-with-temporary-output-file
  64         (lambda (ref-file _)
  65           (let ((pipe (open-pipe* OPEN_WRITE %cpio-program "-o" "-O" ref-file
  66                                   "-H" "newc" "--null")))
  67             (for-each (lambda (file)
  68                         (format pipe "~a\0" file))
  69                       files)
  70             (and (zero? (close-pipe pipe))
  71                  (call-with-temporary-output-file
  72                   (lambda (file port)
  73                     (write-cpio-archive files port)
  74                     (close-port port)
  75                     (or (file=? ref-file file)
  76                         (throw 'cpio-archives-differ files
  77                                ref-file file
  78                                (stat:size (stat ref-file))
  79                                (stat:size (stat file))))))))))))))
  80
  81 (test-end "cpio")