From mboxrd@z Thu Jan 1 00:00:00 1970 From: Alex Kost Subject: Re: [PATCH] Add (guix scripts). Date: Mon, 14 Sep 2015 21:39:11 +0300 Message-ID: <878u88alrk.fsf@gmail.com> References: <1437814197-6321-1-git-send-email-alezost@gmail.com> <1437814197-6321-7-git-send-email-alezost@gmail.com> <87zj1ou1i0.fsf@gnu.org> <878u972ea9.fsf@gmail.com> <87mvxe8frd.fsf@gnu.org> <87oahuvtah.fsf@gmail.com> <87si73u5no.fsf@gnu.org> <87bndfx6l1.fsf@gmail.com> <87io7ku0ys.fsf@gnu.org> <871te6605s.fsf@gmail.com> <87mvwpruos.fsf@gnu.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:52028) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ZbYer-0000ZA-UW for guix-devel@gnu.org; Mon, 14 Sep 2015 14:39:21 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1ZbYeo-00008Q-LA for guix-devel@gnu.org; Mon, 14 Sep 2015 14:39:17 -0400 In-Reply-To: <87mvwpruos.fsf@gnu.org> ("Ludovic \=\?utf-8\?Q\?Court\=C3\=A8s\=22'\?\= \=\?utf-8\?Q\?s\?\= message of "Mon, 14 Sep 2015 15:34:27 +0200") List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org To: Ludovic =?utf-8?Q?Court=C3=A8s?= Cc: guix-devel@gnu.org --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Ludovic Court=C3=A8s (2015-09-14 16:34 +0300) wrote: > Alex Kost skribis: [...] >> Also our 'guix' executable will be changed, I'm not sure what >> consequences it will lead to. > > I knew I=E2=80=99d overlook something: That=E2=80=99s a showstopper. Bas= ically, =E2=80=98guix > pull=E2=80=99 assumes that =E2=80=98guix=E2=80=99 is immutable. Maybe we= can break it once > before 1.0, but in the meantime, I=E2=80=99d rather avoid it. > > That means =E2=80=98guix-main=E2=80=99 must remain in (guix ui). Consequ= ently, a bunch > of other procedures (show-*, run-guix-command, commands) should remain > there, to avoid a circular dependency between (guix scripts) and (guix > ui). > > WDYT? Could you try to adjust the patch accordingly? OK, the updated patch is attached, thanks. --=-=-= Content-Type: text/x-patch; charset=utf-8 Content-Disposition: attachment; filename=0001-Add-guix-scripts.patch Content-Transfer-Encoding: quoted-printable >From b5484f43c429e283284033f4adb6097034a60418 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. (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. --- Makefile.am | 2 + guix/scripts.scm | 81 +++++++++++++++++++++++++++++++++++++= ++++ 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 | 53 ++------------------------- tests/scripts.scm | 72 ++++++++++++++++++++++++++++++++++++ tests/ui.scm | 40 -------------------- 28 files changed, 182 insertions(+), 91 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 =3D \ 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 =3D \ 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/guix/scripts.scm b/guix/scripts.scm new file mode 100644 index 0000000..6bb3e21 --- /dev/null +++ b/guix/scripts.scm @@ -0,0 +1,81 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright =C2=A9 2013, 2014, 2015 Ludovic Court=C3=A8s +;;; Copyright =C2=A9 2014 Deck Pickard +;;; +;;; 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-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 t= he +'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-pro= c' +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 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 ab2a39b..1d766c0 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -19,6 +19,7 @@ =20 (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 @@ =20 (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 @@ =20 (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 @@ =20 (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 @@ =20 (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 pecif= ied, then the generated package definition will correspond to the latest available version.\n")) (display (_ " - -e ALIST, --cabal-environment=3DALIST=20=20=20 + -e ALIST, --cabal-environment=3DALIST 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)) =20 (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 @@ =20 (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 @@ =20 (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..e028e40 100644 --- a/guix/ui.scm +++ b/guix/ui.scm @@ -2,9 +2,11 @@ ;;; Copyright =C2=A9 2012, 2013, 2014, 2015 Ludovic Court=C3=A8s ;;; Copyright =C2=A9 2013 Mark H Weaver ;;; Copyright =C2=A9 2013 Nikita Karetnikov +;;; Copyright =C2=A9 2014 Cyril Roelandt +;;; Copyright =C2=A9 2014 Cyrill Schenkel ;;; Copyright =C2=A9 2014, 2015 Alex Kost +;;; Copyright =C2=A9 2015 David Thompson ;;; Copyright =C2=A9 2015 Mathieu Lirzin -;;; Copyright =C2=A9 2014 Deck Pickard ;;; ;;; This file is part of GNU Guix. ;;; @@ -39,7 +41,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) @@ -79,8 +80,6 @@ package-specification->name+version+output string->generations string->duration - args-fold* - parse-command-line run-guix-command run-guix program-name @@ -959,52 +958,6 @@ optionally contain a version number and an output name= , as in these examples: ;;; Command-line option processing. ;;; =20 -(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 t= he -'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-pro= c' -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.~%")) 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 =C2=A9 2015 Ludovic Court=C3=A8s +;;; +;;; 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=3D10" "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 (=3D (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"))) =20 -(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") =20 -(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=3D10" "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)) =20 (exit (=3D (test-runner-fail-count (test-runner-current)) 0)) - -;;; Local Variables: -;;; eval: (put 'with-environment-variable 'scheme-indent-function 2) -;;; End: --=20 2.5.0 --=-=-=--