diff options
author | Ludovic Courtès <ludo@gnu.org> | 2018-10-27 15:45:45 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2018-10-27 16:39:29 +0200 |
commit | 932d1600564cbf359a6ccd1086b968a934bef8e5 (patch) | |
tree | 36b8f047e54ec51c1638510405e9e8283171e963 /guix | |
parent | 003789e837d8524edf524e25fd753dbd801b583f (diff) |
gexp: 'gexp-modules' now consistently deletes duplicates.
Fixes <https://bugs.gnu.org/32966>.
Reported by Clément Lassieur <clement@lassieur.org>.
* guix/gexp.scm (gexp-attribute): Add 'equal?' optional parameter; pass
it to 'delete-duplicates'.
(gexp-modules)[module=?]: New procedure.
Pass it to 'gexp-attribute'.
* tests/gexp.scm ("gexp-modules deletes duplicates"): New test.
Diffstat (limited to 'guix')
-rw-r--r-- | guix/gexp.scm | 25 |
1 files changed, 21 insertions, 4 deletions
diff --git a/guix/gexp.scm b/guix/gexp.scm index ba0d642b17..537875b6b7 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -506,9 +506,10 @@ whether this should be considered a \"native\" input or not." (set-record-type-printer! <gexp-output> write-gexp-output) -(define (gexp-attribute gexp self-attribute) +(define* (gexp-attribute gexp self-attribute #:optional (equal? equal?)) "Recurse on GEXP and the expressions it refers to, summing the items -returned by SELF-ATTRIBUTE, a procedure that takes a gexp." +returned by SELF-ATTRIBUTE, a procedure that takes a gexp. Use EQUAL? as the +second argument to 'delete-duplicates'." (if (gexp? gexp) (delete-duplicates (append (self-attribute gexp) @@ -524,13 +525,29 @@ returned by SELF-ATTRIBUTE, a procedure that takes a gexp." lst)) (_ '())) - (gexp-references gexp)))) + (gexp-references gexp))) + equal?) '())) ;plain Scheme data type (define (gexp-modules gexp) "Return the list of Guile module names GEXP relies on. If (gexp? GEXP) is false, meaning that GEXP is a plain Scheme object, return the empty list." - (gexp-attribute gexp gexp-self-modules)) + (define (module=? m1 m2) + ;; Return #t when M1 equals M2. Special-case '=>' specs because their + ;; right-hand side may not be comparable with 'equal?': it's typically a + ;; file-like object that embeds a gexp, which in turn embeds closure; + ;; those closures may be 'eq?' when running compiled code but are unlikely + ;; to be 'eq?' when running on 'eval'. Ignore the right-hand side to + ;; avoid this discrepancy. + (match m1 + (((name1 ...) '=> _) + (match m2 + (((name2 ...) '=> _) (equal? name1 name2)) + (_ #f))) + (_ + (equal? m1 m2)))) + + (gexp-attribute gexp gexp-self-modules module=?)) (define (gexp-extensions gexp) "Return the list of Guile extensions (packages) GEXP relies on. If (gexp? |