3
5
Fork 0
mirror of git://git.savannah.gnu.org/guix.git synced 2023-12-14 03:33:07 +01:00

utils: Add `package-name->name+version'.

* guix/utils.scm (package-name->name+version): New procedure.
* guix-package.in (guix-package)[find-package]: Use it.
* tests/utils.scm ("package-name->name+version"): New test.
This commit is contained in:
Ludovic Courtès 2012-11-04 01:29:18 +01:00
parent d388c2c435
commit 9b48fb88ca
3 changed files with 42 additions and 7 deletions

View file

@ -283,8 +283,6 @@ Report bugs to: ~a.~%") "@PACKAGE_BUGREPORT@"))
;; Find the package NAME; NAME may contain a version number and a
;; sub-derivation name.
(define request name)
(define versioned-rx
(make-regexp "^(.*)-([0-9][^-]*)$"))
(let*-values (((name sub-drv)
(match (string-rindex name #\:)
@ -292,10 +290,7 @@ Report bugs to: ~a.~%") "@PACKAGE_BUGREPORT@"))
(colon (values (substring name (+ 1 colon))
(substring name colon)))))
((name version)
(match (regexp-exec versioned-rx name)
(#f (values name #f))
(m (values (match:substring m 1)
(match:substring m 2))))))
(package-name->name+version name)))
(match (find-packages-by-name name version)
((p)
(list name version sub-drv p))

View file

@ -58,7 +58,8 @@
source-properties->location
gnu-triplet->nix-system
%current-system))
%current-system
package-name->name+version))
;;;
@ -571,6 +572,27 @@ returned by `config.guess'."
;; System type as expected by Nix, usually ARCHITECTURE-KERNEL.
(make-parameter (gnu-triplet->nix-system %host-type)))
(define (package-name->name+version name)
"Given NAME, a package name like \"foo-0.9.1b\", return two values:
\"foo\" and \"0.9.1b\". When the version part is unavailable, NAME and
#f are returned. The first hyphen followed by a digit is considered to
introduce the version part."
;; See also `DrvName' in Nix.
(define number?
(cut char-set-contains? char-set:digit <>))
(let loop ((chars (string->list name))
(prefix '()))
(match chars
(()
(values name #f))
((#\- (? number? n) rest ...)
(values (list->string (reverse prefix))
(list->string (cons n rest))))
((head tail ...)
(loop tail (cons head prefix))))))
;;;
;;; Source location.

View file

@ -104,6 +104,24 @@
(equal? nix (gnu-triplet->nix-system gnu)))
gnu nix))))
(test-assert "package-name->name+version"
(every (match-lambda
((name version)
(let*-values (((full-name)
(if version
(string-append name "-" version)
name))
((name* version*)
(package-name->name+version full-name)))
(and (equal? name* name)
(equal? version* version)))))
'(("foo" "0.9.1b")
("foo-bar" "1.0")
("foo-bar2" #f)
("guile" "2.0.6.65-134c9") ; as produced by `git-version-gen'
("nixpkgs" "1.0pre22125_a28fe19")
("gtk2" "2.38.0"))))
(test-assert "define-record-type*"
(begin
(define-record-type* <foo> foo make-foo