* guix/scripts/build.scm (numeric-extension?, tarball-base-name): New
procedures, formerly in 'package-with-source'.
(transform-package-source)[new-sources]: Look for '=' in URI.  Each
element of the list of now a (PKG VERSION SOURCE) tuple.
Pass VERSION to 'package-with-source'.
(package-with-source): Add 'version' parameter and honor it.
* tests/scripts-build.scm ("options->transformation, with-source, PKG=URI")
("options->transformation, with-source, PKG@VER=URI"): New tests.
* doc/guix.texi (Package Transformation Options): Document the new
forms.
		
	
			
		
			
				
	
	
		
			167 lines
		
	
	
	
		
			7 KiB
		
	
	
	
		
			Scheme
		
	
	
	
	
	
			
		
		
	
	
			167 lines
		
	
	
	
		
			7 KiB
		
	
	
	
		
			Scheme
		
	
	
	
	
	
;;; GNU Guix --- Functional package management for GNU
 | 
						||
;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 | 
						||
;;;
 | 
						||
;;; This file is part of GNU Guix.
 | 
						||
;;;
 | 
						||
;;; GNU Guix is free software; you can redistribute it and/or modify it
 | 
						||
;;; under the terms of the GNU General Public License as published by
 | 
						||
;;; the Free Software Foundation; either version 3 of the License, or (at
 | 
						||
;;; your option) any later version.
 | 
						||
;;;
 | 
						||
;;; GNU Guix is distributed in the hope that it will be useful, but
 | 
						||
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
 | 
						||
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 | 
						||
;;; GNU General Public License for more details.
 | 
						||
;;;
 | 
						||
;;; You should have received a copy of the GNU General Public License
 | 
						||
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 | 
						||
 | 
						||
(define-module (test-scripts-build)
 | 
						||
  #:use-module (guix tests)
 | 
						||
  #:use-module (guix store)
 | 
						||
  #:use-module (guix packages)
 | 
						||
  #:use-module (guix scripts build)
 | 
						||
  #:use-module (guix ui)
 | 
						||
  #:use-module (guix utils)
 | 
						||
  #:use-module (gnu packages)
 | 
						||
  #:use-module (gnu packages base)
 | 
						||
  #:use-module (gnu packages busybox)
 | 
						||
  #:use-module (ice-9 match)
 | 
						||
  #:use-module (srfi srfi-64))
 | 
						||
 | 
						||
 | 
						||
(test-begin "scripts-build")
 | 
						||
 | 
						||
(test-assert "options->transformation, no transformations"
 | 
						||
  (let ((p (dummy-package "foo"))
 | 
						||
        (t (options->transformation '())))
 | 
						||
    (with-store store
 | 
						||
      (eq? (t store p) p))))
 | 
						||
 | 
						||
(test-assert "options->transformation, with-source"
 | 
						||
  ;; Our pseudo-package is called 'guix.scm' so the 'guix.scm' source should
 | 
						||
  ;; be applicable.
 | 
						||
  (let* ((p (dummy-package "guix.scm"))
 | 
						||
         (s (search-path %load-path "guix.scm"))
 | 
						||
         (t (options->transformation `((with-source . ,s)))))
 | 
						||
    (with-store store
 | 
						||
      (let ((new (t store p)))
 | 
						||
        (and (not (eq? new p))
 | 
						||
             (string=? (package-source new)
 | 
						||
                       (add-to-store store "guix.scm" #t
 | 
						||
                                     "sha256" s)))))))
 | 
						||
 | 
						||
(test-assert "options->transformation, with-source, replacement"
 | 
						||
  ;; Same, but this time the original package has a 'replacement' field.  We
 | 
						||
  ;; expect that replacement to be set to #f in the new package.
 | 
						||
  (let* ((p (dummy-package "guix.scm" (replacement coreutils)))
 | 
						||
         (s (search-path %load-path "guix.scm"))
 | 
						||
         (t (options->transformation `((with-source . ,s)))))
 | 
						||
    (with-store store
 | 
						||
      (let ((new (t store p)))
 | 
						||
        (and (not (eq? new p))
 | 
						||
             (string=? (package-source new)
 | 
						||
                       (add-to-store store "guix.scm" #t "sha256" s))
 | 
						||
             (not (package-replacement new)))))))
 | 
						||
 | 
						||
(test-assert "options->transformation, with-source, with version"
 | 
						||
  ;; Our pseudo-package is called 'guix.scm' so the 'guix.scm-2.0' source
 | 
						||
  ;; should be applicable, and its version should be extracted.
 | 
						||
  (let ((p (dummy-package "foo"))
 | 
						||
        (s (search-path %load-path "guix.scm")))
 | 
						||
    (call-with-temporary-directory
 | 
						||
     (lambda (directory)
 | 
						||
       (let* ((f (string-append directory "/foo-42.0.tar.gz"))
 | 
						||
              (t (options->transformation `((with-source . ,f)))))
 | 
						||
         (copy-file s f)
 | 
						||
         (with-store store
 | 
						||
           (let ((new (t store p)))
 | 
						||
             (and (not (eq? new p))
 | 
						||
                  (string=? (package-name new) (package-name p))
 | 
						||
                  (string=? (package-version new) "42.0")
 | 
						||
                  (string=? (package-source new)
 | 
						||
                            (add-to-store store (basename f) #t
 | 
						||
                                          "sha256" f))))))))))
 | 
						||
 | 
						||
(test-assert "options->transformation, with-source, no matches"
 | 
						||
  ;; When a transformation in not applicable, a warning must be raised.
 | 
						||
  (let* ((p (dummy-package "foobar"))
 | 
						||
         (s (search-path %load-path "guix.scm"))
 | 
						||
         (t (options->transformation `((with-source . ,s)))))
 | 
						||
    (with-store store
 | 
						||
      (let* ((port (open-output-string))
 | 
						||
             (new  (parameterize ((guix-warning-port port))
 | 
						||
                     (t store p))))
 | 
						||
        (and (eq? new p)
 | 
						||
             (string-contains (get-output-string port)
 | 
						||
                              "had no effect"))))))
 | 
						||
 | 
						||
(test-assert "options->transformation, with-source, PKG=URI"
 | 
						||
  (let* ((p (dummy-package "foo"))
 | 
						||
         (s (search-path %load-path "guix.scm"))
 | 
						||
         (f (string-append "foo=" s))
 | 
						||
         (t (options->transformation `((with-source . ,f)))))
 | 
						||
    (with-store store
 | 
						||
      (let ((new (t store p)))
 | 
						||
        (and (not (eq? new p))
 | 
						||
             (string=? (package-name new) (package-name p))
 | 
						||
             (string=? (package-version new)
 | 
						||
                       (package-version p))
 | 
						||
             (string=? (package-source new)
 | 
						||
                       (add-to-store store (basename s) #t
 | 
						||
                                     "sha256" s)))))))
 | 
						||
 | 
						||
(test-assert "options->transformation, with-source, PKG@VER=URI"
 | 
						||
  (let* ((p (dummy-package "foo"))
 | 
						||
         (s (search-path %load-path "guix.scm"))
 | 
						||
         (f (string-append "foo@42.0=" s))
 | 
						||
         (t (options->transformation `((with-source . ,f)))))
 | 
						||
    (with-store store
 | 
						||
      (let ((new (t store p)))
 | 
						||
        (and (not (eq? new p))
 | 
						||
             (string=? (package-name new) (package-name p))
 | 
						||
             (string=? (package-version new) "42.0")
 | 
						||
             (string=? (package-source new)
 | 
						||
                       (add-to-store store (basename s) #t
 | 
						||
                                     "sha256" s)))))))
 | 
						||
 | 
						||
(test-assert "options->transformation, with-input"
 | 
						||
  (let* ((p (dummy-package "guix.scm"
 | 
						||
              (inputs `(("foo" ,(specification->package "coreutils"))
 | 
						||
                        ("bar" ,(specification->package "grep"))
 | 
						||
                        ("baz" ,(dummy-package "chbouib"
 | 
						||
                                  (native-inputs `(("x" ,grep)))))))))
 | 
						||
         (t (options->transformation '((with-input . "coreutils=busybox")
 | 
						||
                                       (with-input . "grep=findutils")))))
 | 
						||
    (with-store store
 | 
						||
      (let ((new (t store p)))
 | 
						||
        (and (not (eq? new p))
 | 
						||
             (match (package-inputs new)
 | 
						||
               ((("foo" dep1) ("bar" dep2) ("baz" dep3))
 | 
						||
                (and (eq? dep1 busybox)
 | 
						||
                     (eq? dep2 findutils)
 | 
						||
                     (string=? (package-name dep3) "chbouib")
 | 
						||
                     (match (package-native-inputs dep3)
 | 
						||
                       ((("x" dep))
 | 
						||
                        (eq? dep findutils)))))))))))
 | 
						||
 | 
						||
(test-assert "options->transformation, with-graft"
 | 
						||
  (let* ((p (dummy-package "guix.scm"
 | 
						||
              (inputs `(("foo" ,grep)
 | 
						||
                        ("bar" ,(dummy-package "chbouib"
 | 
						||
                                  (native-inputs `(("x" ,grep)))))))))
 | 
						||
         (t (options->transformation '((with-graft . "grep=findutils")))))
 | 
						||
    (with-store store
 | 
						||
      (let ((new (t store p)))
 | 
						||
        (and (not (eq? new p))
 | 
						||
             (match (package-inputs new)
 | 
						||
               ((("foo" dep1) ("bar" dep2))
 | 
						||
                (and (string=? (package-full-name dep1)
 | 
						||
                               (package-full-name grep))
 | 
						||
                     (eq? (package-replacement dep1) findutils)
 | 
						||
                     (string=? (package-name dep2) "chbouib")
 | 
						||
                     (match (package-native-inputs dep2)
 | 
						||
                       ((("x" dep))
 | 
						||
                        (eq? (package-replacement dep) findutils)))))))))))
 | 
						||
 | 
						||
(test-end)
 |