[PATCH] union: Ensure that the output is always a directory

[Mark H Weaver <mhw@netris.org>]

[-- Attachment #1: Type: text/plain, Size: 350 bytes --]

ludo@gnu.org (Ludovic Courtès) writes:

> I stumbled upon this bug: building a profile with a single package
> fails, because the new union.scm makes the profile directory a symlink
> to that package, which then prevents the creation of the ‘manifest’
> file:

Indeed!  Here's a patch that fixes that problem.

   Thanks,
     Mark


[-- Attachment #2: [PATCH] union: Ensure that the output is always a directory --]
[-- Type: text/x-patch, Size: 3943 bytes --]

From 6c8582bc41c8935b8e9d63146595e87d9b92fa95 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
Date: Thu, 3 Apr 2014 17:49:20 -0400
Subject: [PATCH] union: Ensure that the output is always a directory.
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Fixes the creation of single-package profiles, reported by Ludovic Courtès.

* guix/build/union.scm (union-build): Add new internal procedure
  'union-of-directories' that always creates a directory, containing the code
  previously used only to merge multiple directories.  Call it from the
  multiple-directory case in 'union' and from the top-level 'union-build'.
---
 guix/build/union.scm | 53 +++++++++++++++++++++++++++-------------------------
 1 file changed, 28 insertions(+), 25 deletions(-)

diff --git a/guix/build/union.scm b/guix/build/union.scm
index c65bea4..ccd2d5c 100644
--- a/guix/build/union.scm
+++ b/guix/build/union.scm
@@ -108,30 +108,8 @@ the INPUTS."
        (call-with-values (lambda () (partition file-is-directory? inputs))
          (match-lambda*
            ((dirs ())
-            ;; All inputs are directories.  Create a new directory
-            ;; where we will merge the input directories.
-            (mkdir output)
-
-            ;; Build a hash table mapping each file to a list of input
-            ;; directories containing that file.
-            (let ((table (make-hash-table)))
-
-              (define (add-to-table! file dir)
-                (hash-set! table file (cons dir (hash-ref table file '()))))
-
-              ;; Populate the table.
-              (for-each (lambda (dir)
-                          (for-each (cut add-to-table! <> dir)
-                                    (files-in-directory dir)))
-                        dirs)
-
-              ;; Now iterate over the table and recursively
-              ;; perform a union for each entry.
-              (hash-for-each (lambda (file dirs-with-file)
-                               (union (string-append output "/" file)
-                                      (map (cut string-append <> "/" file)
-                                           (reverse dirs-with-file))))
-                             table)))
+            ;; All inputs are directories.
+            (union-of-directories output dirs))
 
            ((() (file (? (cut file=? <> file)) ...))
             ;; There are no directories, and all files have the same contents,
@@ -141,11 +119,36 @@ the INPUTS."
            ((dirs files)
             (resolve-collisions output dirs files)))))))
 
+  (define (union-of-directories output dirs)
+    ;; Create a new directory where we will merge the input directories.
+    (mkdir output)
+
+    ;; Build a hash table mapping each file to a list of input
+    ;; directories containing that file.
+    (let ((table (make-hash-table)))
+
+      (define (add-to-table! file dir)
+        (hash-set! table file (cons dir (hash-ref table file '()))))
+
+      ;; Populate the table.
+      (for-each (lambda (dir)
+                  (for-each (cut add-to-table! <> dir)
+                            (files-in-directory dir)))
+                dirs)
+
+      ;; Now iterate over the table and recursively
+      ;; perform a union for each entry.
+      (hash-for-each (lambda (file dirs-with-file)
+                       (union (string-append output "/" file)
+                              (map (cut string-append <> "/" file)
+                                   (reverse dirs-with-file))))
+                     table)))
+
   (setvbuf (current-output-port) _IOLBF)
   (setvbuf (current-error-port) _IOLBF)
   (when (file-port? log-port)
     (setvbuf log-port _IOLBF))
 
-  (union output (delete-duplicates inputs)))
+  (union-of-directories output (delete-duplicates inputs)))
 
 ;;; union.scm ends here
-- 
1.8.4