From 2725f0463421dfb446bce393b87a13139922f1cc Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 31 May 2021 22:28:43 +0200 Subject: store: Remove 'references/substitutes'. This procedure lost its only user in commit 710854304b1ab29332edcb76f3de532e0724c197. * guix/store.scm (references/substitutes): Remove. * tests/store.scm ("references/substitutes missing reference info") ("references/substitutes with substitute info"): Remove. --- tests/store.scm | 36 ------------------------------------ 1 file changed, 36 deletions(-) (limited to 'tests') diff --git a/tests/store.scm b/tests/store.scm index 9c25adf5e9..3266fa7a82 100644 --- a/tests/store.scm +++ b/tests/store.scm @@ -308,42 +308,6 @@ (null? (references %store t1)) (null? (referrers %store t2))))) -(test-assert "references/substitutes missing reference info" - (with-store s - (set-build-options s #:use-substitutes? #f) - (guard (c ((store-protocol-error? c) #t)) - (let* ((b (add-to-store s "bash" #t "sha256" - (search-bootstrap-binary "bash" - (%current-system)))) - (d (derivation s "the-thing" b '("--help") - #:inputs `((,b))))) - (references/substitutes s (list (derivation->output-path d) b)) - #f)))) - -(test-assert "references/substitutes with substitute info" - (with-store s - (set-build-options s #:use-substitutes? #t) - (let* ((t1 (add-text-to-store s "random1" (random-text))) - (t2 (add-text-to-store s "random2" (random-text) - (list t1))) - (t3 (add-text-to-store s "build" "echo -n $t2 > $out")) - (b (add-to-store s "bash" #t "sha256" - (search-bootstrap-binary "bash" - (%current-system)))) - (d (derivation s "the-thing" b `("-e" ,t3) - #:inputs `((,b) (,t3) (,t2)) - #:env-vars `(("t2" . ,t2)))) - (o (derivation->output-path d))) - (with-derivation-narinfo d - (sha256 => (gcrypt:sha256 (string->utf8 t2))) - (references => (list t2)) - - (equal? (references/substitutes s (list o t3 t2 t1)) - `((,t2) ;refs of O - () ;refs of T3 - (,t1) ;refs of T2 - ())))))) ;refs of T1 - (test-equal "substitutable-path-info when substitutes are turned off" '() (with-store s -- cgit v1.2.3 From 04afb76958184b2a6dafa2815a2a410424a05d84 Mon Sep 17 00:00:00 2001 From: Xinglu Chen Date: Sun, 30 May 2021 22:30:31 +0200 Subject: lint: Check for trailing whitespace in synopsis. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/lint.scm (check-synopsis-style): Check for trailing whitespace. * tests/lint.scm ("synopsis: contains trailing whitespace"): New test. Signed-off-by: Ludovic Courtès --- guix/lint.scm | 12 +++++++++++- tests/lint.scm | 7 +++++++ 2 files changed, 18 insertions(+), 1 deletion(-) (limited to 'tests') diff --git a/guix/lint.scm b/guix/lint.scm index 5cd6db5842..1aba9eff68 100644 --- a/guix/lint.scm +++ b/guix/lint.scm @@ -478,13 +478,23 @@ markup is valid return a plain-text version of SYNOPSIS, otherwise #f." (G_ "Texinfo markup in synopsis is invalid") #:field 'synopsis))))) + (define (check-no-trailing-whitespace synopsis) + "Check that SYNOPSIS doesn't have trailing whitespace." + (if (string-suffix? " " synopsis) + (list + (make-warning package + (G_ "synopsis contains trailing whitespace") + #:field 'synopsis)) + '())) + (define checks (list check-proper-start check-final-period check-start-article check-start-with-package-name check-synopsis-length - check-texinfo-markup)) + check-texinfo-markup + check-no-trailing-whitespace)) (match (package-synopsis package) ("" diff --git a/tests/lint.scm b/tests/lint.scm index f4c3dde774..97ed5ee827 100644 --- a/tests/lint.scm +++ b/tests/lint.scm @@ -271,6 +271,13 @@ (description "Imagine this is Taylor UUCP.")))) (check-synopsis-style pkg))) +(test-equal "synopsis: contains trailing whitespace" + "synopsis contains trailing whitespace" + (single-lint-warning-message + (let ((pkg (dummy-package "x" + (synopsis "Whitespace ")))) + (check-synopsis-style pkg)))) + (test-equal "name: use underscore in package name" "name should use hyphens instead of underscores" (single-lint-warning-message -- cgit v1.2.3 From 93d85deae6bce16bc21fb42ad6a68a1bcbb72527 Mon Sep 17 00:00:00 2001 From: Xinglu Chen Date: Sun, 30 May 2021 22:30:32 +0200 Subject: lint: Check for trailing whitespace in description. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * guix/lint.scm (check-description-style): Check for trailing whitespace. * tests/lint.scm: ("description: trailing whitespace"): New test. Signed-off-by: Ludovic Courtès --- guix/lint.scm | 10 ++++++++++ tests/lint.scm | 7 +++++++ 2 files changed, 17 insertions(+) (limited to 'tests') diff --git a/guix/lint.scm b/guix/lint.scm index 1aba9eff68..8115f2aa50 100644 --- a/guix/lint.scm +++ b/guix/lint.scm @@ -300,6 +300,15 @@ by two spaces; possible infraction~p at ~{~a~^, ~}") infractions) #:field 'description))))) + (define (check-no-trailing-whitespace description) + "Check that DESCRIPTION doesn't have trailing whitespace." + (if (string-suffix? " " description) + (list + (make-warning package + (G_ "description contains trailing whitespace") + #:field 'description)) + '())) + (let ((description (package-description package))) (if (string? description) (append @@ -309,6 +318,7 @@ by two spaces; possible infraction~p at ~{~a~^, ~}") ;; Use raw description for this because Texinfo rendering ;; automatically fixes end of sentence space. (check-end-of-sentence-space description) + (check-no-trailing-whitespace description) (match (check-texinfo-markup description) ((and warning (? lint-warning?)) (list warning)) (plain-description diff --git a/tests/lint.scm b/tests/lint.scm index 97ed5ee827..fae346e724 100644 --- a/tests/lint.scm +++ b/tests/lint.scm @@ -160,6 +160,13 @@ (description "This is a 'quoted' thing.")))) (check-description-style pkg)))) +(test-equal "description: trailing whitespace" + "description contains trailing whitespace" + (single-lint-warning-message + (let ((pkg (dummy-package "x" + (description "Whitespace. ")))) + (check-description-style pkg)))) + (test-equal "synopsis: not a string" "invalid synopsis: #f" (single-lint-warning-message -- cgit v1.2.3 From ee61777a326c3395518dee5e50ffc9c35ae53f3d Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 15 Jun 2021 10:02:48 +0200 Subject: profiles: Add 'load-profile'. * guix/profiles.scm (%precious-variables): New variable. (purify-environment, load-profile): New procedures. * guix/scripts/environment.scm (%precious-variables) (purify-environment, create-environment): Remove. (launch-environment): Call 'load-profile' instead of 'create-environment'. * tests/profiles.scm ("load-profile"): New test. --- guix/profiles.scm | 41 +++++++++++++++++++++++++++++++++++ guix/scripts/environment.scm | 51 +++++++------------------------------------- tests/profiles.scm | 27 +++++++++++++++++++++++ 3 files changed, 76 insertions(+), 43 deletions(-) (limited to 'tests') diff --git a/guix/profiles.scm b/guix/profiles.scm index 8cbffa4d2b..09b2d1525a 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -11,6 +11,7 @@ ;;; Copyright © 2019 Kyle Meyer ;;; Copyright © 2019 Mathieu Othacehe ;;; Copyright © 2020 Danny Milosavljevic +;;; Copyright © 2014 David Thompson ;;; ;;; This file is part of GNU Guix. ;;; @@ -54,6 +55,7 @@ #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) + #:autoload (srfi srfi-98) (get-environment-variables) #:export (&profile-error profile-error? profile-error-profile @@ -127,6 +129,7 @@ %default-profile-hooks profile-derivation profile-search-paths + load-profile profile profile? @@ -1916,6 +1919,44 @@ already effective." (evaluate-search-paths (manifest-search-paths manifest) (list profile) getenv)) +(define %precious-variables + ;; Environment variables in the default 'load-profile' white list. + '("HOME" "USER" "LOGNAME" "DISPLAY" "TERM" "TZ" "PAGER")) + +(define (purify-environment white-list white-list-regexps) + "Unset all environment variables except those that match the regexps in +WHITE-LIST-REGEXPS and those listed in WHITE-LIST." + (for-each unsetenv + (remove (lambda (variable) + (or (member variable white-list) + (find (cut regexp-exec <> variable) + white-list-regexps))) + (match (get-environment-variables) + (((names . _) ...) + names))))) + +(define* (load-profile profile + #:optional (manifest (profile-manifest profile)) + #:key pure? (white-list-regexps '()) + (white-list %precious-variables)) + "Set the environment variables specified by MANIFEST for PROFILE. When +PURE? is #t, unset the variables in the current environment except those that +match the regexps in WHITE-LIST-REGEXPS and those listed in WHITE-LIST. +Otherwise, augment existing environment variables with additional search +paths." + (when pure? + (purify-environment white-list white-list-regexps)) + (for-each (match-lambda + ((($ variable _ separator) . value) + (let ((current (getenv variable))) + (setenv variable + (if (and current (not pure?)) + (if separator + (string-append value separator current) + value) + value))))) + (profile-search-paths profile manifest))) + (define (profile-regexp profile) "Return a regular expression that matches PROFILE's name and number." (make-regexp (string-append "^" (regexp-quote (basename profile)) diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index 5ceb86f7a9..6958bd6238 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -52,50 +52,9 @@ #:export (assert-container-features guix-environment)) -;; Protect some env vars from purification. Borrowed from nix-shell. -(define %precious-variables - '("HOME" "USER" "LOGNAME" "DISPLAY" "TERM" "TZ" "PAGER")) - (define %default-shell (or (getenv "SHELL") "/bin/sh")) -(define (purify-environment white-list) - "Unset all environment variables except those that match the regexps in -WHITE-LIST and those listed in %PRECIOUS-VARIABLES. A small number of -variables such as 'HOME' and 'USER' are left untouched." - (for-each unsetenv - (remove (lambda (variable) - (or (member variable %precious-variables) - (find (cut regexp-exec <> variable) - white-list))) - (match (get-environment-variables) - (((names . _) ...) - names))))) - -(define* (create-environment profile manifest - #:key pure? (white-list '())) - "Set the environment variables specified by MANIFEST for PROFILE. When -PURE? is #t, unset the variables in the current environment except those that -match the regexps in WHITE-LIST. Otherwise, augment existing environment -variables with additional search paths." - (when pure? - (purify-environment white-list)) - (for-each (match-lambda - ((($ variable _ separator) . value) - (let ((current (getenv variable))) - (setenv variable - (if (and current (not pure?)) - (if separator - (string-append value separator current) - value) - value))))) - (profile-search-paths profile manifest)) - - ;; Give users a way to know that they're in 'guix environment', so they can - ;; adjust 'PS1' accordingly, for instance. Set it to PROFILE so users can - ;; conveniently access its contents. - (setenv "GUIX_ENVIRONMENT" profile)) - (define* (show-search-paths profile manifest #:key pure?) "Display the search paths of MANIFEST applied to PROFILE. When PURE? is #t, do not augment existing environment variables with additional search paths." @@ -425,8 +384,14 @@ regexps in WHITE-LIST." ;; Properly handle SIGINT, so pressing C-c in an interactive terminal ;; application works. (sigaction SIGINT SIG_DFL) - (create-environment profile manifest - #:pure? pure? #:white-list white-list) + (load-profile profile manifest + #:pure? pure? #:white-list-regexps white-list) + + ;; Give users a way to know that they're in 'guix environment', so they can + ;; adjust 'PS1' accordingly, for instance. Set it to PROFILE so users can + ;; conveniently access its contents. + (setenv "GUIX_ENVIRONMENT" profile) + (match command ((program . args) (apply execlp program program args)))) diff --git a/tests/profiles.scm b/tests/profiles.scm index ce77711d63..1a06ff88f3 100644 --- a/tests/profiles.scm +++ b/tests/profiles.scm @@ -279,6 +279,33 @@ (string=? (dirname (readlink bindir)) (derivation->output-path guile)))))) +(test-assertm "load-profile" + (mlet* %store-monad + ((entry -> (package->manifest-entry %bootstrap-guile)) + (guile (package->derivation %bootstrap-guile)) + (drv (profile-derivation (manifest (list entry)) + #:hooks '() + #:locales? #f)) + (profile -> (derivation->output-path drv)) + (bindir -> (string-append profile "/bin")) + (_ (built-derivations (list drv)))) + (define-syntax-rule (with-environment-excursion exp ...) + (let ((env (environ))) + (dynamic-wind + (const #t) + (lambda () exp ...) + (lambda () (environ env))))) + + (return (and (with-environment-excursion + (load-profile profile) + (and (string-prefix? (string-append bindir ":") + (getenv "PATH")) + (getenv "GUILE_LOAD_PATH"))) + (with-environment-excursion + (load-profile profile #:pure? #t #:white-list '()) + (equal? (list (string-append "PATH=" bindir)) + (environ))))))) + (test-assertm "" (mlet* %store-monad ((entry -> (package->manifest-entry %bootstrap-guile)) -- cgit v1.2.3