Add a `%current-system' fluid.
* guix/utils.scm (gnu-triplet->nix-system): New procedure.
(%current-system): New variable.
* tests/utils.scm ("gnu-triplet->nix-system"): New test.
* tests/derivations.scm (%current-system): Remove. Update users to
use (%current-system) instead.
This commit is contained in:
Ludovic Courtès
parent
b37eb5ede6
commit
9809055707
@ -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)))
|
||||
|
||||
@ -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))
|
||||
|
||||
@ -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)
|
||||
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user