futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

import: print: Handle patches that are origins.

Browse Source 
* 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.
This commit is contained in:
Ludovic Courtès 2021-10-29 22:29:05 +02:00
parent b3240ae846
commit b2ed40c29f
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 43 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
guix/import/print.scm
View File

@ -112,8 +112,17 @@ when evaluated."
;; FIXME: in order to be able to throw away the directory prefix, ;; FIXME: in order to be able to throw away the directory prefix,
;; we just assume that the patch files can be found with ;; we just assume that the patch files can be found with
;; "search-patches". ;; "search-patches".
,@(if (null? patches) '() ,@(cond ((null? patches)
`((patches (search-patches ,@(map basename 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) (define (package-lists->code lsts)
(list 'quasiquote (list 'quasiquote

33
tests/print.scm
View File

@ -22,6 +22,7 @@
#:use-module (guix download) #:use-module (guix download)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module ((guix licenses) #:prefix license:) #:use-module ((guix licenses) #:prefix license:)
#:use-module ((gnu packages) #:select (search-patches))
#:use-module (srfi srfi-64)) #:use-module (srfi srfi-64))
(define-syntax-rule (define-with-source object source expr) (define-syntax-rule (define-with-source object source expr)
@ -79,7 +80,9 @@
version ".tar.gz"))) version ".tar.gz")))
(sha256 (sha256
(base32 (base32
"070pwb7brdcn1mfvplkd56vjc7lbz4iznzkqvfsakvgbv68k71ah")))) "070pwb7brdcn1mfvplkd56vjc7lbz4iznzkqvfsakvgbv68k71ah"))
(patches (search-patches "guile-linux-syscalls.patch"
"guile-relocatable.patch"))))
(build-system (@ (guix build-system gnu) gnu-build-system)) (build-system (@ (guix build-system gnu) gnu-build-system))
(inputs (inputs
`(("o" ,(origin `(("o" ,(origin
@ -93,6 +96,30 @@
(description "This is a dummy package.") (description "This is a dummy package.")
(license license:gpl3+))) (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" (test-equal "simple package"
`(define-public test ,pkg-source) `(define-public test ,pkg-source)
(package->code pkg)) (package->code pkg))
@ -105,4 +132,8 @@
`(define-public test ,pkg-with-origin-input-source) `(define-public test ,pkg-with-origin-input-source)
(package->code pkg-with-origin-input)) (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") (test-end "print")