From bf5bf5778cb7c3a2475c6acd707abc925b1819aa Mon Sep 17 00:00:00 2001 From: Caleb Ristvedt Date: Sun, 27 May 2018 23:20:54 +0200 Subject: Add (guix store deduplication). MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/store/database.scm (register-path): Add #:deduplicate? and call 'deduplicate' when it's true. (counting-wrapper-port, nar-sha256): Move to... * guix/store/deduplication.scm: ... here. New file. * tests/store-deduplication.scm: New file. * Makefile.am (STORE_MODULES): Add deduplication.scm. (SCM_TESTS) [HAVE_GUILE_SQLITE3]: Add store-deduplication.scm. Co-authored-by: Ludovic Courtès --- tests/store-deduplication.scm | 64 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 64 insertions(+) create mode 100644 tests/store-deduplication.scm (limited to 'tests/store-deduplication.scm') diff --git a/tests/store-deduplication.scm b/tests/store-deduplication.scm new file mode 100644 index 0000000000..04817a193a --- /dev/null +++ b/tests/store-deduplication.scm @@ -0,0 +1,64 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2018 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-store-deduplication) + #:use-module (guix tests) + #:use-module (guix store deduplication) + #:use-module (guix hash) + #:use-module ((guix utils) #:select (call-with-temporary-directory)) + #:use-module (guix build utils) + #:use-module (rnrs bytevectors) + #:use-module (ice-9 binary-ports) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-64)) + +(test-begin "store-deduplication") + +(test-equal "deduplicate" + (cons* #t #f ;inode comparisons + 2 (make-list 5 6)) ;'nlink' values + + (call-with-temporary-directory + (lambda (store) + (let ((data (string->utf8 "Hello, world!")) + (identical (map (lambda (n) + (string-append store "/" (number->string n))) + (iota 5))) + (unique (string-append store "/unique"))) + (for-each (lambda (file) + (call-with-output-file file + (lambda (port) + (put-bytevector port data)))) + identical) + (call-with-output-file unique + (lambda (port) + (put-bytevector port (string->utf8 "This is unique.")))) + + (for-each (lambda (file) + (deduplicate file (sha256 data) #:store store)) + identical) + (deduplicate unique (nar-sha256 unique) #:store store) + + ;; (system (string-append "ls -lRia " store)) + (cons* (apply = (map (compose stat:ino stat) identical)) + (= (stat:ino (stat unique)) + (stat:ino (stat (car identical)))) + (stat:nlink (stat unique)) + (map (compose stat:nlink stat) identical)))))) + +(test-end "store-deduplication") -- cgit v1.2.3