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.
			
			
This commit is contained in:
		
							parent
							
								
									b3240ae846
								
							
						
					
					
						commit
						b2ed40c29f
					
				
					 2 changed files with 43 additions and 3 deletions
				
			
		| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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")
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Reference in a new issue