>From 7d86c3fff02351b7b6bc02b74fb77684c8187693 Mon Sep 17 00:00:00 2001 From: Alex Kost Date: Thu, 10 Sep 2015 12:37:36 +0300 Subject: [PATCH] Add (guix scripts). * guix/ui.scm: Add missing copyright lines. (program-name, show-guix-help, show-guix-usage, initialize-guix): Export. (args-fold*, environment-build-options, %default-argument-handler, parse-command-line, run-guix-command, run-guix, guix-main): Move to ... * guix/scripts.scm: ...here. New file. * emacs/guix-main.scm: Use it. * guix/scripts/archive.scm: Likewise. * 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. * scripts/guix.in (run-guix-main): Use (guix scripts). * Makefile.am (MODULES): Add guix/scripts.scm. (SCM_TESTS): Add tests/scripts.scm. --- Makefile.am | 2 + emacs/guix-main.scm | 1 + guix/scripts.scm | 134 ++++++++++++++++++++++++++++++++++++++++ guix/scripts/archive.scm | 1 + guix/scripts/build.scm | 1 + guix/scripts/download.scm | 1 + guix/scripts/edit.scm | 1 + guix/scripts/environment.scm | 1 + guix/scripts/gc.scm | 1 + guix/scripts/graph.scm | 1 + guix/scripts/hash.scm | 1 + guix/scripts/import/cpan.scm | 1 + guix/scripts/import/cran.scm | 1 + guix/scripts/import/elpa.scm | 1 + guix/scripts/import/gem.scm | 1 + guix/scripts/import/gnu.scm | 1 + guix/scripts/import/hackage.scm | 3 +- guix/scripts/import/nix.scm | 1 + guix/scripts/import/pypi.scm | 1 + guix/scripts/lint.scm | 1 + guix/scripts/package.scm | 1 + guix/scripts/publish.scm | 1 + guix/scripts/pull.scm | 1 + guix/scripts/refresh.scm | 1 + guix/scripts/size.scm | 1 + guix/scripts/system.scm | 1 + guix/ui.scm | 109 +++----------------------------- scripts/guix.in | 2 +- tests/scripts.scm | 72 +++++++++++++++++++++ tests/ui.scm | 40 ------------ 30 files changed, 241 insertions(+), 144 deletions(-) create mode 100644 guix/scripts.scm create mode 100644 tests/scripts.scm diff --git a/Makefile.am b/Makefile.am index 9a810e4..a8dab5d 100644 --- a/Makefile.am +++ b/Makefile.am @@ -102,6 +102,7 @@ MODULES = \ guix/import/cran.scm \ guix/import/hackage.scm \ guix/import/elpa.scm \ + guix/scripts.scm \ guix/scripts/download.scm \ guix/scripts/build.scm \ guix/scripts/archive.scm \ @@ -214,6 +215,7 @@ SCM_TESTS = \ tests/gremlin.scm \ tests/lint.scm \ tests/publish.scm \ + tests/scripts.scm \ tests/size.scm \ tests/graph.scm \ tests/file-systems.scm \ diff --git a/emacs/guix-main.scm b/emacs/guix-main.scm index c9b84d3..3bde121 100644 --- a/emacs/guix-main.scm +++ b/emacs/guix-main.scm @@ -58,6 +58,7 @@ (guix licenses) (guix utils) (guix ui) + (guix scripts) (guix scripts graph) (guix scripts lint) (guix scripts package) diff --git a/guix/scripts.scm b/guix/scripts.scm new file mode 100644 index 0000000..6bbe266 --- /dev/null +++ b/guix/scripts.scm @@ -0,0 +1,134 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013, 2014, 2015 Ludovic Courtès +;;; Copyright © 2013 Mark H Weaver +;;; Copyright © 2014 Deck Pickard +;;; Copyright © 2015 Alex Kost +;;; +;;; 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 . + +(define-module (guix scripts) + #:use-module (guix utils) + #:use-module (guix ui) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (srfi srfi-37) + #:use-module (ice-9 match) + #:export (args-fold* + parse-command-line + run-guix-command + run-guix + guix-main)) + +;;; 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)))) + +(define (run-guix-command command . args) + "Run COMMAND with the given ARGS. Report an error when COMMAND is not +found." + (define module + (catch 'misc-error + (lambda () + (resolve-interface `(guix scripts ,command))) + (lambda - + (format (current-error-port) + (_ "guix: ~a: command not found~%") command) + (show-guix-usage)))) + + (let ((command-main (module-ref module + (symbol-append 'guix- command)))) + (parameterize ((program-name command)) + (apply command-main args)))) + +(define (run-guix . args) + "Run the 'guix' command defined by command line ARGS. +Unlike 'guix-main', this procedure assumes that locale, i18n support, +and signal handling has already been set up." + (define option? (cut string-prefix? "-" <>)) + + (match args + (() + (format (current-error-port) + (_ "guix: missing command name~%")) + (show-guix-usage)) + ((or ("-h") ("--help")) + (show-guix-help)) + (("--version") + (show-version-and-exit "guix")) + (((? option? o) args ...) + (format (current-error-port) + (_ "guix: unrecognized option '~a'~%") o) + (show-guix-usage)) + (("help" args ...) + (show-guix-help)) + ((command args ...) + (apply run-guix-command + (string->symbol command) + args)))) + +(define (guix-main arg0 . args) + (initialize-guix) + (apply run-guix args)) + +;;; scripts.scm ends here diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm index ab2fc46..b120c55 100644 --- a/guix/scripts/archive.scm +++ b/guix/scripts/archive.scm @@ -27,6 +27,7 @@ #:use-module (guix ui) #:use-module (guix pki) #:use-module (guix pk-crypto) + #:use-module (guix scripts) #:use-module (guix scripts build) #:use-module (gnu packages) #:use-module (ice-9 match) diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index d593b5a..03a9d67 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -19,6 +19,7 @@ (define-module (guix scripts build) #:use-module (guix ui) + #:use-module (guix scripts) #:use-module (guix store) #:use-module (guix derivations) #:use-module (guix packages) diff --git a/guix/scripts/download.scm b/guix/scripts/download.scm index 87b4204..533970f 100644 --- a/guix/scripts/download.scm +++ b/guix/scripts/download.scm @@ -18,6 +18,7 @@ (define-module (guix scripts download) #:use-module (guix ui) + #:use-module (guix scripts) #:use-module (guix store) #:use-module (guix hash) #:use-module (guix utils) diff --git a/guix/scripts/edit.scm b/guix/scripts/edit.scm index fc453ac..30146af 100644 --- a/guix/scripts/edit.scm +++ b/guix/scripts/edit.scm @@ -18,6 +18,7 @@ (define-module (guix scripts edit) #:use-module (guix ui) + #:use-module (guix scripts) #:use-module (guix utils) #:use-module (guix packages) #:use-module (gnu packages) diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index ecdbc7a..7aa52e8 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -27,6 +27,7 @@ #:use-module (guix utils) #:use-module (guix monads) #:use-module ((guix gexp) #:select (lower-inputs)) + #:use-module (guix scripts) #:use-module (guix scripts build) #:use-module (gnu packages) #:use-module (ice-9 format) diff --git a/guix/scripts/gc.scm b/guix/scripts/gc.scm index 6403893..7e06c72 100644 --- a/guix/scripts/gc.scm +++ b/guix/scripts/gc.scm @@ -18,6 +18,7 @@ (define-module (guix scripts gc) #:use-module (guix ui) + #:use-module (guix scripts) #:use-module (guix store) #:use-module (ice-9 match) #:use-module (ice-9 regex) diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm index 2b671be..da02973 100644 --- a/guix/scripts/graph.scm +++ b/guix/scripts/graph.scm @@ -18,6 +18,7 @@ (define-module (guix scripts graph) #:use-module (guix ui) + #:use-module (guix scripts) #:use-module (guix utils) #:use-module (guix packages) #:use-module (guix monads) diff --git a/guix/scripts/hash.scm b/guix/scripts/hash.scm index e2305d7..d440953 100644 --- a/guix/scripts/hash.scm +++ b/guix/scripts/hash.scm @@ -22,6 +22,7 @@ #:use-module (guix hash) #:use-module (guix serialization) #:use-module (guix ui) + #:use-module (guix scripts) #:use-module (guix utils) #:use-module (rnrs io ports) #:use-module (rnrs files) diff --git a/guix/scripts/import/cpan.scm b/guix/scripts/import/cpan.scm index 1f4dedf..3d470f6 100644 --- a/guix/scripts/import/cpan.scm +++ b/guix/scripts/import/cpan.scm @@ -19,6 +19,7 @@ (define-module (guix scripts import cpan) #:use-module (guix ui) #:use-module (guix utils) + #:use-module (guix scripts) #:use-module (guix import cpan) #:use-module (guix scripts import) #:use-module (srfi srfi-1) diff --git a/guix/scripts/import/cran.scm b/guix/scripts/import/cran.scm index f11fa10..8d001ac 100644 --- a/guix/scripts/import/cran.scm +++ b/guix/scripts/import/cran.scm @@ -20,6 +20,7 @@ (define-module (guix scripts import cran) #:use-module (guix ui) #:use-module (guix utils) + #:use-module (guix scripts) #:use-module (guix import cran) #:use-module (guix scripts import) #:use-module (srfi srfi-1) diff --git a/guix/scripts/import/elpa.scm b/guix/scripts/import/elpa.scm index c72aaf0..b22a7c4 100644 --- a/guix/scripts/import/elpa.scm +++ b/guix/scripts/import/elpa.scm @@ -19,6 +19,7 @@ (define-module (guix scripts import elpa) #:use-module (guix ui) #:use-module (guix utils) + #:use-module (guix scripts) #:use-module (guix import elpa) #:use-module (guix scripts import) #:use-module (srfi srfi-1) diff --git a/guix/scripts/import/gem.scm b/guix/scripts/import/gem.scm index 9f8094f..a5dd2a7 100644 --- a/guix/scripts/import/gem.scm +++ b/guix/scripts/import/gem.scm @@ -19,6 +19,7 @@ (define-module (guix scripts import gem) #:use-module (guix ui) #:use-module (guix utils) + #:use-module (guix scripts) #:use-module (guix import gem) #:use-module (guix scripts import) #:use-module (srfi srfi-1) diff --git a/guix/scripts/import/gnu.scm b/guix/scripts/import/gnu.scm index 5fac6db..92bd830 100644 --- a/guix/scripts/import/gnu.scm +++ b/guix/scripts/import/gnu.scm @@ -19,6 +19,7 @@ (define-module (guix scripts import gnu) #:use-module (guix ui) #:use-module (guix utils) + #:use-module (guix scripts) #:use-module (guix import gnu) #:use-module (guix scripts import) #:use-module (srfi srfi-1) diff --git a/guix/scripts/import/hackage.scm b/guix/scripts/import/hackage.scm index 1e33556..8d31128 100644 --- a/guix/scripts/import/hackage.scm +++ b/guix/scripts/import/hackage.scm @@ -19,6 +19,7 @@ (define-module (guix scripts import hackage) #:use-module (guix ui) #:use-module (guix utils) + #:use-module (guix scripts) #:use-module (guix import hackage) #:use-module (guix scripts import) #: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 version.\n")) (display (_ " - -e ALIST, --cabal-environment=ALIST + -e ALIST, --cabal-environment=ALIST specify environment for Cabal evaluation")) (display (_ " -h, --help display this help and exit")) diff --git a/guix/scripts/import/nix.scm b/guix/scripts/import/nix.scm index 2dc2677..dba053b 100644 --- a/guix/scripts/import/nix.scm +++ b/guix/scripts/import/nix.scm @@ -20,6 +20,7 @@ (define-module (guix scripts import nix) #:use-module (guix ui) #:use-module (guix utils) + #:use-module (guix scripts) #:use-module (guix import snix) #:use-module (guix scripts import) #:use-module (srfi srfi-1) diff --git a/guix/scripts/import/pypi.scm b/guix/scripts/import/pypi.scm index 1e03843..7166b01 100644 --- a/guix/scripts/import/pypi.scm +++ b/guix/scripts/import/pypi.scm @@ -19,6 +19,7 @@ (define-module (guix scripts import pypi) #:use-module (guix ui) #:use-module (guix utils) + #:use-module (guix scripts) #:use-module (guix import pypi) #:use-module (guix scripts import) #:use-module (srfi srfi-1) diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm index 2a618c9..f6f5aec 100644 --- a/guix/scripts/lint.scm +++ b/guix/scripts/lint.scm @@ -28,6 +28,7 @@ #:use-module (guix records) #:use-module (guix ui) #:use-module (guix utils) + #:use-module (guix scripts) #:use-module (guix gnu-maintenance) #:use-module (guix monads) #:use-module (gnu packages) diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index 23f1597..e0fe1dd 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -29,6 +29,7 @@ #:use-module (guix monads) #:use-module (guix utils) #:use-module (guix config) + #:use-module (guix scripts) #:use-module (guix scripts build) #:use-module ((guix build utils) #:select (directory-exists? mkdir-p search-path-as-list)) diff --git a/guix/scripts/publish.scm b/guix/scripts/publish.scm index cc96355..e352090 100644 --- a/guix/scripts/publish.scm +++ b/guix/scripts/publish.scm @@ -45,6 +45,7 @@ #:use-module (guix store) #:use-module (guix serialization) #:use-module (guix ui) + #:use-module (guix scripts) #:export (guix-publish)) (define (show-help) diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index e8459e5..56ee9ac 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -18,6 +18,7 @@ (define-module (guix scripts pull) #:use-module (guix ui) + #:use-module (guix scripts) #:use-module (guix store) #:use-module (guix config) #:use-module (guix packages) diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index e7980a9..097059e 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -21,6 +21,7 @@ (define-module (guix scripts refresh) #:use-module (guix ui) #:use-module (guix hash) + #:use-module (guix scripts) #:use-module (guix store) #:use-module (guix utils) #:use-module (guix packages) diff --git a/guix/scripts/size.scm b/guix/scripts/size.scm index ee070f1..44ff926 100644 --- a/guix/scripts/size.scm +++ b/guix/scripts/size.scm @@ -18,6 +18,7 @@ (define-module (guix scripts size) #:use-module (guix ui) + #:use-module (guix scripts) #:use-module (guix store) #:use-module (guix monads) #:use-module (guix utils) diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm index 45f5982..c9dbd99 100644 --- a/guix/scripts/system.scm +++ b/guix/scripts/system.scm @@ -26,6 +26,7 @@ #:use-module (guix utils) #:use-module (guix monads) #:use-module (guix profiles) + #:use-module (guix scripts) #:use-module (guix scripts build) #:use-module (guix build utils) #:use-module (gnu build install) diff --git a/guix/ui.scm b/guix/ui.scm index ca5b844..c8bf5ab 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -2,9 +2,10 @@ ;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès ;;; Copyright © 2013 Mark H Weaver ;;; Copyright © 2013 Nikita Karetnikov +;;; Copyright © 2014 Cyril Roelandt +;;; Copyright © 2014 Cyrill Schenkel ;;; Copyright © 2014, 2015 Alex Kost ;;; Copyright © 2015 Mathieu Lirzin -;;; Copyright © 2014 Deck Pickard ;;; ;;; This file is part of GNU Guix. ;;; @@ -39,7 +40,6 @@ #:use-module (srfi srfi-31) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) - #:use-module (srfi srfi-37) #:autoload (ice-9 ftw) (scandir) #:use-module (ice-9 match) #:use-module (ice-9 format) @@ -57,6 +57,9 @@ make-user-module load* warn-about-load-error + program-name + show-guix-help + show-guix-usage show-version-and-exit show-bug-report-information string->number* @@ -79,14 +82,9 @@ package-specification->name+version+output string->generations string->duration - args-fold* - parse-command-line - run-guix-command - run-guix - program-name + initialize-guix guix-warning-port - warning - guix-main)) + warning)) ;;; Commentary: ;;; @@ -959,52 +957,6 @@ optionally contain a version number and an output name, as in these examples: ;;; 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) (format (current-error-port) (_ "Try `guix --help' for more information.~%")) @@ -1048,54 +1000,7 @@ Run COMMAND with ARGS.\n")) ;; Name of the command-line program currently executing, or #f. (make-parameter #f)) -(define (run-guix-command command . args) - "Run COMMAND with the given ARGS. Report an error when COMMAND is not -found." - (define module - (catch 'misc-error - (lambda () - (resolve-interface `(guix scripts ,command))) - (lambda - - (format (current-error-port) - (_ "guix: ~a: command not found~%") command) - (show-guix-usage)))) - - (let ((command-main (module-ref module - (symbol-append 'guix- command)))) - (parameterize ((program-name command)) - (apply command-main args)))) - -(define (run-guix . args) - "Run the 'guix' command defined by command line ARGS. -Unlike 'guix-main', this procedure assumes that locale, i18n support, -and signal handling has already been set up." - (define option? (cut string-prefix? "-" <>)) - - (match args - (() - (format (current-error-port) - (_ "guix: missing command name~%")) - (show-guix-usage)) - ((or ("-h") ("--help")) - (show-guix-help)) - (("--version") - (show-version-and-exit "guix")) - (((? option? o) args ...) - (format (current-error-port) - (_ "guix: unrecognized option '~a'~%") o) - (show-guix-usage)) - (("help" args ...) - (show-guix-help)) - ((command args ...) - (apply run-guix-command - (string->symbol command) - args)))) - (define guix-warning-port (make-parameter (current-warning-port))) -(define (guix-main arg0 . args) - (initialize-guix) - (apply run-guix args)) - ;;; ui.scm ends here diff --git a/scripts/guix.in b/scripts/guix.in index 8f2d8a6..91a5fd1 100644 --- a/scripts/guix.in +++ b/scripts/guix.in @@ -57,7 +57,7 @@ (push! updates-dir %load-compiled-path))))) (define (run-guix-main) - (let ((guix-main (module-ref (resolve-interface '(guix ui)) + (let ((guix-main (module-ref (resolve-interface '(guix scripts)) 'guix-main))) (bindtextdomain "guix" (config-lookup "localedir")) (bindtextdomain "guix-packages" (config-lookup "localedir")) diff --git a/tests/scripts.scm b/tests/scripts.scm new file mode 100644 index 0000000..3bf41ae --- /dev/null +++ b/tests/scripts.scm @@ -0,0 +1,72 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2015 Ludovic Courtès +;;; +;;; 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 . + + +(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: diff --git a/tests/ui.scm b/tests/ui.scm index 1478fe2..25fc709 100644 --- a/tests/ui.scm +++ b/tests/ui.scm @@ -22,8 +22,6 @@ #:use-module (guix profiles) #:use-module (guix store) #:use-module (guix derivations) - #:use-module ((guix scripts build) - #:select (%standard-build-options)) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-19) @@ -54,43 +52,9 @@ interface, and powerful string processing.") (item "/gnu/store/...") (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-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" (every (lambda (column) (every (lambda (width) @@ -282,7 +246,3 @@ Second line" 24)) (exit (= (test-runner-fail-count (test-runner-current)) 0)) - -;;; Local Variables: -;;; eval: (put 'with-environment-variable 'scheme-indent-function 2) -;;; End: -- 2.5.0