diff options
| -rw-r--r-- | guix-package.in | 7 | ||||
| -rw-r--r-- | guix/utils.scm | 24 | ||||
| -rw-r--r-- | tests/utils.scm | 18 |
3 files changed, 42 insertions, 7 deletions
diff --git a/guix-package.in b/guix-package.in index ed46a26ffb..41716d3ecc 100644 --- a/guix-package.in +++ b/guix-package.in @@ -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)) diff --git a/guix/utils.scm b/guix/utils.scm index 345ed374cd..7ebc026702 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -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. diff --git a/tests/utils.scm b/tests/utils.scm index 7dd248fae2..1ced410d41 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -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 |