From e78fd4ca636a19bc286747f8d91bda22cd8f08fd Mon Sep 17 00:00:00 2001 From: Andreas Enge Date: Sun, 13 Oct 2013 18:02:49 +0200 Subject: guix: Make cmake build system aware of usual paths. * guix/build/cmake-build-system.scm (configure): Set CMAKE_LIBRARY_PATH to LIBRARY_PATH and CMAKE_INCLUDE_PATH to CPATH. --- guix/build/cmake-build-system.scm | 2 ++ 1 file changed, 2 insertions(+) (limited to 'guix/build') diff --git a/guix/build/cmake-build-system.scm b/guix/build/cmake-build-system.scm index 877d8110d7..449c609398 100644 --- a/guix/build/cmake-build-system.scm +++ b/guix/build/cmake-build-system.scm @@ -38,6 +38,8 @@ (if (file-exists? "CMakeLists.txt") (let ((args `(,(string-append "-DCMAKE_INSTALL_PREFIX=" out) ,@configure-flags))) + (setenv "CMAKE_LIBRARY_PATH" (getenv "LIBRARY_PATH")) + (setenv "CMAKE_INCLUDE_PATH" (getenv "CPATH")) (format #t "running 'cmake' with arguments ~s~%" args) (zero? (apply system* "cmake" args))) (error "no CMakeLists.txt found")))) -- cgit v1.2.3 From c065c443a03960b6d535783ac68f9cff3236d262 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 30 Oct 2013 21:43:37 +0100 Subject: union: Make the log port a parameter. * guix/build/union.scm (union-build): Add 'log-port' keyword parameter; use it. --- guix/build/union.scm | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) (limited to 'guix/build') diff --git a/guix/build/union.scm b/guix/build/union.scm index 077b7fe530..0f8c87e171 100644 --- a/guix/build/union.scm +++ b/guix/build/union.scm @@ -100,7 +100,8 @@ single leaf." ,@(map loop dirs)))) (leaf leaf)))) -(define* (union-build output directories) +(define* (union-build output directories + #:key (log-port (current-error-port))) "Build in the OUTPUT directory a symlink tree that is the union of all the DIRECTORIES." (define (file-tree dir) @@ -174,6 +175,8 @@ the DIRECTORIES." (setvbuf (current-output-port) _IOLBF) (setvbuf (current-error-port) _IOLBF) + (when (file-port? log-port) + (setvbuf log-port _IOLBF)) (mkdir output) (let loop ((tree (delete-duplicate-leaves @@ -189,8 +192,7 @@ the DIRECTORIES." ;; A leaf: create a symlink. (let* ((dir (string-join dir "/")) (target (string-append output "/" dir "/" (basename tree)))) - (format (current-error-port) "`~a' ~~> `~a'~%" - tree target) + (format log-port "`~a' ~~> `~a'~%" tree target) (symlink tree target))) (((? string? subdir) leaves ...) ;; A sub-directory: create it in OUTPUT, and iterate over LEAVES. -- cgit v1.2.3 From cdbca518ca797cae61c7829e51649b55c47f6a2f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 31 Oct 2013 23:31:00 +0100 Subject: union: Do not warn when identical files collide. * guix/build/union.scm (file=?): New procedure. (union-build)[resolve-collision]: Do not warn when identical files collide. --- guix/build/union.scm | 36 ++++++++++++++++++++++++++++-------- 1 file changed, 28 insertions(+), 8 deletions(-) (limited to 'guix/build') diff --git a/guix/build/union.scm b/guix/build/union.scm index 0f8c87e171..1b09da45c7 100644 --- a/guix/build/union.scm +++ b/guix/build/union.scm @@ -22,6 +22,8 @@ #:use-module (ice-9 format) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) + #:use-module (rnrs bytevectors) + #:use-module (rnrs io ports) #:export (tree-union delete-duplicate-leaves union-build)) @@ -100,6 +102,23 @@ single leaf." ,@(map loop dirs)))) (leaf leaf)))) +(define (file=? file1 file2) + "Return #t if the contents of FILE1 and FILE2 are identical, #f otherwise." + (and (= (stat:size (stat file1)) (stat:size (stat file2))) + (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 directories #:key (log-port (current-error-port))) "Build in the OUTPUT directory a symlink tree that is the union of all @@ -163,14 +182,15 @@ the DIRECTORIES." ;; LEAVES all actually point to the same file, so nothing to worry ;; about. one-and-the-same) - ((and lst (head _ ...)) - ;; A real collision. - (format (current-error-port) "warning: collision encountered: ~{~a ~}~%" - lst) - - ;; TODO: Implement smarter strategies. - (format (current-error-port) "warning: arbitrarily choosing ~a~%" - head) + ((and lst (head rest ...)) + ;; A real collision, unless those files are all identical. + (unless (every (cut file=? head <>) rest) + (format (current-error-port) "warning: collision encountered: ~{~a ~}~%" + lst) + + ;; TODO: Implement smarter strategies. + (format (current-error-port) "warning: arbitrarily choosing ~a~%" + head)) head))) (setvbuf (current-output-port) _IOLBF) -- cgit v1.2.3