GNU bug report logs - #71941
Broken `map-derivation' procedure

Previous Next

Package: guix;

Reported by: Sergio Pastor Pérez <sergio.pastorperez <at> outlook.es>

Date: Thu, 4 Jul 2024 15:06:02 UTC

Severity: normal

To reply to this bug, email your comments to 71941 AT debbugs.gnu.org.

Toggle the display of automated, internal messages from the tracker.

View this report as an mbox folder, status mbox, maintainer mbox


Report forwarded to bug-guix <at> gnu.org:
bug#71941; Package guix. (Thu, 04 Jul 2024 15:06:02 GMT) Full text and rfc822 format available.

Acknowledgement sent to Sergio Pastor Pérez <sergio.pastorperez <at> outlook.es>:
New bug report received and forwarded. Copy sent to bug-guix <at> gnu.org. (Thu, 04 Jul 2024 15:06:02 GMT) Full text and rfc822 format available.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Sergio Pastor Pérez <sergio.pastorperez <at> outlook.es>
To: bug-guix <at> gnu.org
Subject: Broken `map-derivation' procedure
Date: Thu, 04 Jul 2024 16:59:55 +0200
Hello.

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

Evaluating this yields an error, it probably shouldn't:
--8<---------------cut here---------------start------------->8---
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]> 
--8<---------------cut here---------------end--------------->8---

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.




Information forwarded to sergio.pastorperez <at> outlook.es, guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, zimon.toutoune <at> gmail.com, me <at> tobias.gr, bug-guix <at> gnu.org:
bug#71941; Package guix. (Sun, 01 Sep 2024 16:17:02 GMT) Full text and rfc822 format available.

Message #8 received at 71941 <at> debbugs.gnu.org (full text, mbox):

From: Sergio Pastor Pérez <sergio.pastorperez <at> outlook.es>
To: 71941 <at> debbugs.gnu.org
Cc: Sergio Pastor Pérez <sergio.pastorperez <at> outlook.es>
Subject: [PATCH] guix: fix map-derivation not handling directories
Date: Sun,  1 Sep 2024 18:15:05 +0200
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:
--8<---------------cut here---------------start------------->8---
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")>)
--8<---------------cut here---------------end--------------->8---

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].

[1]: https://lists.gnu.org/archive/html/guix-devel/2024-06/msg00275.html

Regards,
Sergio.


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

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





Information forwarded to sergio.pastorperez <at> outlook.es, guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, zimon.toutoune <at> gmail.com, me <at> tobias.gr, bug-guix <at> gnu.org:
bug#71941; Package guix. (Wed, 05 Feb 2025 14:47:03 GMT) Full text and rfc822 format available.

Message #11 received at 71941 <at> debbugs.gnu.org (full text, mbox):

From: Sergio Pastor Pérez <sergio.pastorperez <at> gmail.com>
To: 71941 <at> debbugs.gnu.org
Cc: ludo <at> gnu.org,
 Sergio Pastor Pérez <sergio.pastorperez <at> gmail.com>
Subject: [PATCH v2 1/2] guix: fix map-derivation not handling directories
Date: Wed,  5 Feb 2025 13:29:33 +0100
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)))))
                                 (derivation-sources drv)))
 
              ;; Now augment the lists of initials and replacements.

base-commit: d0dbba3053123ee623d8a5889f1a0946859a205e
-- 
2.48.1





Information forwarded to sergio.pastorperez <at> outlook.es, guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, zimon.toutoune <at> gmail.com, me <at> tobias.gr, bug-guix <at> gnu.org:
bug#71941; Package guix. (Wed, 05 Feb 2025 14:47:03 GMT) Full text and rfc822 format available.

Message #14 received at 71941 <at> debbugs.gnu.org (full text, mbox):

From: Sergio Pastor Pérez <sergio.pastorperez <at> gmail.com>
To: 71941 <at> debbugs.gnu.org
Cc: ludo <at> gnu.org,
 Sergio Pastor Pérez <sergio.pastorperez <at> gmail.com>
Subject: [PATCH v2 2/2] guix: fix: slow `map-derivation' procedure
Date: Wed,  5 Feb 2025 13:29:34 +0100
Implement caching to speed up computation.

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

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





Information forwarded to sergio.pastorperez <at> outlook.es, sergio.pastorperez <at> gmail.com, guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, zimon.toutoune <at> gmail.com, me <at> tobias.gr, bug-guix <at> gnu.org:
bug#71941; Package guix. (Sun, 23 Feb 2025 21:19:02 GMT) Full text and rfc822 format available.

Message #17 received at 71941 <at> debbugs.gnu.org (full text, mbox):

From: Sergio Pastor Pérez <sergio.pastorperez <at> gmail.com>
To: 71941 <at> debbugs.gnu.org
Cc: Sergio Pastor Pérez <sergio.pastorperez <at> gmail.com>
Subject: [PATCH v3 1/2] guix: fix: map-derivation not handling directories
Date: Sun, 23 Feb 2025 18:29:07 +0100
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)))))
                                 (derivation-sources drv)))
 
              ;; Now augment the lists of initials and replacements.

base-commit: 00787cd61611d74d3e54b160e94176905d36ef39
-- 
2.48.1





Information forwarded to sergio.pastorperez <at> outlook.es, sergio.pastorperez <at> gmail.com, guix <at> cbaines.net, dev <at> jpoiret.xyz, ludo <at> gnu.org, othacehe <at> gnu.org, zimon.toutoune <at> gmail.com, me <at> tobias.gr, bug-guix <at> gnu.org:
bug#71941; Package guix. (Sun, 23 Feb 2025 21:19:03 GMT) Full text and rfc822 format available.

Message #20 received at 71941 <at> debbugs.gnu.org (full text, mbox):

From: Sergio Pastor Pérez <sergio.pastorperez <at> gmail.com>
To: 71941 <at> debbugs.gnu.org
Cc: Sergio Pastor Pérez <sergio.pastorperez <at> gmail.com>
Subject: [PATCH v3 2/2] guix: fix: slow map-derivation procedure
Date: Sun, 23 Feb 2025 18:29:08 +0100
Implement caching to speed up computation.

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

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 <at> gnu.org>
 ;;; Copyright © 2016, 2017 Mathieu Lirzin <mthl <at> gnu.org>
+;;; Copyright © 2025 Sergio Pastor Pérez <sergio.pastorperez <at> 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





Information forwarded to bug-guix <at> gnu.org:
bug#71941; Package guix. (Tue, 25 Feb 2025 17:24:02 GMT) Full text and rfc822 format available.

Message #23 received at 71941 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Sergio Pastor Pérez <sergio.pastorperez <at> gmail.com>
Cc: Josselin Poiret <dev <at> jpoiret.xyz>,
 Simon Tournier <zimon.toutoune <at> gmail.com>, Mathieu Othacehe <othacehe <at> gnu.org>,
 Tobias Geerinckx-Rice <me <at> tobias.gr>, 71941 <at> debbugs.gnu.org,
 Christopher Baines <guix <at> cbaines.net>,
 Sergio Pastor Pérez <sergio.pastorperez <at> outlook.es>
Subject: Re: bug#71941: Broken `map-derivation' procedure
Date: Tue, 25 Feb 2025 18:23:12 +0100
Hi Sergio,

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

> 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’.




Information forwarded to bug-guix <at> gnu.org:
bug#71941; Package guix. (Tue, 25 Feb 2025 17:29:02 GMT) Full text and rfc822 format available.

Message #26 received at 71941 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Sergio Pastor Pérez <sergio.pastorperez <at> gmail.com>
Cc: Josselin Poiret <dev <at> jpoiret.xyz>,
 Simon Tournier <zimon.toutoune <at> gmail.com>, Mathieu Othacehe <othacehe <at> gnu.org>,
 Tobias Geerinckx-Rice <me <at> tobias.gr>, 71941 <at> debbugs.gnu.org,
 Christopher Baines <guix <at> cbaines.net>,
 Sergio Pastor Pérez <sergio.pastorperez <at> outlook.es>
Subject: Re: bug#71941: Broken `map-derivation' procedure
Date: Tue, 25 Feb 2025 18:27:53 +0100
Sergio Pastor Pérez <sergio.pastorperez <at> gmail.com> skribis:

> Implement caching to speed up computation.
>
> Change-Id: I186e2a62f6655e3b0738dd6e0f628faccd8b855e

Nice!

> +      (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’.




Information forwarded to sergio.pastorperez <at> outlook.es, sergio.pastorperez <at> gmail.com, ludo <at> gnu.org, guix <at> cbaines.net, dev <at> jpoiret.xyz, othacehe <at> gnu.org, zimon.toutoune <at> gmail.com, me <at> tobias.gr, bug-guix <at> gnu.org:
bug#71941; Package guix. (Sat, 01 Mar 2025 18:09:01 GMT) Full text and rfc822 format available.

Message #29 received at 71941 <at> debbugs.gnu.org (full text, mbox):

From: Sergio Pastor Pérez <sergio.pastorperez <at> gmail.com>
To: 71941 <at> debbugs.gnu.org
Cc: Sergio Pastor Pérez <sergio.pastorperez <at> gmail.com>
Subject: [PATCH v4 1/3] guix: fix: 'map-derivation' not handling directories
Date: Sat,  1 Mar 2025 19:06:08 +0100
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(-)

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 <at> gnu.org>
 ;;; Copyright © 2016, 2017 Mathieu Lirzin <mthl <at> gnu.org>
+;;; Copyright © 2025 Sergio Pastor Pérez <sergio.pastorperez <at> 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





Information forwarded to sergio.pastorperez <at> outlook.es, sergio.pastorperez <at> gmail.com, ludo <at> gnu.org, guix <at> cbaines.net, dev <at> jpoiret.xyz, othacehe <at> gnu.org, zimon.toutoune <at> gmail.com, me <at> tobias.gr, bug-guix <at> gnu.org:
bug#71941; Package guix. (Sat, 01 Mar 2025 18:09:03 GMT) Full text and rfc822 format available.

Message #32 received at 71941 <at> debbugs.gnu.org (full text, mbox):

From: Sergio Pastor Pérez <sergio.pastorperez <at> gmail.com>
To: 71941 <at> debbugs.gnu.org
Cc: Sergio Pastor Pérez <sergio.pastorperez <at> gmail.com>
Subject: [PATCH v4 2/3] guix: fix: Slow 'map-derivation' procedure
Date: Sat,  1 Mar 2025 19:06:09 +0100
Implement caching to speed up computation through memoization.

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

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





Information forwarded to sergio.pastorperez <at> outlook.es, sergio.pastorperez <at> gmail.com, ludo <at> gnu.org, bug-guix <at> gnu.org:
bug#71941; Package guix. (Sat, 01 Mar 2025 18:09:04 GMT) Full text and rfc822 format available.

Message #35 received at 71941 <at> debbugs.gnu.org (full text, mbox):

From: Sergio Pastor Pérez <sergio.pastorperez <at> gmail.com>
To: 71941 <at> debbugs.gnu.org
Cc: Sergio Pastor Pérez <sergio.pastorperez <at> gmail.com>
Subject: [PATCH v4 3/3] tests: Add unit test for 'map-derivation' that tests
 import modules as inputs
Date: Sat,  1 Mar 2025 19:06:10 +0100
* tests/derivations.scm ("map-derivation, modules"): New test.

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

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 <at> gnu.org>
+;;; Copyright © 2025 Sergio Pastor Pérez <sergio.pastorperez <at> 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





Information forwarded to bug-guix <at> gnu.org:
bug#71941; Package guix. (Sat, 01 Mar 2025 19:40:01 GMT) Full text and rfc822 format available.

Message #38 received at 71941 <at> debbugs.gnu.org (full text, mbox):

From: Sergio Pastor Pérez <sergio.pastorperez <at> gmail.com>
To: Ludovic Courtès <ludo <at> gnu.org>
Cc: Josselin Poiret <dev <at> jpoiret.xyz>,
 Simon Tournier <zimon.toutoune <at> gmail.com>, Mathieu Othacehe <othacehe <at> gnu.org>,
 Tobias Geerinckx-Rice <me <at> tobias.gr>, 71941 <at> debbugs.gnu.org,
 Christopher Baines <guix <at> cbaines.net>,
 Sergio Pastor Pérez <sergio.pastorperez <at> outlook.es>
Subject: Re: bug#71941: Broken `map-derivation' procedure
Date: Sat, 01 Mar 2025 20:39:45 +0100
Hello, Ludo!

Ludovic Courtès <ludo <at> gnu.org> writes:
> 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:
--8<---------------cut here---------------start------------->8---
(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)))
--8<---------------cut here---------------end--------------->8---

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:
--8<---------------cut here---------------start------------->8---
$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>
--8<---------------cut here---------------end--------------->8---

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.




This bug report was last modified 110 days ago.

Previous Next


GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.