profiles: Raise an error for unmatched patterns.
Previously, "guix package -r something-not-installed" would silently
complete. Now an error is raised.
* guix/profiles.scm (&unmatched-pattern-error): New condition type.
(manifest-matching-entries): Rewrite to raise an error when one of
PATTERNS is not matched.
* guix/ui.scm (call-with-error-handling): Handle 'unmatched-pattern-error?'.
* tests/guix-package.sh: Add test.
* tests/profiles.scm ("manifest-matching-entries"): Don't try to remove
unmatched pattern.
("manifest-matching-entries, no match"): New test.
("manifest-transaction-effects"): Remove 'remove' field.
This commit is contained in:
Ludovic Courtès
Ludovic Courtès
parent
89ea6252b6
commit
487cbb0164
|
|
@ -63,6 +63,10 @@
|
|||
&missing-generation-error
|
||||
missing-generation-error?
|
||||
missing-generation-error-generation
|
||||
&unmatched-pattern-error
|
||||
unmatched-pattern-error?
|
||||
unmatched-pattern-error-pattern
|
||||
unmatched-pattern-error-manifest
|
||||
|
||||
manifest make-manifest
|
||||
manifest?
|
||||
|
|
@ -156,6 +160,11 @@
|
|||
(entry profile-collision-error-entry) ;<manifest-entry>
|
||||
(conflict profile-collision-error-conflict)) ;<manifest-entry>
|
||||
|
||||
(define-condition-type &unmatched-pattern-error &error
|
||||
unmatched-pattern-error?
|
||||
(pattern unmatched-pattern-error-pattern) ;<manifest-pattern>
|
||||
(manifest unmatched-pattern-error-manifest)) ;<manifest>
|
||||
|
||||
(define-condition-type &missing-generation-error &profile-error
|
||||
missing-generation-error?
|
||||
(generation missing-generation-error-generation))
|
||||
|
|
@ -559,16 +568,21 @@ no match.."
|
|||
(->bool (manifest-lookup manifest pattern)))
|
||||
|
||||
(define (manifest-matching-entries manifest patterns)
|
||||
"Return all the entries of MANIFEST that match one of the PATTERNS."
|
||||
(define predicates
|
||||
(map entry-predicate patterns))
|
||||
|
||||
(define (matches? entry)
|
||||
(any (lambda (pred)
|
||||
(pred entry))
|
||||
predicates))
|
||||
|
||||
(filter matches? (manifest-entries manifest)))
|
||||
"Return all the entries of MANIFEST that match one of the PATTERNS. Raise
|
||||
an '&unmatched-pattern-error' if none of the entries of MANIFEST matches one
|
||||
of PATTERNS."
|
||||
(fold-right (lambda (pattern matches)
|
||||
(match (filter (entry-predicate pattern)
|
||||
(manifest-entries manifest))
|
||||
(()
|
||||
(raise (condition
|
||||
(&unmatched-pattern-error
|
||||
(pattern pattern)
|
||||
(manifest manifest)))))
|
||||
(lst
|
||||
(append lst matches))))
|
||||
'()
|
||||
patterns))
|
||||
|
||||
(define (manifest-search-paths manifest)
|
||||
"Return the list of search path specifications that apply to MANIFEST,
|
||||
|
|
|
|||
|
|
@ -643,6 +643,14 @@ or remove one of them from the profile.")
|
|||
(leave (G_ "generation ~a of profile '~a' does not exist~%")
|
||||
(missing-generation-error-generation c)
|
||||
(profile-error-profile c)))
|
||||
((unmatched-pattern-error? c)
|
||||
(let ((pattern (unmatched-pattern-error-pattern c)))
|
||||
(leave (G_ "package '~a~@[@~a~]~@[:~a~]' not found in profile~%")
|
||||
(manifest-pattern-name pattern)
|
||||
(manifest-pattern-version pattern)
|
||||
(match (manifest-pattern-output pattern)
|
||||
("out" #f)
|
||||
(output output)))))
|
||||
((profile-collision-error? c)
|
||||
(let ((entry (profile-collision-error-entry c))
|
||||
(conflict (profile-collision-error-conflict c)))
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
# GNU Guix --- Functional package management for GNU
|
||||
# Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
|
||||
# Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
|
||||
# Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
|
||||
#
|
||||
# This file is part of GNU Guix.
|
||||
|
|
@ -97,6 +97,11 @@ then false; else true; fi
|
|||
if guix package --bootstrap -i "guile-bootstrap:does-not-exist" -p "$profile";
|
||||
then false; else true; fi
|
||||
|
||||
# Make sure we get an error when trying to remove something that's not
|
||||
# installed.
|
||||
if guix package --bootstrap -r something-not-installed -p "$profile";
|
||||
then false; else true; fi
|
||||
|
||||
# Check whether `--list-available' returns something sensible.
|
||||
guix package -p "$profile" -A 'gui.*e' | grep guile
|
||||
|
||||
|
|
|
|||
|
|
@ -93,10 +93,7 @@
|
|||
(test-assert "manifest-matching-entries"
|
||||
(let* ((e (list guile-2.0.9 guile-2.0.9:debug))
|
||||
(m (manifest e)))
|
||||
(and (null? (manifest-matching-entries m
|
||||
(list (manifest-pattern
|
||||
(name "python")))))
|
||||
(equal? e
|
||||
(and (equal? e
|
||||
(manifest-matching-entries m
|
||||
(list (manifest-pattern
|
||||
(name "guile")
|
||||
|
|
@ -107,6 +104,15 @@
|
|||
(name "guile")
|
||||
(version "2.0.9"))))))))
|
||||
|
||||
(test-assert "manifest-matching-entries, no match"
|
||||
(let ((m (manifest (list guile-2.0.9)))
|
||||
(p (manifest-pattern (name "python"))))
|
||||
(guard (c ((unmatched-pattern-error? c)
|
||||
(and (eq? p (unmatched-pattern-error-pattern c))
|
||||
(eq? m (unmatched-pattern-error-manifest c)))))
|
||||
(manifest-matching-entries m (list p))
|
||||
#f)))
|
||||
|
||||
(test-assert "manifest-remove"
|
||||
(let* ((m0 (manifest (list guile-2.0.9 guile-2.0.9:debug)))
|
||||
(m1 (manifest-remove m0
|
||||
|
|
@ -165,8 +171,7 @@
|
|||
(test-assert "manifest-transaction-effects"
|
||||
(let* ((m0 (manifest (list guile-1.8.8)))
|
||||
(t (manifest-transaction
|
||||
(install (list guile-2.0.9 glibc))
|
||||
(remove (list (manifest-pattern (name "coreutils")))))))
|
||||
(install (list guile-2.0.9 glibc)))))
|
||||
(let-values (((remove install upgrade downgrade)
|
||||
(manifest-transaction-effects m0 t)))
|
||||
(and (null? remove) (null? downgrade)
|
||||
|
|
|
|||
Loading…
Reference in New Issue