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,
 | 
					         ;; 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
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -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")
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Reference in a new issue