Merge branch 'master' into core-updates

1 files changed, 46 insertions, 9 deletions

diff --git a/guix/gexp.scm b/guix/gexp.scm
index b9525603ee..1929947d95 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -564,6 +564,7 @@ names and file names suitable for the #:allowed-references argument to
                            allowed-references disallowed-references
                            leaked-env-vars
                            local-build? (substitutable? #t)
+                           deprecation-warnings
                            (script-name (string-append name "-builder")))
   "Return a derivation NAME that runs EXP (a gexp) with GUILE-FOR-BUILD (a
 derivation) on SYSTEM; EXP is stored in a file called SCRIPT-NAME.  When
@@ -599,6 +600,9 @@ refer to.  Any reference to another store item will lead to a build error.
 Similarly for DISALLOWED-REFERENCES, which can list items that must not be
 referenced by the outputs.
 
+DEPRECATION-WARNINGS determines whether to show deprecation warnings while
+compiling modules.  It can be #f, #t, or 'detailed.
+
 The other arguments are as for 'derivation'."
   (define %modules
     (delete-duplicates
@@ -648,7 +652,9 @@ The other arguments are as for 'derivation'."
                                      (compiled-modules %modules
                                                        #:system system
                                                        #:module-path module-path
-                                                       #:guile guile-for-build)
+                                                       #:guile guile-for-build
+                                                       #:deprecation-warnings
+                                                       deprecation-warnings)
                                      (return #f)))
                        (graphs   (if references-graphs
                                      (lower-reference-graphs references-graphs
@@ -1023,7 +1029,8 @@ last one is created from the given <scheme-file> object."
                            #:key (name "module-import-compiled")
                            (system (%current-system))
                            (guile (%guile-for-build))
-                           (module-path %load-path))
+                           (module-path %load-path)
+                           (deprecation-warnings #f))
   "Return a derivation that builds a tree containing the `.go' files
 corresponding to MODULES.  All the MODULES are built in a context where
 they can refer to each other."
@@ -1073,7 +1080,15 @@ they can refer to each other."
     (gexp->derivation name build
                       #:system system
                       #:guile-for-build guile
-                      #:local-build? #t)))
+                      #:local-build? #t
+                      #:env-vars
+                      (case deprecation-warnings
+                        ((#f)
+                         '(("GUILE_WARN_DEPRECATED" . "no")))
+                        ((detailed)
+                         '(("GUILE_WARN_DEPRECATED" . "detailed")))
+                        (else
+                         '())))))
 
 
 ;;;
@@ -1081,10 +1096,12 @@ they can refer to each other."
 ;;;
 
 (define (default-guile)
-  ;; Lazily resolve 'guile-final'.  This module must not refer to (gnu …)
+  ;; Lazily resolve 'guile-2.2' (not 'guile-final' because this is for
+  ;; programs returned by 'program-file' and we don't want to keep references
+  ;; to several Guile packages).  This module must not refer to (gnu …)
   ;; modules directly, to avoid circular dependencies, hence this hack.
-  (module-ref (resolve-interface '(gnu packages commencement))
-              'guile-final))
+  (module-ref (resolve-interface '(gnu packages guile))
+              'guile-2.2))
 
 (define (load-path-expression modules)
   "Return as a monadic value a gexp that sets '%load-path' and
@@ -1204,13 +1221,30 @@ This yields an 'etc' directory containing these two files."
                                          (ungexp target))))))
                           files))))))
 
-(define (directory-union name things)
+(define* (directory-union name things
+                          #:key (copy? #f) (quiet? #f))
   "Return a directory that is the union of THINGS, where THINGS is a list of
 file-like objects denoting directories.  For example:
 
   (directory-union \"guile+emacs\" (list guile emacs))
 
-yields a directory that is the union of the 'guile' and 'emacs' packages."
+yields a directory that is the union of the 'guile' and 'emacs' packages.
+
+When HARD-LINKS? is true, create hard links instead of symlinks.  When QUIET?
+is true, the derivation will not print anything."
+  (define symlink
+    (if copy?
+        (gexp (lambda (old new)
+                (if (file-is-directory? old)
+                    (symlink old new)
+                    (copy-file old new))))
+        (gexp symlink)))
+
+  (define log-port
+    (if quiet?
+        (gexp (%make-void-port "w"))
+        (gexp (current-error-port))))
+
   (match things
     ((one)
      ;; Only one thing; return it.
@@ -1221,7 +1255,10 @@ yields a directory that is the union of the 'guile' and 'emacs' packages."
                       (gexp (begin
                               (use-modules (guix build union))
                               (union-build (ungexp output)
-                                           '(ungexp things)))))))))
+                                           '(ungexp things)
+
+                                           #:log-port (ungexp log-port)
+                                           #:symlink (ungexp symlink)))))))))
 
 
 ;;;