~ruther/guix-local

b2ed40c29f578d46d42cb1c5e99bd797cea3aba0 — Ludovic Courtès 4 years ago b3240ae
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.
2 files changed, 43 insertions(+), 3 deletions(-)

M guix/import/print.scm
M tests/print.scm
M guix/import/print.scm => guix/import/print.scm +11 -2
@@ 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

M tests/print.scm => tests/print.scm +32 -1
@@ 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")