Broken `map-derivation' procedure

  • Open
  • quality assurance status badge
Details
3 participants
  • Ludovic Courtès
  • Sergio Pastor Pérez
  • Sergio Pastor Pérez
Owner
unassigned
Submitted by
Sergio Pastor Pérez
Severity
normal

Debbugs page

Sergio Pastor Pérez wrote 8 months ago
(address . bug-guix@gnu.org)
PAXP251MB03489F8E853184BD49C9D310F3DE2@PAXP251MB0348.EURP251.PROD.OUTLOOK.COM
Hello.

The procedure `map-derivation` from `(guix derivations)` seems broken.

Evaluating this yields an error, it probably shouldn't:
Toggle snippet (19 lines)
scheme@(guix-user)> (use-modules (guix)
(guix derivations)
(gnu packages)
(gnu packages perl)
(gnu packages games))
scheme@(guix-user)> (with-store store
(let ((cowsay-drv (package-derivation store cowsay))
(perl-drv (package-derivation store perl))
(perl-5.6-drv (package-derivation store perl-5.6)))
(map-derivation store
cowsay-drv
`((,perl-drv . ,perl-5.6-drv)))))
ice-9/boot-9.scm:1685:16: In procedure raise-exception:
In procedure fport_read: Is a directory

Entering a new prompt. Type `,bt' for a backtrace or `,q' to continue.
scheme@(guix-user) [1]>

If you inspect the `cowsay` derivation, you will see that the mapping
should be possible since it contains the `perl` derivation.

Does anyone have an idea on what could be the issue or how to investigate
further?

Thanks,
Sergio.
Sergio Pastor Pérez wrote 6 months ago
[PATCH] guix: fix map-derivation not handling directories
(address . 71941@debbugs.gnu.org)(name . Sergio Pastor Pérez)(address . sergio.pastorperez@outlook.es)
PAXP251MB0348632A500D4E1B1A078B75F3912@PAXP251MB0348.EURP251.PROD.OUTLOOK.COM
The `map-derivation` procedure was trying to process directories as files.
When a derivation had a 'module import' directory as input, it threw an
exception since it tried to open it as a file.

Change-Id: I9b766f9aaa03ea9307f73e8abb36bc347af4b5e6
---
Hi, as far as I know 'module import' directories don't contain derivation
references, so it should not be needed to apply `substitute-file` on the files of
those directories. This fix just returns the 'module import' directories
untouched. Thoughts?

Note that `map-derivation` is very slow. I could only test it with tiny
derivations, such as the ones provided in the '(gnu packages commencement)'
module.

You can test it with:
Toggle snippet (17 lines)
scheme@(guix-user)> (use-modules (guix store)
(guix packages)
(guix derivations)
(gnu packages games)
(gnu packages bootstrap))
scheme@(guix-user)> (with-store store
(let ((bootar-drv (package-derivation store (@@ (gnu packages commencement) bootar)))
(guile-bootstrap-drv (package-derivation store %bootstrap-guile))
(cowsay-drv (package-derivation store cowsay)))
(map-derivation store
bootar-drv
`((,guile-bootstrap-drv . ,cowsay-drv)))))
$1 = #<derivation /gnu/store/qwn18yxc1ccdxq1mgg863lfxsfwng3wk-bootar-1b.drv => /gnu/store/852xy3bhck2sd1hq1rmzai0px7fplxfq-bootar-1b 7fcfc3f05b90>
scheme@(guix-user)> (derivation-inputs $1)
$2 = (#<<derivation-input> drv: #<derivation /gnu/store/5rx5dn2xnkjs3q0rzpm66q79ndwrafp7-module-import-compiled.drv => /gnu/store/472plnlfm8yrb3axwy16fydq01idbkv1-module-import-compiled 7fcfc3f05d70> sub-derivations: ("out")> #<<derivation-input> drv: #<derivation /gnu/store/fhqh9f3lmf8wd9mh0bzavpkjnmsb0bg0-cowsay-3.7.0.drv => /gnu/store/vwa9vh21l68ivnwxj18s2gxd1v71w43r-cowsay-3.7.0 7fcfb73a50f0> sub-derivations: ("out")> #<<derivation-input> drv: #<derivation /gnu/store/k6852ja7cvdvbbdxh24ph711gm74m3qq-bootar-1b.ses.drv => /gnu/store/xmw3h03svpw6rwfg03f0m608zkm24qx8-bootar-1b.ses 7fcfc3f05f00> sub-derivations: ("out")>)

As you can see, with this fix, the new derivation has the `cowsay` package a an
input.

I would like to encourage people to discuss ways to improve the performance of
this procedure. It would be very useful for system wide package rewriting as
discussed in this thread[1].


Regards,
Sergio.


guix/derivations.scm | 6 ++++--
1 file changed, 4 insertions(+), 2 deletions(-)

Toggle diff (21 lines)
diff --git a/guix/derivations.scm b/guix/derivations.scm
index a91c1ae984..c16e1c2be3 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -1062,8 +1062,10 @@ (define* (map-derivation store drv mapping
((_ . replacement)
replacement)
(#f
- (substitute-file source
- initial replacements))))
+ (if (file-is-directory? source)
+ source
+ (substitute-file source
+ initial replacements)))))
(derivation-sources drv)))
;; Now augment the lists of initials and replacements.

base-commit: e1c92c98f7afff13fb7060199ba0dd4d9c5c2c53
--
2.45.2
Sergio Pastor Pérez wrote 4 weeks ago
[PATCH v2 1/2] guix: fix map-derivation not handling directories
(address . 71941@debbugs.gnu.org)
bd6d0cd65d321f03aad528391cc782564a405130.1738758574.git.sergio.pastorperez@gmail.com
The `map-derivation` procedure was trying to process directories as files.
When a derivation had a 'module import' directory as input, it threw an
exception since it tried to open it as a file.

Change-Id: I9b766f9aaa03ea9307f73e8abb36bc347af4b5e6
---
guix/derivations.scm | 6 ++++--
1 file changed, 4 insertions(+), 2 deletions(-)

Toggle diff (21 lines)
diff --git a/guix/derivations.scm b/guix/derivations.scm
index bef98cd26a..9c019a35bb 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -1074,8 +1074,10 @@ (define* (map-derivation store drv mapping
((_ . replacement)
replacement)
(#f
- (substitute-file source
- initial replacements))))
+ (if (file-is-directory? source)
+ source
+ (substitute-file source
+ initial replacements)))))
(derivation-sources drv)))
;; Now augment the lists of initials and replacements.

base-commit: d0dbba3053123ee623d8a5889f1a0946859a205e
--
2.48.1
Sergio Pastor Pérez wrote 4 weeks ago
[PATCH v2 2/2] guix: fix: slow `map-derivation' procedure
(address . 71941@debbugs.gnu.org)
00a6dd1e400f182156e8fa5a1de062944aa6a37e.1738758574.git.sergio.pastorperez@gmail.com
Implement caching to speed up computation.

Change-Id: I186e2a62f6655e3b0738dd6e0f628faccd8b855e
---
guix/derivations.scm | 108 +++++++++++++++++++++++--------------------
1 file changed, 58 insertions(+), 50 deletions(-)

Toggle diff (128 lines)
diff --git a/guix/derivations.scm b/guix/derivations.scm
index 9c019a35bb..aa7f55ee92 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -1044,7 +1044,8 @@ (define* (map-derivation store drv mapping
((file . replacement)
(vhash-cons file replacement result))))
vlist-null
- mapping)))
+ mapping))
+ (computed-drvs (make-hash-table 100)))
(define rewritten-input
;; Rewrite the given input according to MAPPING, and return an input
;; in the format used in 'derivation' calls.
@@ -1060,55 +1061,62 @@ (define* (map-derivation store drv mapping
(derivation-input (loop drv) sub-drvs)))))))
(let loop ((drv drv))
- (let* ((inputs (map (cut rewritten-input <> loop)
- (derivation-inputs drv)))
- (initial (append-map derivation-input-output-paths
- (derivation-inputs drv)))
- (replacements (append-map input->output-paths inputs))
-
- ;; Sources typically refer to the output directories of the
- ;; original inputs, INITIAL. Rewrite them by substituting
- ;; REPLACEMENTS.
- (sources (map (lambda (source)
- (match (vhash-assoc source mapping)
- ((_ . replacement)
- replacement)
- (#f
- (if (file-is-directory? source)
- source
- (substitute-file source
- initial replacements)))))
- (derivation-sources drv)))
-
- ;; Now augment the lists of initials and replacements.
- (initial (append (derivation-sources drv) initial))
- (replacements (append sources replacements))
- (name (store-path-package-name
- (string-drop-right (derivation-file-name drv)
- 4))))
- (derivation store name
- (substitute (derivation-builder drv)
- initial replacements)
- (map (cut substitute <> initial replacements)
- (derivation-builder-arguments drv))
- #:system system
- #:env-vars (map (match-lambda
- ((var . value)
- `(,var
- . ,(substitute value initial
- replacements))))
- (derivation-builder-environment-vars drv))
- #:inputs (filter derivation-input? inputs)
- #:sources (append sources (filter string? inputs))
- #:outputs (derivation-output-names drv)
- #:hash (match (derivation-outputs drv)
- ((($ <derivation-output> _ algo hash))
- hash)
- (_ #f))
- #:hash-algo (match (derivation-outputs drv)
- ((($ <derivation-output> _ algo hash))
- algo)
- (_ #f)))))))
+ (let ((cached-drv (hash-ref computed-drvs drv)))
+ (if cached-drv
+ cached-drv
+ (let* ((inputs (map (cut rewritten-input <> loop)
+ (derivation-inputs drv)))
+ (initial (append-map derivation-input-output-paths
+ (derivation-inputs drv)))
+ (replacements (append-map input->output-paths inputs))
+
+ ;; Sources typically refer to the output directories of the
+ ;; original inputs, INITIAL. Rewrite them by substituting
+ ;; REPLACEMENTS.
+ (sources (map (lambda (source)
+ (match (vhash-assoc source mapping)
+ ((_ . replacement)
+ replacement)
+ (#f
+ (if (file-is-directory? source)
+ source
+ (substitute-file source
+ initial replacements)))))
+ (derivation-sources drv)))
+
+ ;; Now augment the lists of initials and replacements.
+ (initial (append (derivation-sources drv) initial))
+ (replacements (append sources replacements))
+ (name (store-path-package-name
+ (string-drop-right (derivation-file-name drv)
+ 4))))
+
+ (hash-set!
+ computed-drvs
+ drv
+ (derivation store name
+ (substitute (derivation-builder drv)
+ initial replacements)
+ (map (cut substitute <> initial replacements)
+ (derivation-builder-arguments drv))
+ #:system system
+ #:env-vars (map (match-lambda
+ ((var . value)
+ `(,var
+ . ,(substitute value initial
+ replacements))))
+ (derivation-builder-environment-vars drv))
+ #:inputs (filter derivation-input? inputs)
+ #:sources (append sources (filter string? inputs))
+ #:outputs (derivation-output-names drv)
+ #:hash (match (derivation-outputs drv)
+ ((($ <derivation-output> _ algo hash))
+ hash)
+ (_ #f))
+ #:hash-algo (match (derivation-outputs drv)
+ ((($ <derivation-output> _ algo hash))
+ algo)
+ (_ #f))))))))))
;;;
--
2.48.1
Sergio Pastor Pérez wrote 2 weeks ago
[PATCH v3 1/2] guix: fix: map-derivation not handling directories
(address . 71941@debbugs.gnu.org)(name . Sergio Pastor Pérez)(address . sergio.pastorperez@gmail.com)
c803f54d538ce37f043422f86fe8938316a73b15.1740331748.git.sergio.pastorperez@gmail.com
The `map-derivation` procedure was trying to process directories as files.
When a derivation had a 'module import' directory as input, it threw an
exception since it tried to open it as a file.

Change-Id: I9b766f9aaa03ea9307f73e8abb36bc347af4b5e6
---
guix/derivations.scm | 6 ++++--
1 file changed, 4 insertions(+), 2 deletions(-)

Toggle diff (21 lines)
diff --git a/guix/derivations.scm b/guix/derivations.scm
index bef98cd26a..9c019a35bb 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -1074,8 +1074,10 @@ (define* (map-derivation store drv mapping
((_ . replacement)
replacement)
(#f
- (substitute-file source
- initial replacements))))
+ (if (file-is-directory? source)
+ source
+ (substitute-file source
+ initial replacements)))))
(derivation-sources drv)))
;; Now augment the lists of initials and replacements.

base-commit: 00787cd61611d74d3e54b160e94176905d36ef39
--
2.48.1
Sergio Pastor Pérez wrote 2 weeks ago
[PATCH v3 2/2] guix: fix: slow map-derivation procedure
(address . 71941@debbugs.gnu.org)(name . Sergio Pastor Pérez)(address . sergio.pastorperez@gmail.com)
6f67d2c9b2e14a6c1fd77689d959ddf5ca0a256d.1740331748.git.sergio.pastorperez@gmail.com
Implement caching to speed up computation.

Change-Id: I186e2a62f6655e3b0738dd6e0f628faccd8b855e
---
guix/derivations.scm | 109 +++++++++++++++++++++++--------------------
1 file changed, 59 insertions(+), 50 deletions(-)

Toggle diff (136 lines)
diff --git a/guix/derivations.scm b/guix/derivations.scm
index 9c019a35bb..8ec36b0fe3 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012-2021, 2023-2024 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016, 2017 Mathieu Lirzin <mthl@gnu.org>
+;;; Copyright © 2025 Sergio Pastor Pérez <sergio.pastorperez@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -1044,7 +1045,8 @@ (define* (map-derivation store drv mapping
((file . replacement)
(vhash-cons file replacement result))))
vlist-null
- mapping)))
+ mapping))
+ (computed-drvs (make-hash-table 100)))
(define rewritten-input
;; Rewrite the given input according to MAPPING, and return an input
;; in the format used in 'derivation' calls.
@@ -1060,55 +1062,62 @@ (define* (map-derivation store drv mapping
(derivation-input (loop drv) sub-drvs)))))))
(let loop ((drv drv))
- (let* ((inputs (map (cut rewritten-input <> loop)
- (derivation-inputs drv)))
- (initial (append-map derivation-input-output-paths
- (derivation-inputs drv)))
- (replacements (append-map input->output-paths inputs))
-
- ;; Sources typically refer to the output directories of the
- ;; original inputs, INITIAL. Rewrite them by substituting
- ;; REPLACEMENTS.
- (sources (map (lambda (source)
- (match (vhash-assoc source mapping)
- ((_ . replacement)
- replacement)
- (#f
- (if (file-is-directory? source)
- source
- (substitute-file source
- initial replacements)))))
- (derivation-sources drv)))
-
- ;; Now augment the lists of initials and replacements.
- (initial (append (derivation-sources drv) initial))
- (replacements (append sources replacements))
- (name (store-path-package-name
- (string-drop-right (derivation-file-name drv)
- 4))))
- (derivation store name
- (substitute (derivation-builder drv)
- initial replacements)
- (map (cut substitute <> initial replacements)
- (derivation-builder-arguments drv))
- #:system system
- #:env-vars (map (match-lambda
- ((var . value)
- `(,var
- . ,(substitute value initial
- replacements))))
- (derivation-builder-environment-vars drv))
- #:inputs (filter derivation-input? inputs)
- #:sources (append sources (filter string? inputs))
- #:outputs (derivation-output-names drv)
- #:hash (match (derivation-outputs drv)
- ((($ <derivation-output> _ algo hash))
- hash)
- (_ #f))
- #:hash-algo (match (derivation-outputs drv)
- ((($ <derivation-output> _ algo hash))
- algo)
- (_ #f)))))))
+ (let ((cached-drv (hash-ref computed-drvs drv)))
+ (if cached-drv
+ cached-drv
+ (let* ((inputs (map (cut rewritten-input <> loop)
+ (derivation-inputs drv)))
+ (initial (append-map derivation-input-output-paths
+ (derivation-inputs drv)))
+ (replacements (append-map input->output-paths inputs))
+
+ ;; Sources typically refer to the output directories of the
+ ;; original inputs, INITIAL. Rewrite them by substituting
+ ;; REPLACEMENTS.
+ (sources (map (lambda (source)
+ (match (vhash-assoc source mapping)
+ ((_ . replacement)
+ replacement)
+ (#f
+ (if (file-is-directory? source)
+ source
+ (substitute-file source
+ initial replacements)))))
+ (derivation-sources drv)))
+
+ ;; Now augment the lists of initials and replacements.
+ (initial (append (derivation-sources drv) initial))
+ (replacements (append sources replacements))
+ (name (store-path-package-name
+ (string-drop-right (derivation-file-name drv)
+ 4))))
+
+ (hash-set!
+ computed-drvs
+ drv
+ (derivation store name
+ (substitute (derivation-builder drv)
+ initial replacements)
+ (map (cut substitute <> initial replacements)
+ (derivation-builder-arguments drv))
+ #:system system
+ #:env-vars (map (match-lambda
+ ((var . value)
+ `(,var
+ . ,(substitute value initial
+ replacements))))
+ (derivation-builder-environment-vars drv))
+ #:inputs (filter derivation-input? inputs)
+ #:sources (append sources (filter string? inputs))
+ #:outputs (derivation-output-names drv)
+ #:hash (match (derivation-outputs drv)
+ ((($ <derivation-output> _ algo hash))
+ hash)
+ (_ #f))
+ #:hash-algo (match (derivation-outputs drv)
+ ((($ <derivation-output> _ algo hash))
+ algo)
+ (_ #f))))))))))
;;;
--
2.48.1
Ludovic Courtès wrote 1 weeks ago
Re: bug#71941: Broken `map-derivation' procedure
(name . Sergio Pastor Pérez)(address . sergio.pastorperez@gmail.com)
87v7sylz0f.fsf_-_@gnu.org
Hi Sergio,

Sergio Pastor Pérez <sergio.pastorperez@gmail.com> skribis:

Toggle quote (24 lines)
> The `map-derivation` procedure was trying to process directories as files.
> When a derivation had a 'module import' directory as input, it threw an
> exception since it tried to open it as a file.
>
> Change-Id: I9b766f9aaa03ea9307f73e8abb36bc347af4b5e6
> ---
> guix/derivations.scm | 6 ++++--
> 1 file changed, 4 insertions(+), 2 deletions(-)
>
> diff --git a/guix/derivations.scm b/guix/derivations.scm
> index bef98cd26a..9c019a35bb 100644
> --- a/guix/derivations.scm
> +++ b/guix/derivations.scm
> @@ -1074,8 +1074,10 @@ (define* (map-derivation store drv mapping
> ((_ . replacement)
> replacement)
> (#f
> - (substitute-file source
> - initial replacements))))
> + (if (file-is-directory? source)
> + source
> + (substitute-file source
> + initial replacements)))))

Could you add a unit test for this specific case?

Bonus points if you come up with a commit log that follows our
conventions. :-) (I can do it on your behalf if you’re not sure.)

Thanks,
Ludo’.
Ludovic Courtès wrote 1 weeks ago
(name . Sergio Pastor Pérez)(address . sergio.pastorperez@gmail.com)
87msealysm.fsf_-_@gnu.org
Sergio Pastor Pérez <sergio.pastorperez@gmail.com> skribis:

Toggle quote (4 lines)
> Implement caching to speed up computation.
>
> Change-Id: I186e2a62f6655e3b0738dd6e0f628faccd8b855e

Nice!

Toggle quote (5 lines)
> + (let ((cached-drv (hash-ref computed-drvs drv)))
> + (if cached-drv
> + cached-drv
> + (let* ((inputs (map (cut rewritten-input <> loop)

Two things:

1. Preferably use ‘hashq-set!’ and ‘hashq-ref’ for the cache, to
compare derivations according to ‘eq?’;

2. Instead of rolling your own, perhaps you can use ‘mlambdaq’, which
also has the advantage of maintaining statistics; you can see them
by setting GUIX_PROFILING=memoization.

For #2, essentially you would write:

(define loop
(mlambdaq (drv)
contents of the loop…))

(loop drv)

I *think* that would do the job.

We you able to test this on meaningful cases?

Thanks for your work, and apologies for the delay!

Ludo’.
Sergio Pastor Pérez wrote 5 days ago
[PATCH v4 1/3] guix: fix: 'map-derivation' not handling directories
(address . 71941@debbugs.gnu.org)(name . Sergio Pastor Pérez)(address . sergio.pastorperez@gmail.com)
7090bd5fec7bfd51bad65aa6eebd7aea7c9a7b7f.1740852370.git.sergio.pastorperez@gmail.com
The 'map-derivation' procedure was trying to process directories as files.
When a derivation had a 'module import' directory as input, it threw an
exception since it tried to open it as a file.

Change-Id: I9b766f9aaa03ea9307f73e8abb36bc347af4b5e6
---
guix/derivations.scm | 7 +++++--
1 file changed, 5 insertions(+), 2 deletions(-)

Toggle diff (29 lines)
diff --git a/guix/derivations.scm b/guix/derivations.scm
index ffa69e924c..d84d1a391c 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -1,6 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012-2021, 2023-2024 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016, 2017 Mathieu Lirzin <mthl@gnu.org>
+;;; Copyright © 2025 Sergio Pastor Pérez <sergio.pastorperez@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -1074,8 +1075,10 @@ (define* (map-derivation store drv mapping
((_ . replacement)
replacement)
(#f
- (substitute-file source
- initial replacements))))
+ (if (file-is-directory? source)
+ source
+ (substitute-file source
+ initial replacements)))))
(derivation-sources drv)))
;; Now augment the lists of initials and replacements.

base-commit: 256bee7d0b72df2d471e1db071500e7635462ad7
--
2.48.1
Sergio Pastor Pérez wrote 5 days ago
[PATCH v4 2/3] guix: fix: Slow 'map-derivation' procedure
(address . 71941@debbugs.gnu.org)(name . Sergio Pastor Pérez)(address . sergio.pastorperez@gmail.com)
193c3a8ea0ce9ef0b8ecba5232129b950fba6bb8.1740852370.git.sergio.pastorperez@gmail.com
Implement caching to speed up computation through memoization.

Change-Id: I186e2a62f6655e3b0738dd6e0f628faccd8b855e
---
guix/derivations.scm | 103 ++++++++++++++++++++++---------------------
1 file changed, 53 insertions(+), 50 deletions(-)

Toggle diff (116 lines)
diff --git a/guix/derivations.scm b/guix/derivations.scm
index d84d1a391c..9b44febdb8 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -1060,56 +1060,59 @@ (define* (map-derivation store drv mapping
(#f
(derivation-input (loop drv) sub-drvs)))))))
- (let loop ((drv drv))
- (let* ((inputs (map (cut rewritten-input <> loop)
- (derivation-inputs drv)))
- (initial (append-map derivation-input-output-paths
- (derivation-inputs drv)))
- (replacements (append-map input->output-paths inputs))
-
- ;; Sources typically refer to the output directories of the
- ;; original inputs, INITIAL. Rewrite them by substituting
- ;; REPLACEMENTS.
- (sources (map (lambda (source)
- (match (vhash-assoc source mapping)
- ((_ . replacement)
- replacement)
- (#f
- (if (file-is-directory? source)
- source
- (substitute-file source
- initial replacements)))))
- (derivation-sources drv)))
-
- ;; Now augment the lists of initials and replacements.
- (initial (append (derivation-sources drv) initial))
- (replacements (append sources replacements))
- (name (store-path-package-name
- (string-drop-right (derivation-file-name drv)
- 4))))
- (derivation store name
- (substitute (derivation-builder drv)
- initial replacements)
- (map (cut substitute <> initial replacements)
- (derivation-builder-arguments drv))
- #:system system
- #:env-vars (map (match-lambda
- ((var . value)
- `(,var
- . ,(substitute value initial
- replacements))))
- (derivation-builder-environment-vars drv))
- #:inputs (filter derivation-input? inputs)
- #:sources (append sources (filter string? inputs))
- #:outputs (derivation-output-names drv)
- #:hash (match (derivation-outputs drv)
- ((($ <derivation-output> _ algo hash))
- hash)
- (_ #f))
- #:hash-algo (match (derivation-outputs drv)
- ((($ <derivation-output> _ algo hash))
- algo)
- (_ #f)))))))
+ (define loop
+ (mlambdaq (drv)
+ (let* ((inputs (map (cut rewritten-input <> loop)
+ (derivation-inputs drv)))
+ (initial (append-map derivation-input-output-paths
+ (derivation-inputs drv)))
+ (replacements (append-map input->output-paths inputs))
+
+ ;; Sources typically refer to the output directories of the
+ ;; original inputs, INITIAL. Rewrite them by substituting
+ ;; REPLACEMENTS.
+ (sources (map (lambda (source)
+ (match (vhash-assoc source mapping)
+ ((_ . replacement)
+ replacement)
+ (#f
+ (if (file-is-directory? source)
+ source
+ (substitute-file source
+ initial replacements)))))
+ (derivation-sources drv)))
+
+ ;; Now augment the lists of initials and replacements.
+ (initial (append (derivation-sources drv) initial))
+ (replacements (append sources replacements))
+ (name (store-path-package-name
+ (string-drop-right (derivation-file-name drv)
+ 4))))
+ (derivation store name
+ (substitute (derivation-builder drv)
+ initial replacements)
+ (map (cut substitute <> initial replacements)
+ (derivation-builder-arguments drv))
+ #:system system
+ #:env-vars (map (match-lambda
+ ((var . value)
+ `(,var
+ . ,(substitute value initial
+ replacements))))
+ (derivation-builder-environment-vars drv))
+ #:inputs (filter derivation-input? inputs)
+ #:sources (append sources (filter string? inputs))
+ #:outputs (derivation-output-names drv)
+ #:hash (match (derivation-outputs drv)
+ ((($ <derivation-output> _ algo hash))
+ hash)
+ (_ #f))
+ #:hash-algo (match (derivation-outputs drv)
+ ((($ <derivation-output> _ algo hash))
+ algo)
+ (_ #f))))))
+
+ (loop drv)))
;;;
--
2.48.1
Sergio Pastor Pérez wrote 5 days ago
[PATCH v4 3/3] tests: Add unit test for 'map-derivation' that tests import modules as inputs
(address . 71941@debbugs.gnu.org)(name . Sergio Pastor Pérez)(address . sergio.pastorperez@gmail.com)
c6dfb889c586387960d040d474d8c0c838fdfad6.1740852370.git.sergio.pastorperez@gmail.com
* tests/derivations.scm ("map-derivation, modules"): New test.

Change-Id: I4cc18a643a9b64caeea0ae16456bdbdb56ea8c4e
---
tests/derivations.scm | 25 +++++++++++++++++++++++++
1 file changed, 25 insertions(+)

Toggle diff (51 lines)
diff --git a/tests/derivations.scm b/tests/derivations.scm
index 72ea9aa9cc..ffe921b284 100644
--- a/tests/derivations.scm
+++ b/tests/derivations.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012-2024 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2025 Sergio Pastor Pérez <sergio.pastorperez@gmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -20,6 +21,7 @@
(define-module (test-derivations)
#:use-module (guix derivations)
+ #:use-module (guix gexp)
#:use-module (guix store)
#:use-module (guix utils)
#:use-module ((gcrypt hash) #:prefix gcrypt:)
@@ -1483,6 +1485,29 @@ (define %coreutils
(and (build-derivations %store (list (pk 'remapped* drv2)))
(call-with-input-file out get-string-all))))
+(test-assert "map-derivation, modules"
+ (let* ((bash-drv (package-derivation %store (@ (gnu packages bash) bash)))
+ (bash-input (car (derivation-inputs bash-drv)))
+ (bash-input-drv (derivation-input-derivation bash-input))
+ (drv-with-modules (run-with-store %store
+ (gexp->derivation "derivation-with-modules"
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils))
+ (mkdir-p (string-append #$output
+ "/bin")))))))
+ (bash-mapped-1 (map-derivation %store bash-drv
+ `((,bash-input-drv . ,drv-with-modules))))
+ (bash-mapped-2 (map-derivation %store bash-mapped-1
+ `((,drv-with-modules . ,bash-input-drv))))
+ (is-input? (lambda (in drv)
+ (not (null? (filter (lambda (input)
+ (eq? in (derivation-input-derivation input)))
+ (derivation-inputs drv)))))))
+ (and
+ (not (is-input? bash-input-drv bash-mapped-1))
+ (is-input? bash-input-drv bash-mapped-2))))
+
(test-end)
;; Local Variables:
--
2.48.1
Sergio Pastor Pérez wrote 5 days ago
Re: bug#71941: Broken `map-derivation' procedure
(name . Ludovic Courtès)(address . ludo@gnu.org)
84a5a4ee0u.fsf@gmail.com
Hello, Ludo!

Ludovic Courtès <ludo@gnu.org> writes:
Toggle quote (2 lines)
> We you able to test this on meaningful cases?

I would test it for rewriting a complete OS with alternative graphic
drivers, but I don't completely understand how a derivation is computed.

For example, the `supertux' package has the `mesa' package as input, I
would expect that the derivation of the `mesa' package would be
contained in the `supertux' derivation inputs.

This code illustrates that this is not the case:
Toggle snippet (14 lines)
(use-modules (guix store)
(guix packages)
(guix derivations)
(gnu packages gl)
(gnu packages games))

(with-store store
(values (filter (lambda (drv)
(equal? (string-append (package-name mesa) "-" (package-version mesa))
(derivation-name (derivation-input-derivation drv))))
(derivation-inputs (package-derivation store supertux)))
(package-derivation store mesa)))

The above code filters all `mesa' derivations from the `supertux'
derivation inputs, and returns them as the first value, it also returns
the derivation of the `mesa' package. Evaluating the code yields the
following result:
Toggle snippet (4 lines)
$9 = (#<<derivation-input> drv: #<derivation /gnu/store/7fsqc78lxp1jsclyl9rjpia9axk2wbq7-mesa-24.3.2.drv => /gnu/store/fmvqq46l2bqgby8ci87by8ycn51nc6x2-mesa-24.3.2-bin /gnu/store/s06dfjxf2sg12airxma7yyjjfa6y7mak-mesa-24.3.2 7ff44156c460> sub-derivations: ("out")> #<<derivation-input> drv: #<derivation /gnu/store/g0ys6y85xixv4bha8vh84gav47ci9fb0-mesa-24.3.2.drv => /gnu/store/g1rwi3s1xrz4swlz97szqmzd5w171p76-mesa-24.3.2 7ff4400705f0> sub-derivations: ("out")>)
$10 = #<derivation /gnu/store/jn8kxv3hvafb0s5xfrk304c57f6r3pkj-mesa-24.3.2.drv => /gnu/store/4ki84lapkja3zkca9gcvsbnh28rlk2wf-mesa-24.3.2-bin /gnu/store/cdw9y91nrfw2pwyycj69wj2kz7jw336w-mesa-24.3.2 7ff4406e2be0>

As you can see, the inputs of the `supertux' derivation contain a
different derivation from the one that the `mesa' package returns. I
don't know if this is related to grafting.

Since I don't see how a package translates to a derivation, I cannot map
`mesa' to a different package system wide using `map-derivation'. I
would expect packages to map 1:1 with output derivations.

Please, could anyone shed some light on this confusion?


Best regards,
Sergio.
?
Your comment

Commenting via the web interface is currently disabled.

To comment on this conversation send an email to 71941@debbugs.gnu.org

To respond to this issue using the mumi CLI, first switch to it
mumi current 71941
Then, you may apply the latest patchset in this issue (with sign off)
mumi am -- -s
Or, compose a reply to this issue
mumi compose
Or, send patches to this issue
mumi send-email *.patch
You may also tag this issue. See list of standard tags. For example, to set the confirmed and easy tags
mumi command -t +confirmed -t +easy
Or, remove the moreinfo tag and set the help tag
mumi command -t -moreinfo -t +help