05/09: import: print: Handle patches that are origins.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit b2ed40c29f578d46d42cb1c5e99bd797cea3aba0
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Fri Oct 29 22:29:05 2021 +0200

    import: print: Handle patches that are origins.
    
    * guix/import/print.scm (package->code)[source->code]: Handle patches
    that are origins.
    * tests/print.scm (pkg-with-origin-input): Add 'patches' field.
    (pkg-with-origin-patch, pkg-with-origin-patch-source): New variables.
    ("package with origin patch"): New test.
---
 guix/import/print.scm | 13 +++++++++++--
 tests/print.scm       | 33 ++++++++++++++++++++++++++++++++-
 2 files changed, 43 insertions(+), 3 deletions(-)

diff --git a/guix/import/print.scm b/guix/import/print.scm
index 4e65d18..e04a664 100644
--- a/guix/import/print.scm
+++ b/guix/import/print.scm
@@ -112,8 +112,17 @@ when evaluated."
          ;; FIXME: in order to be able to throw away the directory prefix,
          ;; we just assume that the patch files can be found with
          ;; "search-patches".
-         ,@(if (null? patches) '()
-               `((patches (search-patches ,@(map basename patches))))))))
+         ,@(cond ((null? patches)
+                  '())
+                 ((every string? patches)
+                  `((patches (search-patches ,@(map basename patches)))))
+                 (else
+                  `((patches (list ,@(map (match-lambda
+                                            ((? string? file)
+                                             `(search-patch ,file))
+                                            ((? origin? origin)
+                                             (source->code origin #f)))
+                                          patches)))))))))
 
   (define (package-lists->code lsts)
     (list 'quasiquote
diff --git a/tests/print.scm b/tests/print.scm
index 7f4c8cc..ff0db46 100644
--- a/tests/print.scm
+++ b/tests/print.scm
@@ -22,6 +22,7 @@
   #:use-module (guix download)
   #:use-module (guix packages)
   #:use-module ((guix licenses) #:prefix license:)
+  #:use-module ((gnu packages) #:select (search-patches))
   #:use-module (srfi srfi-64))
 
 (define-syntax-rule (define-with-source object source expr)
@@ -79,7 +80,9 @@
                                         version ".tar.gz")))
               (sha256
                (base32
-                "070pwb7brdcn1mfvplkd56vjc7lbz4iznzkqvfsakvgbv68k71ah"))))
+                "070pwb7brdcn1mfvplkd56vjc7lbz4iznzkqvfsakvgbv68k71ah"))
+              (patches (search-patches "guile-linux-syscalls.patch"
+                                       "guile-relocatable.patch"))))
     (build-system (@ (guix build-system gnu) gnu-build-system))
     (inputs
      `(("o" ,(origin
@@ -93,6 +96,30 @@
     (description "This is a dummy package.")
     (license license:gpl3+)))
 
+(define-with-source pkg-with-origin-patch pkg-with-origin-patch-source
+  (package
+    (name "test")
+    (version "1.2.3")
+    (source (origin
+              (method url-fetch)
+              (uri (string-append "file:///tmp/test-"
+                                  version ".tar.gz"))
+              (sha256
+               (base32
+                "070pwb7brdcn1mfvplkd56vjc7lbz4iznzkqvfsakvgbv68k71ah"))
+              (patches
+               (list (origin
+                       (method url-fetch)
+                       (uri "http://example.org/x.patch";)
+                       (sha256
+                        (base32
+                         
"0000000000000000000000000000000000000000000000000000")))))))
+    (build-system (@ (guix build-system gnu) gnu-build-system))
+    (home-page "http://gnu.org";)
+    (synopsis "Dummy")
+    (description "This is a dummy package.")
+    (license license:gpl3+)))
+
 (test-equal "simple package"
   `(define-public test ,pkg-source)
   (package->code pkg))
@@ -105,4 +132,8 @@
   `(define-public test ,pkg-with-origin-input-source)
   (package->code pkg-with-origin-input))
 
+(test-equal "package with origin patch"
+  `(define-public test ,pkg-with-origin-patch-source)
+  (package->code pkg-with-origin-patch))
+
 (test-end "print")