build-self: Avoid recompilations of 'compute-guix-derivation'.

* build-aux/build-self.scm (build-program)["compute-guix-derivation"]:
Honor the SOURCE command-line argument.  Add a VERSION command-line
argument and honor it.
(build): Pass VERSION to BUILD.
master
Ludovic Courtès 2018-06-21 11:14:17 +02:00
parent 3cd1aafa83
commit 1f1d76a178
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 9 additions and 8 deletions

View File

@ -232,11 +232,12 @@ person's version identifier."
;; (gnu packages …) modules are going to be looked up ;; (gnu packages …) modules are going to be looked up
;; under SOURCE. (guix config) is looked up in FRONT. ;; under SOURCE. (guix config) is looked up in FRONT.
(match %load-path (match (command-line)
((#$source _ ...) ((_ source _ ...)
#t) ;already done (match %load-path
((front _ ...) ((front _ ...)
(set! %load-path (list #$source front)))) (unless (string=? front source) ;already done?
(set! %load-path (list source front)))))))
;; Only load our own modules or those of Guile. ;; Only load our own modules or those of Guile.
(match %load-compiled-path (match %load-compiled-path
@ -264,7 +265,7 @@ person's version identifier."
(loop (cdr spin)))) (loop (cdr spin))))
(match (command-line) (match (command-line)
((_ _ system) ((_ source system version)
(with-store store (with-store store
(call-with-new-thread (call-with-new-thread
(lambda () (lambda ()
@ -273,7 +274,7 @@ person's version identifier."
(display (display
(and=> (and=>
(run-with-store store (run-with-store store
(guix-derivation #$source #$version (guix-derivation source version
#$guile-version #$guile-version
#:pull-version #:pull-version
#$pull-version) #$pull-version)
@ -304,7 +305,7 @@ files."
(setenv "GUILE_WARN_DEPRECATED" "no") ;be quiet and drive (setenv "GUILE_WARN_DEPRECATED" "no") ;be quiet and drive
(open-pipe* OPEN_READ (open-pipe* OPEN_READ
(derivation->output-path build) (derivation->output-path build)
source system))) source system version)))
(str (get-string-all pipe)) (str (get-string-all pipe))
(status (close-pipe pipe))) (status (close-pipe pipe)))
(match str (match str