From 1d84d7bf6052c0c80bd212d4524876576e9817d4 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 15 Feb 2018 16:13:36 +0100 Subject: build: Require Guile >= 2.0.13. * README, configure.ac, doc/guix.texi (Requirements): Increase minimum Guile version from 2.0.9 to 2.0.13. * config-daemon.ac: Remove use of 'GUIX_CHECK_UNBUFFERED_CBIP'. * m4/guix.m4 (GUIX_CHECK_UNBUFFERED_CBIP): Remove. * guix/build/download.scm (current-http-proxy): Remove. * guix/build/syscalls.scm (%libc-errno-pointer, errno): Remove. (syscall->procedure): Use #:return-errno unconditionally. * guix/hash.scm (open-sha256-input-port)[unbuffered]: Remove outdated comment. * guix/http-client.scm (when-guile<=2.0.5-or-otherwise-broken): Remove. : Remove 'when-guile<=2.0.5-or-otherwise-broken' block. * guix/scripts/substitute.scm (fetch): Remove 'guile-version>?' conditional. * tests/hash.scm (supports-unbuffered-cbip?): Remove. : Remove 'test-skip' call. --- guix/build/download.scm | 10 +--------- guix/build/syscalls.scm | 48 +++--------------------------------------------- 2 files changed, 4 insertions(+), 54 deletions(-) (limited to 'guix/build') diff --git a/guix/build/download.scm b/guix/build/download.scm index 1b630a9d6d..315a3554ec 100644 --- a/guix/build/download.scm +++ b/guix/build/download.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès ;;; Copyright © 2015 Mark H Weaver ;;; Copyright © 2017 Tobias Geerinckx-Rice ;;; @@ -321,14 +321,6 @@ host name without trailing dot." ((uri? uri-or-string) uri-or-string) (else (error "Invalid URI" uri-or-string)))) -(define current-http-proxy - ;; XXX: Add a dummy definition for Guile < 2.0.10; this is used in - ;; 'open-socket-for-uri'. - (or (and=> (module-variable (resolve-interface '(web client)) - 'current-http-proxy) - variable-ref) - (const #f))) - (define* (open-socket-for-uri uri-or-string #:key timeout) "Return an open input/output port for a connection to URI. When TIMEOUT is not #f, it must be a (possibly inexact) number denoting the maximum duration diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 0cb630cfb3..25726b885e 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès +;;; Copyright © 2014, 2015, 2016, 2017, 2018 Ludovic Courtès ;;; Copyright © 2015 David Thompson ;;; Copyright © 2015 Mark H Weaver ;;; Copyright © 2017 Mathieu Othacehe @@ -350,39 +350,6 @@ expansion-time error is raised if FIELD does not exist in TYPE." ;;; FFI. ;;; -(define %libc-errno-pointer - ;; Glibc's 'errno' pointer, for use with Guile < 2.0.12. - (let ((errno-loc (false-if-exception - (dynamic-func "__errno_location" (dynamic-link))))) - (and errno-loc - (let ((proc (pointer->procedure '* errno-loc '()))) - (proc))))) - -(define errno ;for Guile < 2.0.12 - (if %libc-errno-pointer - (let ((bv (pointer->bytevector %libc-errno-pointer (sizeof int)))) - (lambda () - "Return the current errno." - ;; XXX: We assume that nothing changes 'errno' while we're doing all this. - ;; In particular, that means that no async must be running here. - - ;; Use one of the fixed-size native-ref procedures because they are - ;; optimized down to a single VM instruction, which reduces the risk - ;; that we fiddle with 'errno' (needed on Guile 2.0.5, libc 2.11.) - (let-syntax ((ref (lambda (s) - (syntax-case s () - ((_ bv) - (case (sizeof int) - ((4) - #'(bytevector-s32-native-ref bv 0)) - ((8) - #'(bytevector-s64-native-ref bv 0)) - (else - (error "unsupported 'int' size" - (sizeof int))))))))) - (ref bv)))) - (lambda () 0))) - (define (call-with-restart-on-EINTR thunk) (let loop () (catch 'system-error @@ -406,17 +373,8 @@ the returned procedure is called." (lambda () (let ((ptr (dynamic-func name (dynamic-link)))) ;; The #:return-errno? facility was introduced in Guile 2.0.12. - ;; Support older versions of Guile by catching 'wrong-number-of-args'. - (catch 'wrong-number-of-args - (lambda () - (pointer->procedure return-type ptr argument-types - #:return-errno? #t)) - (lambda (key . rest) - (let ((proc (pointer->procedure return-type ptr argument-types))) - (lambda args - (let ((result (apply proc args)) - (err (errno))) - (values result err)))))))) + (pointer->procedure return-type ptr argument-types + #:return-errno? #t))) (lambda args (lambda _ (error (format #f "~a: syscall->procedure failed: ~s" -- cgit v1.2.3 From 329dabe13bf98b899b907b45565434c5140804f5 Mon Sep 17 00:00:00 2001 From: Danny Milosavljevic Date: Wed, 14 Feb 2018 00:54:01 +0100 Subject: git-download: Fetch only the required commit, if possible. * guix/build/git.scm (git-fetch): Fetch only the required commit, if possible. --- guix/build/git.scm | 43 +++++++++++++++++++++++-------------------- 1 file changed, 23 insertions(+), 20 deletions(-) (limited to 'guix/build') diff --git a/guix/build/git.scm b/guix/build/git.scm index c1af545a76..14d415a6f8 100644 --- a/guix/build/git.scm +++ b/guix/build/git.scm @@ -37,28 +37,31 @@ recursively. Return #t on success, #f otherwise." ;; in advance anyway. (setenv "GIT_SSL_NO_VERIFY" "true") - ;; 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" + (mkdir-p directory) + + (with-directory-excursion directory + (invoke git-command "init") + (invoke git-command "remote" "add" "origin" url) + (if (zero? (system* git-command "fetch" "--depth" "1" "origin" commit)) + (invoke git-command "checkout" "FETCH_HEAD") + (begin + (invoke git-command "fetch" "origin") + (invoke git-command "checkout" commit))) + (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)) + (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$"))) + ;; 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))))) + ;; 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