From e3b14fdf63e78a504a4f6e8a6ed85d5f8b08acb7 Mon Sep 17 00:00:00 2001 From: Maxime Devos Date: Sat, 4 Sep 2021 17:25:58 +0200 Subject: [PATCH 5/6] packages: Compute the hash of patches in advance when possible. * gnu/packages.scm (search-patch): Rename to ... (%search-patch): ... this. (try-search-patch): New procedure, extracted from ... (%search-patch): ... this procedure. (%local-patch-file): New procedure. (true): New procedure. (search-patch): New macro, behaving like %search-patch, but computing the hash at expansion time when possible. * gnu/packages/chromium.scm (%guix-patches): Use search-patches instead of local-file + assume-valid-file-name + search-patch. * gnu/packages/gnuzilla.scm (icecat-source)[gnuzilla-fixes-patch]: Use search-patch instead of local-file + assule-valid-file-name + search-patch. (icecat-source)[makeicecat-patch]: Likewise. * gnu/packages/embedded.scm (gcc-arm-none-eabi-4.9)[source]{patches}: Expect patches to be local-file objects instead of strings. of strings. * guix/lint.scm (check-patch-file-names): Allow local-file objects. --- gnu/packages.scm | 42 +++++++++++++++++++++++++++++++++++++-- gnu/packages/chromium.scm | 4 +--- gnu/packages/embedded.scm | 3 ++- gnu/packages/gnuzilla.scm | 8 ++------ guix/lint.scm | 28 ++++++++++++++++---------- 5 files changed, 62 insertions(+), 23 deletions(-) diff --git a/gnu/packages.scm b/gnu/packages.scm index ccfc83dd11..f5552e5a9b 100644 --- a/gnu/packages.scm +++ b/gnu/packages.scm @@ -4,6 +4,7 @@ ;;; Copyright © 2014 Eric Bavier ;;; Copyright © 2016, 2017 Alex Kost ;;; Copyright © 2016 Mathieu Lirzin +;;; Copyright © 2021 Maxime Devos ;;; ;;; This file is part of GNU Guix. ;;; @@ -21,11 +22,13 @@ ;;; along with GNU Guix. If not, see . (define-module (gnu packages) + #:use-module (guix gexp) #:use-module (guix packages) #:use-module (guix ui) #:use-module (guix utils) #:use-module (guix diagnostics) #:use-module (guix discovery) + #:use-module (guix hash) #:use-module (guix memoization) #:use-module ((guix build utils) #:select ((package-name->name+version @@ -90,12 +93,47 @@ "Search the auxiliary FILE-NAME. Return #f if not found." (search-path (%auxiliary-files-path) file-name)) -(define (search-patch file-name) +(define (try-search-patch file-name) + "Search the patch FILE-NAME. Return #f if not found." + (search-path (%patch-path) file-name)) + +(define (%search-patch file-name) "Search the patch FILE-NAME. Raise an error if not found." - (or (search-path (%patch-path) file-name) + (or (try-search-patch file-name) (raise (formatted-message (G_ "~a: patch not found") file-name)))) +(define (%local-patch-file file-name hash) + "Search the patch FILE-NAME, which is known to have HASH." + (local-file (precanonicalized-file-name file-name (%search-patch file-name)) + #:sha256 hash #:recursive? #t)) + +(define true (const #t)) + +(define-syntax search-patch + (lambda (s) + "Search the patch FILE-NAME and compute its hash at expansion time +if possible. Return #f if not found." + (syntax-case s () + ((_ file-name) + (string? (syntax->datum #'file-name)) + ;; FILE-NAME is a constant string, so the hash can be computed + ;; in advance. + (let ((patch (try-search-patch (syntax->datum #'file-name)))) + (if patch + #`(%local-patch-file file-name #,(file-hash* patch #:select? true)) + (begin + (warning (source-properties->location + (syntax-source #'file-name)) + (G_ "~a: patch not found at expansion time") + (syntax->datum #'ile-name)) + #'(%search-patch file-name))))) + ;; FILE-NAME is variable, so the hash cannot be pre-computed. + ((_ file-name) #'(%search-patch file-name)) + ;; search-patch is being used used in a construct like + ;; (map search-patch ...). + (id (identifier? #'id) #'%search-patch)))) + (define-syntax-rule (search-patches file-name ...) "Return the list of absolute file names corresponding to each FILE-NAME found in %PATCH-PATH." diff --git a/gnu/packages/chromium.scm b/gnu/packages/chromium.scm index 26ae1e2550..cf419cf41b 100644 --- a/gnu/packages/chromium.scm +++ b/gnu/packages/chromium.scm @@ -351,9 +351,7 @@ "0wbcbjzh5ak4nciahqw4yvxc4x8ik4x0iz9h4kfy0m011sxzy174")))) (define %guix-patches - (list (local-file - (assume-valid-file-name - (search-patch "ungoogled-chromium-extension-search-path.patch"))))) + (search-patches "ungoogled-chromium-extension-search-path.patch")) ;; This is a source 'snippet' that does the following: ;; *) Applies various patches for unbundling purposes and libstdc++ compatibility. diff --git a/gnu/packages/embedded.scm b/gnu/packages/embedded.scm index f388c11c3d..826f5655c3 100644 --- a/gnu/packages/embedded.scm +++ b/gnu/packages/embedded.scm @@ -30,6 +30,7 @@ #:use-module (guix packages) #:use-module (guix download) #:use-module (guix svn-download) + #:use-module (guix gexp) #:use-module (guix git-download) #:use-module ((guix licenses) #:prefix license:) #:use-module (guix build-system cmake) @@ -91,7 +92,7 @@ ;; Remove the one patch that doesn't apply to this 4.9 snapshot (the ;; patch is for 4.9.4 and later but this svn snapshot is older). (patches (remove (lambda (patch) - (string=? (basename patch) + (string=? (local-file-name patch) "gcc-arm-bug-71399.patch")) (origin-patches (package-source xgcc)))))) (native-inputs diff --git a/gnu/packages/gnuzilla.scm b/gnu/packages/gnuzilla.scm index 576bc2586f..be674dce8f 100644 --- a/gnu/packages/gnuzilla.scm +++ b/gnu/packages/gnuzilla.scm @@ -736,14 +736,10 @@ from forcing GEXP-PROMISE." (base32 "00ws3540x5whpicc5fx4k949ff73cqvajz6jp13ahn49wqdads47")))) - ;; 'search-patch' returns either a valid file name or #f, so wrap it - ;; in 'assume-valid-file-name' to avoid 'local-file' warnings. (gnuzilla-fixes-patch - (local-file (assume-valid-file-name - (search-patch "icecat-use-older-reveal-hidden-html.patch")))) + (search-patch "icecat-use-older-reveal-hidden-html.patch")) (makeicecat-patch - (local-file (assume-valid-file-name - (search-patch "icecat-makeicecat.patch"))))) + (search-patch "icecat-makeicecat.patch"))) (origin (method computed-origin-method) diff --git a/guix/lint.scm b/guix/lint.scm index 3a7f3be327..b0a2fbc327 100644 --- a/guix/lint.scm +++ b/guix/lint.scm @@ -46,6 +46,7 @@ gexp->approximate-sexp)) #:use-module (guix licenses) #:use-module (guix records) + #:use-module (guix gexp) #:use-module (guix grafts) #:use-module (guix upstream) #:use-module (guix utils) @@ -928,6 +929,8 @@ patch could not be found." (starts-with-package-name? (basename patch))) ((? origin? patch) (starts-with-package-name? (origin-actual-file-name patch))) + ((? local-file? patch) + (starts-with-package-name? (local-file-name patch))) (_ #f)) ;must be some other file-like object patches) '() @@ -941,19 +944,22 @@ patch could not be found." (let ((prefix (string-length (%distro-directory))) (margin (string-length "guix-2.0.0rc3-10000-1234567890/")) (max 99)) + (define (test-patch-name file-name) + (if (> (+ margin (if (string-prefix? (%distro-directory) file-name) + (- (string-length file-name) prefix) + (string-length file-name))) + max) + (make-warning + package + (G_ "~a: file name is too long") + (list (basename file-name)) + #:field 'patch-file-names) + #f)) (filter-map (match-lambda ((? string? patch) - (if (> (+ margin (if (string-prefix? (%distro-directory) - patch) - (- (string-length patch) prefix) - (string-length patch))) - max) - (make-warning - package - (G_ "~a: file name is too long") - (list (basename patch)) - #:field 'patch-file-names) - #f)) + (test-patch-name patch)) + ((? local-file? patch) + (test-patch-name (local-file-absolute-file-name patch))) (_ #f)) patches))))) -- 2.33.0