rekahsoft
/
guix
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Add (guix scripts). 

* guix/ui.scm: Add missing copyright lines.
  (args-fold*, environment-build-options, %default-argument-handler,
  parse-command-line): Move to ...
* guix/scripts.scm: ...here.  New file.
* guix/scripts/archive.scm: Use it.
* guix/scripts/build.scm: Likewise.
* guix/scripts/download.scm: Likewise.
* guix/scripts/edit.scm: Likewise.
* guix/scripts/environment.scm: Likewise.
* guix/scripts/gc.scm: Likewise.
* guix/scripts/graph.scm: Likewise.
* guix/scripts/hash.scm: Likewise.
* guix/scripts/import/cpan.scm: Likewise.
* guix/scripts/import/cran.scm: Likewise.
* guix/scripts/import/elpa.scm: Likewise.
* guix/scripts/import/gem.scm: Likewise.
* guix/scripts/import/gnu.scm: Likewise.
* guix/scripts/import/hackage.scm: Likewise.
* guix/scripts/import/nix.scm: Likewise.
* guix/scripts/import/pypi.scm: Likewise.
* guix/scripts/lint.scm: Likewise.
* guix/scripts/package.scm: Likewise.
* guix/scripts/publish.scm: Likewise.
* guix/scripts/pull.scm: Likewise.
* guix/scripts/refresh.scm: Likewise.
* guix/scripts/size.scm: Likewise.
* guix/scripts/system.scm: Likewise.
* tests/ui.scm (with-environment-variable, "parse-command-line",
  "parse-command-line and --no options"): Move to ...
* tests/scripts.scm: ...here.  New file.
* Makefile.am (MODULES): Add guix/scripts.scm.
  (SCM_TESTS): Add tests/scripts.scm.
* po/guix/POTFILES.in: Add guix/scripts.scm.
This commit is contained in:
Alex Kost 2015-09-10 12:37:36 +03:00
parent b2cb869cf9
commit 88981dd3e2
29 changed files with 183 additions and 91 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Makefile.am
View File

@ -102,6 +102,7 @@ MODULES = \
guix/import/cran.scm \ guix/import/cran.scm \
guix/import/hackage.scm \ guix/import/hackage.scm \
guix/import/elpa.scm \ guix/import/elpa.scm \
guix/scripts.scm \
guix/scripts/download.scm \ guix/scripts/download.scm \
guix/scripts/build.scm \ guix/scripts/build.scm \
guix/scripts/archive.scm \ guix/scripts/archive.scm \
@ -214,6 +215,7 @@ SCM_TESTS = \
tests/gremlin.scm \ tests/gremlin.scm \
tests/lint.scm \ tests/lint.scm \
tests/publish.scm \ tests/publish.scm \
tests/scripts.scm \
tests/size.scm \ tests/size.scm \
tests/graph.scm \ tests/graph.scm \
tests/file-systems.scm \ tests/file-systems.scm \

81
guix/scripts.scm Normal file
View File

@ -0,0 +1,81 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014 Deck Pickard <deck.r.pickard@gmail.com>
;;;
;;; 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 (guix scripts)
#:use-module (guix utils)
#:use-module (guix ui)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-37)
#:use-module (ice-9 match)
#:export (args-fold*
parse-command-line))
;;; Commentary:
;;;
;;; General code for Guix scripts.
;;;
;;; Code:
(define (args-fold* options unrecognized-option-proc operand-proc . seeds)
"A wrapper on top of `args-fold' that does proper user-facing error
reporting."
(catch 'misc-error
(lambda ()
(apply args-fold options unrecognized-option-proc
operand-proc seeds))
(lambda (key proc msg args . rest)
;; XXX: MSG is not i18n'd.
(leave (_ "invalid argument: ~a~%")
(apply format #f msg args)))))
(define (environment-build-options)
"Return additional build options passed as environment variables."
(arguments-from-environment-variable "GUIX_BUILD_OPTIONS"))
(define %default-argument-handler
;; The default handler for non-option command-line arguments.
(lambda (arg result)
(alist-cons 'argument arg result)))
(define* (parse-command-line args options seeds
#:key
(argument-handler %default-argument-handler))
"Parse the command-line arguments ARGS as well as arguments passed via the
'GUIX_BUILD_OPTIONS' environment variable according to OPTIONS (a list of
SRFI-37 options) and return the result, seeded by SEEDS.
Command-line options take precedence those passed via 'GUIX_BUILD_OPTIONS'.
ARGUMENT-HANDLER is called for non-option arguments, like the 'operand-proc'
parameter of 'args-fold'."
(define (parse-options-from args seeds)
;; Actual parsing takes place here.
(apply args-fold* args options
(lambda (opt name arg . rest)
(leave (_ "~A: unrecognized option~%") name))
argument-handler
seeds))
(call-with-values
(lambda ()
(parse-options-from (environment-build-options) seeds))
(lambda seeds
;; ARGS take precedence over what the environment variable specifies.
(parse-options-from args seeds))))
;;; scripts.scm ends here

1
guix/scripts/archive.scm
View File

@ -27,6 +27,7 @@
#:use-module (guix ui) #:use-module (guix ui)
#:use-module (guix pki) #:use-module (guix pki)
#:use-module (guix pk-crypto) #:use-module (guix pk-crypto)
#:use-module (guix scripts)
#:use-module (guix scripts build) #:use-module (guix scripts build)
#:use-module (gnu packages) #:use-module (gnu packages)
#:use-module (ice-9 match) #:use-module (ice-9 match)

1
guix/scripts/build.scm
View File

@ -19,6 +19,7 @@
(define-module (guix scripts build) (define-module (guix scripts build)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module (guix scripts)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module (guix packages) #:use-module (guix packages)

1
guix/scripts/download.scm
View File

@ -18,6 +18,7 @@
(define-module (guix scripts download) (define-module (guix scripts download)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module (guix scripts)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix hash) #:use-module (guix hash)
#:use-module (guix utils) #:use-module (guix utils)

1
guix/scripts/edit.scm
View File

@ -18,6 +18,7 @@
(define-module (guix scripts edit) (define-module (guix scripts edit)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module (guix scripts)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (gnu packages) #:use-module (gnu packages)

1
guix/scripts/environment.scm
View File

@ -27,6 +27,7 @@
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix monads) #:use-module (guix monads)
#:use-module ((guix gexp) #:select (lower-inputs)) #:use-module ((guix gexp) #:select (lower-inputs))
#:use-module (guix scripts)
#:use-module (guix scripts build) #:use-module (guix scripts build)
#:use-module (gnu packages) #:use-module (gnu packages)
#:use-module (ice-9 format) #:use-module (ice-9 format)

1
guix/scripts/gc.scm
View File

@ -18,6 +18,7 @@
(define-module (guix scripts gc) (define-module (guix scripts gc)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module (guix scripts)
#:use-module (guix store) #:use-module (guix store)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)

1
guix/scripts/graph.scm
View File

@ -18,6 +18,7 @@
(define-module (guix scripts graph) (define-module (guix scripts graph)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module (guix scripts)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix monads) #:use-module (guix monads)

1
guix/scripts/hash.scm
View File

@ -22,6 +22,7 @@
#:use-module (guix hash) #:use-module (guix hash)
#:use-module (guix serialization) #:use-module (guix serialization)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module (guix scripts)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (rnrs io ports) #:use-module (rnrs io ports)
#:use-module (rnrs files) #:use-module (rnrs files)

1
guix/scripts/import/cpan.scm
View File

@ -19,6 +19,7 @@
(define-module (guix scripts import cpan) (define-module (guix scripts import cpan)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix scripts)
#:use-module (guix import cpan) #:use-module (guix import cpan)
#:use-module (guix scripts import) #:use-module (guix scripts import)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)

1
guix/scripts/import/cran.scm
View File

@ -20,6 +20,7 @@
(define-module (guix scripts import cran) (define-module (guix scripts import cran)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix scripts)
#:use-module (guix import cran) #:use-module (guix import cran)
#:use-module (guix scripts import) #:use-module (guix scripts import)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)

1
guix/scripts/import/elpa.scm
View File

@ -19,6 +19,7 @@
(define-module (guix scripts import elpa) (define-module (guix scripts import elpa)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix scripts)
#:use-module (guix import elpa) #:use-module (guix import elpa)
#:use-module (guix scripts import) #:use-module (guix scripts import)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)

1
guix/scripts/import/gem.scm
View File

@ -19,6 +19,7 @@
(define-module (guix scripts import gem) (define-module (guix scripts import gem)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix scripts)
#:use-module (guix import gem) #:use-module (guix import gem)
#:use-module (guix scripts import) #:use-module (guix scripts import)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)

1
guix/scripts/import/gnu.scm
View File

@ -19,6 +19,7 @@
(define-module (guix scripts import gnu) (define-module (guix scripts import gnu)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix scripts)
#:use-module (guix import gnu) #:use-module (guix import gnu)
#:use-module (guix scripts import) #:use-module (guix scripts import)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)

3
guix/scripts/import/hackage.scm
View File

@ -19,6 +19,7 @@
(define-module (guix scripts import hackage) (define-module (guix scripts import hackage)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix scripts)
#:use-module (guix import hackage) #:use-module (guix import hackage)
#:use-module (guix scripts import) #:use-module (guix scripts import)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
@ -47,7 +48,7 @@ package will be generated. If no version suffix is pecified, then the
generated package definition will correspond to the latest available generated package definition will correspond to the latest available
version.\n")) version.\n"))
(display (_ " (display (_ "
-e ALIST, --cabal-environment=ALIST -e ALIST, --cabal-environment=ALIST
specify environment for Cabal evaluation")) specify environment for Cabal evaluation"))
(display (_ " (display (_ "
-h, --help display this help and exit")) -h, --help display this help and exit"))

1
guix/scripts/import/nix.scm
View File

@ -20,6 +20,7 @@
(define-module (guix scripts import nix) (define-module (guix scripts import nix)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix scripts)
#:use-module (guix import snix) #:use-module (guix import snix)
#:use-module (guix scripts import) #:use-module (guix scripts import)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)

1
guix/scripts/import/pypi.scm
View File

@ -19,6 +19,7 @@
(define-module (guix scripts import pypi) (define-module (guix scripts import pypi)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix scripts)
#:use-module (guix import pypi) #:use-module (guix import pypi)
#:use-module (guix scripts import) #:use-module (guix scripts import)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)

1
guix/scripts/lint.scm
View File

@ -29,6 +29,7 @@
#:use-module (guix records) #:use-module (guix records)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix scripts)
#:use-module (guix gnu-maintenance) #:use-module (guix gnu-maintenance)
#:use-module (guix monads) #:use-module (guix monads)
#:use-module (gnu packages) #:use-module (gnu packages)

1
guix/scripts/package.scm
View File

@ -29,6 +29,7 @@
#:use-module (guix monads) #:use-module (guix monads)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix config) #:use-module (guix config)
#:use-module (guix scripts)
#:use-module (guix scripts build) #:use-module (guix scripts build)
#:use-module ((guix build utils) #:use-module ((guix build utils)
#:select (directory-exists? mkdir-p search-path-as-list)) #:select (directory-exists? mkdir-p search-path-as-list))

1
guix/scripts/publish.scm
View File

@ -45,6 +45,7 @@
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix serialization) #:use-module (guix serialization)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module (guix scripts)
#:export (guix-publish)) #:export (guix-publish))
(define (show-help) (define (show-help)

1
guix/scripts/pull.scm
View File

@ -18,6 +18,7 @@
(define-module (guix scripts pull) (define-module (guix scripts pull)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module (guix scripts)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix config) #:use-module (guix config)
#:use-module (guix packages) #:use-module (guix packages)

1
guix/scripts/refresh.scm
View File

@ -21,6 +21,7 @@
(define-module (guix scripts refresh) (define-module (guix scripts refresh)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module (guix hash) #:use-module (guix hash)
#:use-module (guix scripts)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix packages) #:use-module (guix packages)

1
guix/scripts/size.scm
View File

@ -18,6 +18,7 @@
(define-module (guix scripts size) (define-module (guix scripts size)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module (guix scripts)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix monads) #:use-module (guix monads)
#:use-module (guix utils) #:use-module (guix utils)

1
guix/scripts/system.scm
View File

@ -26,6 +26,7 @@
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (guix monads) #:use-module (guix monads)
#:use-module (guix profiles) #:use-module (guix profiles)
#:use-module (guix scripts)
#:use-module (guix scripts build) #:use-module (guix scripts build)
#:use-module (guix build utils) #:use-module (guix build utils)
#:use-module (gnu build install) #:use-module (gnu build install)

53
guix/ui.scm
View File

@ -2,9 +2,11 @@
;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2013 Mark H Weaver <mhw@netris.org> ;;; Copyright © 2013 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org> ;;; Copyright © 2013 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2014 Cyril Roelandt <tipecaml@gmail.com>
;;; Copyright © 2014 Cyrill Schenkel <cyrill.schenkel@gmail.com>
;;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com> ;;; Copyright © 2014, 2015 Alex Kost <alezost@gmail.com>
;;; Copyright © 2015 David Thompson <davet@gnu.org>
;;; Copyright © 2015 Mathieu Lirzin <mthl@openmailbox.org> ;;; Copyright © 2015 Mathieu Lirzin <mthl@openmailbox.org>
;;; Copyright © 2014 Deck Pickard <deck.r.pickard@gmail.com>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -39,7 +41,6 @@
#:use-module (srfi srfi-31) #:use-module (srfi srfi-31)
#:use-module (srfi srfi-34) #:use-module (srfi srfi-34)
#:use-module (srfi srfi-35) #:use-module (srfi srfi-35)
#:use-module (srfi srfi-37)
#:autoload (ice-9 ftw) (scandir) #:autoload (ice-9 ftw) (scandir)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 format) #:use-module (ice-9 format)
@ -79,8 +80,6 @@
package-specification->name+version+output package-specification->name+version+output
string->generations string->generations
string->duration string->duration
args-fold*
parse-command-line
run-guix-command run-guix-command
run-guix run-guix
program-name program-name
@ -959,52 +958,6 @@ optionally contain a version number and an output name, as in these examples:
;;; Command-line option processing. ;;; Command-line option processing.
;;; ;;;
(define (args-fold* options unrecognized-option-proc operand-proc . seeds)
"A wrapper on top of `args-fold' that does proper user-facing error
reporting."
(catch 'misc-error
(lambda ()
(apply args-fold options unrecognized-option-proc
operand-proc seeds))
(lambda (key proc msg args . rest)
;; XXX: MSG is not i18n'd.
(leave (_ "invalid argument: ~a~%")
(apply format #f msg args)))))
(define (environment-build-options)
"Return additional build options passed as environment variables."
(arguments-from-environment-variable "GUIX_BUILD_OPTIONS"))
(define %default-argument-handler
;; The default handler for non-option command-line arguments.
(lambda (arg result)
(alist-cons 'argument arg result)))
(define* (parse-command-line args options seeds
#:key
(argument-handler %default-argument-handler))
"Parse the command-line arguments ARGS as well as arguments passed via the
'GUIX_BUILD_OPTIONS' environment variable according to OPTIONS (a list of
SRFI-37 options) and return the result, seeded by SEEDS.
Command-line options take precedence those passed via 'GUIX_BUILD_OPTIONS'.
ARGUMENT-HANDLER is called for non-option arguments, like the 'operand-proc'
parameter of 'args-fold'."
(define (parse-options-from args seeds)
;; Actual parsing takes place here.
(apply args-fold* args options
(lambda (opt name arg . rest)
(leave (_ "~A: unrecognized option~%") name))
argument-handler
seeds))
(call-with-values
(lambda ()
(parse-options-from (environment-build-options) seeds))
(lambda seeds
;; ARGS take precedence over what the environment variable specifies.
(parse-options-from args seeds))))
(define (show-guix-usage) (define (show-guix-usage)
(format (current-error-port) (format (current-error-port)
(_ "Try `guix --help' for more information.~%")) (_ "Try `guix --help' for more information.~%"))

1
po/guix/POTFILES.in
View File

@ -4,6 +4,7 @@ gnu/packages.scm
gnu/system.scm gnu/system.scm
gnu/services/dmd.scm gnu/services/dmd.scm
gnu/system/shadow.scm gnu/system/shadow.scm
guix/scripts.scm
guix/scripts/build.scm guix/scripts/build.scm
guix/scripts/download.scm guix/scripts/download.scm
guix/scripts/package.scm guix/scripts/package.scm

72
tests/scripts.scm Normal file
View File

@ -0,0 +1,72 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 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)
#:use-module (guix scripts)
#:use-module ((guix scripts build)
#:select (%standard-build-options))
#:use-module (srfi srfi-64))
;; Test the (guix scripts) module.
(define-syntax-rule (with-environment-variable variable value body ...)
"Run BODY with VARIABLE set to VALUE."
(let ((orig (getenv variable)))
(dynamic-wind
(lambda ()
(setenv variable value))
(lambda ()
body ...)
(lambda ()
(if orig
(setenv variable orig)
(unsetenv variable))))))
(test-begin "scripts")
(test-equal "parse-command-line"
'((argument . "bar") (argument . "foo")
(cores . 10) ;takes precedence
(substitutes? . #f) (keep-failed? . #t)
(max-jobs . 77) (cores . 42))
(with-environment-variable "GUIX_BUILD_OPTIONS" "-c 42 -M 77"
(parse-command-line '("--keep-failed" "--no-substitutes"
"--cores=10" "foo" "bar")
%standard-build-options
(list '()))))
(test-equal "parse-command-line and --no options"
'((argument . "foo")
(substitutes? . #f)) ;takes precedence
(with-environment-variable "GUIX_BUILD_OPTIONS" "--no-substitutes"
(parse-command-line '("foo")
%standard-build-options
(list '((substitutes? . #t))))))
(test-end "scripts")
(exit (= (test-runner-fail-count (test-runner-current)) 0))
;;; Local Variables:
;;; eval: (put 'with-environment-variable 'scheme-indent-function 2)
;;; End:

40
tests/ui.scm
View File

@ -22,8 +22,6 @@
#:use-module (guix profiles) #:use-module (guix profiles)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix derivations) #:use-module (guix derivations)
#:use-module ((guix scripts build)
#:select (%standard-build-options))
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-11) #:use-module (srfi srfi-11)
#:use-module (srfi srfi-19) #:use-module (srfi srfi-19)
@ -54,43 +52,9 @@ interface, and powerful string processing.")
(item "/gnu/store/...") (item "/gnu/store/...")
(output "out"))) (output "out")))
(define-syntax-rule (with-environment-variable variable value body ...)
"Run BODY with VARIABLE set to VALUE."
(let ((orig (getenv variable)))
(dynamic-wind
(lambda ()
(setenv variable value))
(lambda ()
body ...)
(lambda ()
(if orig
(setenv variable orig)
(unsetenv variable))))))
(test-begin "ui") (test-begin "ui")
(test-equal "parse-command-line"
'((argument . "bar") (argument . "foo")
(cores . 10) ;takes precedence
(substitutes? . #f) (keep-failed? . #t)
(max-jobs . 77) (cores . 42))
(with-environment-variable "GUIX_BUILD_OPTIONS" "-c 42 -M 77"
(parse-command-line '("--keep-failed" "--no-substitutes"
"--cores=10" "foo" "bar")
%standard-build-options
(list '()))))
(test-equal "parse-command-line and --no options"
'((argument . "foo")
(substitutes? . #f)) ;takes precedence
(with-environment-variable "GUIX_BUILD_OPTIONS" "--no-substitutes"
(parse-command-line '("foo")
%standard-build-options
(list '((substitutes? . #t))))))
(test-assert "fill-paragraph" (test-assert "fill-paragraph"
(every (lambda (column) (every (lambda (column)
(every (lambda (width) (every (lambda (width)
@ -282,7 +246,3 @@ Second line" 24))
(exit (= (test-runner-fail-count (test-runner-current)) 0)) (exit (= (test-runner-fail-count (test-runner-current)) 0))
;;; Local Variables:
;;; eval: (put 'with-environment-variable 'scheme-indent-function 2)
;;; End: