ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-25 05:48:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

union: Compare inode numbers in 'file=?'.

Browse source 
* guix/build/union.scm (file=?): Compare the inode of ST1 and ST2.
This commit is contained in:
Ludovic Courtès 2016-05-23 18:02:04 +02:00
parent 86cf13033e
commit af98798c7a
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 19 additions and 17 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

36
guix/build/union.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012, 2013, 2014, 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
@ -53,22 +53,24 @@ (define (file=? file1 file2)
identical, #f otherwise."
(let ((st1 (stat file1))
(st2 (stat file2)))
(and (eq? (stat:type st1) 'regular)
(eq? (stat:type st2) 'regular)
(= (stat:size st1) (stat:size st2))
(call-with-input-file file1
(lambda (port1)
(call-with-input-file file2
(lambda (port2)
(define len 8192)
(define buf1 (make-bytevector len))
(define buf2 (make-bytevector len))
(let loop ()
(let ((n1 (get-bytevector-n! port1 buf1 0 len))
(n2 (get-bytevector-n! port2 buf2 0 len)))
(and (equal? n1 n2)
(or (eof-object? n1)
(loop))))))))))))
;; When deduplication is enabled, identical files share the same inode.
(or (= (stat:ino st1) (stat:ino st2))
(and (eq? (stat:type st1) 'regular)
(eq? (stat:type st2) 'regular)
(= (stat:size st1) (stat:size st2))
(call-with-input-file file1
(lambda (port1)
(call-with-input-file file2
(lambda (port2)
(define len 8192)
(define buf1 (make-bytevector len))
(define buf2 (make-bytevector len))
(let loop ()
(let ((n1 (get-bytevector-n! port1 buf1 0 len))
(n2 (get-bytevector-n! port2 buf2 0 len)))
(and (equal? n1 n2)
(or (eof-object? n1)
(loop)))))))))))))
(define* (union-build output inputs
#:key (log-port (current-error-port)))