me/guix
Archived
1
0
Fork 0
Code Activity

import: print: Properly render packages with origins as inputs.

Browse source 
* guix/import/print.scm (package->code)[source->code]: Check whether
VERSION is true before calling 'factorize-uri'.
[package-lists->code]: Add clause for inputs that are origins.
* tests/print.scm (pkg-with-origin-input, pkg-with-origin-input-source):
New variables.
("package with origin input"): New test.
This commit is contained in:
Ludovic Courtès 2021-10-29 21:51:39 +02:00
parent 450e1dd52e
commit 04d929570a
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 37 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
guix/import/print.scm
View file

@ -89,9 +89,11 @@ when evaluated."
(guix hg-download) (guix hg-download)
(guix svn-download))) (guix svn-download)))
(procedure-name method))) (procedure-name method)))
(uri (string-append ,@(match (factorize-uri uri version) (uri ,(if version
((? string? uri) (list uri)) `(string-append ,@(match (factorize-uri uri version)
(factorized factorized)))) ((? string? uri) (list uri))
(factorized factorized)))
uri))
,(if (equal? (content-hash-algorithm hash) 'sha256) ,(if (equal? (content-hash-algorithm hash) 'sha256)
`(sha256 (base32 ,(bytevector->nix-base32-string `(sha256 (base32 ,(bytevector->nix-base32-string
(content-hash-value hash)))) (content-hash-value hash))))
@ -109,7 +111,7 @@ when evaluated."
(map (match-lambda (map (match-lambda
((? symbol? s) ((? symbol? s)
(list (symbol->string s) (list 'unquote s))) (list (symbol->string s) (list 'unquote s)))
((label pkg . out) ((label (? package? pkg) . out)
(let ((mod (package-module-name pkg))) (let ((mod (package-module-name pkg)))
(cons* label (cons* label
;; FIXME: using '@ certainly isn't pretty, but it ;; FIXME: using '@ certainly isn't pretty, but it
@ -117,7 +119,9 @@ when evaluated."
;; modules. ;; modules.
(list 'unquote (list 'unquote
(list '@ mod (variable-name pkg mod))) (list '@ mod (variable-name pkg mod)))
out)))) out)))
((label (? origin? origin))
(list label (list 'unquote (source->code origin #f)))))
lsts))) lsts)))
(let ((name (package-name package)) (let ((name (package-name package))

28
tests/print.scm
View file

@ -67,6 +67,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-input pkg-with-origin-input-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"))))
(build-system (@ (guix build-system gnu) gnu-build-system))
(inputs
`(("o" ,(origin
(method url-fetch)
(uri "http://example.org/somefile.txt")
(sha256
(base32
"0000000000000000000000000000000000000000000000000000"))))))
(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))
@ -75,4 +99,8 @@
`(define-public test ,pkg-with-inputs-source) `(define-public test ,pkg-with-inputs-source)
(package->code pkg-with-inputs)) (package->code pkg-with-inputs))
(test-equal "package with origin input"
`(define-public test ,pkg-with-origin-input-source)
(package->code pkg-with-origin-input))
(test-end "print") (test-end "print")