From 35a6dabcf1386fa33539a4d022dc3a46b536de64 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 4 Jan 2016 22:10:03 +0100 Subject: git-download: Correctly implement recursive checkouts. Previously, the 'git checkout' invocation would remove sub-modules that had been initialized by 'git clone --recursive'. * guix/build/git.scm (git-fetch): Never use "git clone --recursive". Invoke "git submodule update --init --recursive" after "git checkout". Remove '.git' directories as the last step. --- guix/build/git.scm | 43 ++++++++++++++++++++++++------------------- 1 file changed, 24 insertions(+), 19 deletions(-) (limited to 'guix/build') diff --git a/guix/build/git.scm b/guix/build/git.scm index 121f07a7fa..c1af545a76 100644 --- a/guix/build/git.scm +++ b/guix/build/git.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014 Ludovic Courtès +;;; Copyright © 2014, 2016 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -37,23 +37,28 @@ recursively. Return #t on success, #f otherwise." ;; in advance anyway. (setenv "GIT_SSL_NO_VERIFY" "true") - (let ((args `("clone" ,@(if recursive? '("--recursive") '()) - ,url ,directory))) - (and (zero? (apply system* git-command args)) - (with-directory-excursion directory - (system* git-command "tag" "-l") - (and (zero? (system* git-command "checkout" commit)) - (begin - ;; The contents of '.git' vary as a function of the current - ;; status of the Git repo. Since we want a fixed output, this - ;; directory needs to be taken out. - (delete-file-recursively ".git") - - (when recursive? - ;; In sub-modules, '.git' is a flat file, not a directory, - ;; so we can use 'find-files' here. - (for-each delete-file-recursively - (find-files directory "^\\.git$"))) - #t)))))) + ;; We cannot use "git clone --recursive" since the following "git checkout" + ;; effectively removes sub-module checkouts as of Git 2.6.3. + (and (zero? (system* git-command "clone" url directory)) + (with-directory-excursion directory + (system* git-command "tag" "-l") + (and (zero? (system* git-command "checkout" commit)) + (begin + (when recursive? + ;; Now is the time to fetch sub-modules. + (unless (zero? (system* git-command "submodule" "update" + "--init" "--recursive")) + (error "failed to fetch sub-modules" url)) + + ;; In sub-modules, '.git' is a flat file, not a directory, + ;; so we can use 'find-files' here. + (for-each delete-file-recursively + (find-files directory "^\\.git$"))) + + ;; The contents of '.git' vary as a function of the current + ;; status of the Git repo. Since we want a fixed output, this + ;; directory needs to be taken out. + (delete-file-recursively ".git") + #t))))) ;;; git.scm ends here -- cgit v1.2.3 From f07041f7d25badb7d74b8fad6ee446a12af04f63 Mon Sep 17 00:00:00 2001 From: Taylan Ulrich Bayırlı/Kammer Date: Fri, 27 Nov 2015 09:27:55 +0100 Subject: build: pull: Compile .scm files in one process. * guix/build/pull.scm (call-with-process, report-build-progress) (p-for-each): Remove. (build-guix): Load and compile files in one process. --- guix/build/pull.scm | 149 +++++++++++++++++++--------------------------------- 1 file changed, 55 insertions(+), 94 deletions(-) (limited to 'guix/build') diff --git a/guix/build/pull.scm b/guix/build/pull.scm index 281be23aa8..4ddb12ac04 100644 --- a/guix/build/pull.scm +++ b/guix/build/pull.scm @@ -1,5 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2013, 2014 Ludovic Courtès +;;; Copyright © 2015 Taylan Ulrich Bayırlı/Kammer ;;; ;;; This file is part of GNU Guix. ;;; @@ -22,6 +23,7 @@ #:use-module (ice-9 ftw) #:use-module (ice-9 match) #:use-module (ice-9 format) + #:use-module (ice-9 threads) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) @@ -33,75 +35,10 @@ ;;; ;;; Code: -(define (call-with-process thunk) - "Run THUNK in a separate process that will return 0 if THUNK terminates -normally, and 1 if an exception is raised." - (match (primitive-fork) - (0 - (catch #t - (lambda () - (thunk) - (primitive-exit 0)) - (lambda (key . args) - (print-exception (current-error-port) #f key args) - (primitive-exit 1)))) - (pid - #t))) - -(define* (report-build-progress total completed cont - #:optional (log-port (current-error-port))) - "Report that COMPLETED out of TOTAL files have been completed, and call -CONT." - (display #\cr log-port) - (format log-port "compiling...\t~5,1f% of ~d files" ;FIXME: i18n - (* 100. (/ completed total)) total) - (force-output log-port) - (cont)) - -(define* (p-for-each proc lst - #:optional (max-processes (current-processor-count)) - #:key (progress report-build-progress)) - "Invoke PROC for each element of LST in a separate process, using up to -MAX-PROCESSES processes in parallel. Call PROGRESS at each step, passing it -the continuation. Raise an error if one of the processes exit with non-zero." - (define total - (length lst)) - - (define (wait-for-one-process) - (match (waitpid WAIT_ANY) - ((_ . status) - (unless (zero? (status:exit-val status)) - (error "process failed" proc status))))) - - (let loop ((lst lst) - (running 0) - (completed 0)) - (match lst - (() - (or (zero? running) - (let ((running (- running 1)) - (completed (+ completed 1))) - (wait-for-one-process) - (progress total completed - (lambda () - (loop lst running completed)))))) - ((head . tail) - (if (< running max-processes) - (let ((running (+ 1 running))) - (call-with-process (cut proc head)) - (progress total completed - (lambda () - (loop tail running completed)))) - (let ((running (- running 1)) - (completed (+ completed 1))) - (wait-for-one-process) - (progress total completed - (lambda () - (loop lst running completed))))))))) - (define* (build-guix out source #:key gcrypt - (debug-port (%make-void-port "w"))) + (debug-port (%make-void-port "w")) + (log-port (current-error-port))) "Build and install Guix in directory OUT using SOURCE, a directory containing the source code. Write any debugging output to DEBUG-PORT." (setvbuf (current-output-port) _IOLBF) @@ -130,33 +67,57 @@ containing the source code. Write any debugging output to DEBUG-PORT." (set! %load-path (cons out %load-path)) (set! %load-compiled-path (cons out %load-compiled-path)) - ;; Compile the .scm files. Do that in independent processes, à la - ;; 'make -j', to work around (FIXME). - ;; This ensures correctness, but is overly conservative and slow. - ;; The solution initially implemented (and described in the bug - ;; above) was slightly faster but consumed memory proportional to the - ;; number of modules, which quickly became unacceptable. - (p-for-each (lambda (file) - (let ((go (string-append (string-drop-right file 4) - ".go"))) - (format debug-port "~%compiling '~a'...~%" file) - (parameterize ((current-warning-port debug-port)) - (compile-file file - #:output-file go - #:opts - %auto-compilation-options)))) - - (filter (cut string-suffix? ".scm" <>) - - ;; Build guix/*.scm before gnu/*.scm to speed - ;; things up. - (sort (find-files out "\\.scm") - (let ((guix (string-append out "/guix")) - (gnu (string-append out "/gnu"))) - (lambda (a b) - (or (and (string-prefix? guix a) - (string-prefix? gnu b)) - (string (FIXME). + (let* ((files + ;; Load guix/ modules before gnu/ modules to get somewhat steadier + ;; progress reporting. + (sort (filter (cut string-suffix? ".scm" <>) + (find-files out "\\.scm")) + (let ((guix (string-append out "/guix")) + (gnu (string-append out "/gnu"))) + (lambda (a b) + (or (and (string-prefix? guix a) + (string-prefix? gnu b)) + (string/foo/bar.scm" into (foo bar). + (let* ((relative-file (string-drop file (+ (string-length out) 1))) + (module-path (string-drop-right relative-file 4)) + (module-name (map string->symbol + (string-split module-path #\/)))) + (parameterize ((current-warning-port debug-port)) + (resolve-interface module-name))) + (loop files (+ 1 completed))))) + (newline) + (let ((mutex (make-mutex)) + (completed 0)) + (par-for-each + (lambda (file) + (with-mutex mutex + (display #\cr log-port) + (format log-port "compiling...\t~5,1f% of ~d files" ;FIXME: i18n + (* 100. (/ completed total)) total) + (force-output log-port) + (format debug-port "~%compiling '~a'...~%" file)) + (let ((go (string-append (string-drop-right file 4) ".go"))) + (parameterize ((current-warning-port (%make-void-port "w"))) + (compile-file file + #:output-file go + #:opts %auto-compilation-options))) + (with-mutex mutex + (set! completed (+ 1 completed)))) + files)))) ;; Remove the "fake" (guix config). (delete-file (string-append out "/guix/config.scm")) -- cgit v1.2.3 From 7266848ace1da9b43c3a06bf4c942c56d4ba3d6a Mon Sep 17 00:00:00 2001 From: Ben Woodcroft Date: Wed, 30 Dec 2015 10:27:33 +1000 Subject: build: ruby: Remove cached gem after install. The .gem file stored in GEM_HOME after install is both redundant and an archive that stores timestamped files which makes builds non-deterministic, so delete it after 'gem install'. * guix/build/ruby-build-system.scm (install): Remove cached gem after install. --- guix/build/ruby-build-system.scm | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) (limited to 'guix/build') diff --git a/guix/build/ruby-build-system.scm b/guix/build/ruby-build-system.scm index 2685da1a72..6439bf69eb 100644 --- a/guix/build/ruby-build-system.scm +++ b/guix/build/ruby-build-system.scm @@ -1,6 +1,7 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2015 David Thompson ;;; Copyright © 2015 Pjotr Prins +;;; Copyright © 2015 Ben Woodcroft ;;; ;;; This file is part of GNU Guix. ;;; @@ -115,15 +116,19 @@ GEM-FLAGS are passed to the 'gem' invokation, if present." (assoc-ref inputs "ruby")) 1)) (out (assoc-ref outputs "out")) - (gem-home (string-append out "/lib/ruby/gems/" ruby-version ".0"))) - + (gem-home (string-append out "/lib/ruby/gems/" ruby-version ".0")) + (gem-name (first-matching-file "\\.gem$"))) (setenv "GEM_HOME" gem-home) (mkdir-p gem-home) - (zero? (apply system* "gem" "install" (first-matching-file "\\.gem$") - "--local" "--ignore-dependencies" - ;; Executables should go into /bin, not /lib/ruby/gems. - "--bindir" (string-append out "/bin") - gem-flags)))) + (and (apply system* "gem" "install" gem-name + "--local" "--ignore-dependencies" + ;; Executables should go into /bin, not /lib/ruby/gems. + "--bindir" (string-append out "/bin") + gem-flags) + ;; Remove the cached gem file as this is unnecessary and contains + ;; timestamped files rendering builds not reproducible. + (begin (delete-file (string-append gem-home "/cache/" gem-name)) + #t)))) (define %standard-phases (modify-phases gnu:%standard-phases -- cgit v1.2.3