mirrors
/
cuirass
mirror of https://notabug.org/mthl/cuirass.git
1
0
Fork 0
Code Issues Releases Wiki Activity

base: Handle 'git clone' errors correctly. 

Fixes https://notabug.org/mthl/cuirass/issues/1.

* src/cuirass/base.scm (fetch-repository): Return #f when 'git clone' fails.
(process-specs): Test if commit is not #f before using its value.

Signed-off-by: Mathieu Lirzin <mthl@gnu.org>
improve-build-parallelism
Mathieu Othacehe 2017-01-29 11:25:13 +01:00 committed by Mathieu Lirzin
parent 5127c6797c
commit abd52046d5
No known key found for this signature in database
GPG Key ID: 0ADEE10094604D37
1 changed files with 22 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
src/cuirass/base.scm
View File

@ -77,7 +77,7 @@ values."
(define (fetch-repository spec)
"Get the latest version of repository specified in SPEC. Clone repository
if required."
if required. Return the last commit ID on success, #f otherwise."
(define (current-commit)
(let* ((pipe (open-input-pipe "git log -n1"))
(log (read-string pipe))
@ -93,14 +93,15 @@ if required."
(branch (assq-ref spec #:branch))
(commit (assq-ref spec #:commit))
(tag (assq-ref spec #:tag)))
(or (file-exists? name) (system* "git" "clone" url name))
(with-directory-excursion name
(and (zero? (system* "git" "fetch"))
(zero? (system* "git" "reset" "--hard"
(or tag
commit
(string-append "origin/" branch))))
(current-commit)))))))
(and (or (file-exists? name)
(zero? (system* "git" "clone" url name)))
(with-directory-excursion name
(and (zero? (system* "git" "fetch"))
(zero? (system* "git" "reset" "--hard"
(or tag
commit
(string-append "origin/" branch))))
(current-commit))))))))
(define (compile dir)
;; Required for fetching Guix bootstrap tarballs.
@ -166,17 +167,18 @@ if required."
(define (process spec)
(let ((commit (fetch-repository spec))
(stamp (db-get-stamp db spec)))
(unless (string=? commit stamp)
(unless (assq-ref spec #:no-compile?)
(compile (string-append (%package-cachedir) "/"
(assq-ref spec #:name))))
(with-store store
(let* ((spec* (acons #:current-commit commit spec))
(jobs (evaluate store db spec*)))
(unless (%use-substitutes?)
(set-build-options store #:use-substitutes? #f))
(build-packages store db jobs))))
(db-add-stamp db spec commit)))
(when commit
(unless (string=? commit stamp)
(unless (assq-ref spec #:no-compile?)
(compile (string-append (%package-cachedir) "/"
(assq-ref spec #:name))))
(with-store store
(let* ((spec* (acons #:current-commit commit spec))
(jobs (evaluate store db spec*)))
(unless (%use-substitutes?)
(set-build-options store #:use-substitutes? #f))
(build-packages store db jobs))))
(db-add-stamp db spec commit))))
(for-each process jobspecs))