diff options
| -rw-r--r-- | guix/utils.scm | 31 | ||||
| -rw-r--r-- | tests/derivations.scm | 22 | ||||
| -rw-r--r-- | tests/utils.scm | 13 |
3 files changed, 52 insertions, 14 deletions
diff --git a/guix/utils.scm b/guix/utils.scm index 77ed9ce6ee..5415ab9e63 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -26,6 +26,7 @@ #:use-module (ice-9 format) #:autoload (ice-9 popen) (open-pipe*) #:autoload (ice-9 rdelim) (read-line) + #:use-module (ice-9 regex) #:use-module ((chop hash) #:select (bytevector-hash hash-method/sha256)) @@ -41,7 +42,9 @@ %nixpkgs-directory nixpkgs-derivation - memoize)) + memoize + gnu-triplet->nix-system + %current-system)) ;;; @@ -400,3 +403,29 @@ starting from the right of S." list))) (hash-set! cache args results) (apply values results))))))) + +(define (gnu-triplet->nix-system triplet) + "Return the Nix system type corresponding to TRIPLET, a GNU triplet as +returned by `config.guess'." + (let ((triplet (cond ((string-match "^i[345]86-(.*)$" triplet) + => + (lambda (m) + (string-append "i686-" (match:substring m 1)))) + (else triplet)))) + (cond ((string-match "^([^-]+)-([^-]+-)?linux-gnu.*" triplet) + => + (lambda (m) + ;; Nix omits `-gnu' for GNU/Linux. + (string-append (match:substring m 1) "-linux"))) + ((string-match "^([^-]+)-([^-]+-)?([[:alpha:]]+)([0-9]+\\.?)*$" triplet) + => + (lambda (m) + ;; Nix strip the version number from names such as `gnu0.3', + ;; `darwin10.2.0', etc., and always strips the vendor part. + (string-append (match:substring m 1) "-" + (match:substring m 3)))) + (else triplet)))) + +(define %current-system + ;; System type as expected by Nix, usually ARCHITECTURE-KERNEL. + (make-parameter (gnu-triplet->nix-system %host-type))) diff --git a/tests/derivations.scm b/tests/derivations.scm index eb2f360b2a..b4e4ccea8e 100644 --- a/tests/derivations.scm +++ b/tests/derivations.scm @@ -30,10 +30,6 @@ #:use-module (ice-9 rdelim) #:use-module (ice-9 ftw)) -(define %current-system - ;; System type as expected by Nix, usually ARCHITECTURE-KERNEL. - "x86_64-linux") - (define %store (false-if-exception (open-connection))) @@ -79,7 +75,7 @@ (let ((builder (add-text-to-store %store "my-builder.sh" "#!/bin/sh\necho hello, world\n" '()))) - (store-path? (derivation %store "foo" %current-system builder + (store-path? (derivation %store "foo" (%current-system) builder '() '(("HOME" . "/homeless")) '())))) (test-assert "build derivation with 1 source" @@ -88,7 +84,7 @@ "echo hello, world > \"$out\"\n" '())) ((drv-path drv) - (derivation %store "foo" %current-system + (derivation %store "foo" (%current-system) "/bin/sh" `(,builder) '(("HOME" . "/homeless") ("zzz" . "Z!") @@ -106,7 +102,7 @@ (let* ((builder (add-text-to-store %store "my-fixed-builder.sh" "echo -n hello > $out" '())) (hash (sha256 (string->utf8 "hello"))) - (drv-path (derivation %store "fixed" %current-system + (drv-path (derivation %store "fixed" (%current-system) "/bin/sh" `(,builder) '() `((,builder)) #:hash hash #:hash-algo 'sha256)) @@ -120,7 +116,7 @@ (let* ((builder (add-text-to-store %store "my-fixed-builder.sh" "echo one > $out ; echo two > $second" '())) - (drv-path (derivation %store "fixed" %current-system + (drv-path (derivation %store "fixed" (%current-system) "/bin/sh" `(,builder) '(("HOME" . "/homeless") ("zzz" . "Z!") @@ -146,7 +142,7 @@ "echo $PATH ; mkdir --version ; mkdir $out ; touch $out/good" '())) (drv-path - (derivation %store "foo" %current-system + (derivation %store "foo" (%current-system) "/bin/sh" `(,builder) `(("PATH" . ,(string-append @@ -168,7 +164,7 @@ (call-with-output-file (string-append %output "/test") (lambda (p) (display '(hello guix) p))))) - (drv-path (build-expression->derivation %store "goo" %current-system + (drv-path (build-expression->derivation %store "goo" (%current-system) builder '())) (succeeded? (build-derivations %store (list drv-path)))) (and succeeded? @@ -185,7 +181,7 @@ (lambda (p) (display '(world) p))))) (drv-path (build-expression->derivation %store "double" - %current-system + (%current-system) builder '() #:outputs '("out" "second"))) @@ -204,7 +200,7 @@ (dup2 (port->fdes p) 1) (execl (string-append cu "/bin/uname") "uname" "-a"))))) - (drv-path (build-expression->derivation %store "uname" %current-system + (drv-path (build-expression->derivation %store "uname" (%current-system) builder `(("cu" . ,%coreutils)))) (succeeded? (build-derivations %store (list drv-path)))) @@ -227,7 +223,7 @@ (lambda (p) (put-bytevector p bv)))))) (drv-path (build-expression->derivation - %store "hello-2.8.tar.gz" %current-system builder '() + %store "hello-2.8.tar.gz" (%current-system) builder '() #:hash (nix-base32-string->bytevector "0wqd8sjmxfskrflaxywc7gqw7sfawrfvdxd9skxawzfgyy0pzdz6") #:hash-algo 'sha256)) diff --git a/tests/utils.scm b/tests/utils.scm index db4eb5a340..b3c7fefa39 100644 --- a/tests/utils.scm +++ b/tests/utils.scm @@ -20,6 +20,7 @@ (define-module (test-utils) #:use-module (guix utils) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) #:use-module (srfi srfi-64) #:use-module (rnrs bytevectors) @@ -85,6 +86,18 @@ (close-pipe p) l)))) +(test-assert "gnu-triplet->nix-system" + (let ((samples '(("i586-gnu0.3" "i686-gnu") + ("x86_64-unknown-linux-gnu" "x86_64-linux") + ("i386-pc-linux-gnu" "i686-linux") + ("x86_64-unknown-freebsd8.2" "x86_64-freebsd") + ("x86_64-apple-darwin10.8.0" "x86_64-darwin") + ("i686-pc-cygwin" "i686-cygwin")))) + (let-values (((gnu nix) (unzip2 samples))) + (every (lambda (gnu nix) + (equal? nix (gnu-triplet->nix-system gnu))) + gnu nix)))) + (test-end) |