From 89b1f89cfc88c1cdc4e61834e8e1b497b978ee99 Mon Sep 17 00:00:00 2001 From: Mathieu Lirzin Date: Thu, 14 Jul 2016 17:56:27 +0200 Subject: Move '%program-name' to (cuirass ui) module. --- Makefile.am | 1 + bin/cuirass.in | 7 +++---- src/cuirass/base.scm | 11 ----------- src/cuirass/ui.scm | 18 +++++++++++++++--- tests/base.scm | 19 +++++++------------ tests/ui.scm | 24 ++++++++++++++++++++++++ 6 files changed, 50 insertions(+), 30 deletions(-) create mode 100644 tests/ui.scm diff --git a/Makefile.am b/Makefile.am index f178cf7..85cac05 100644 --- a/Makefile.am +++ b/Makefile.am @@ -31,6 +31,7 @@ TESTS = \ tests/base.scm \ ## tests/basic.sh # takes too long to execute tests/database.scm \ + tests/ui.scm \ tests/utils.scm # Unset 'GUILE_LOAD_COMPILED_PATH' altogether while compiling. Otherwise, if diff --git a/bin/cuirass.in b/bin/cuirass.in index 180ecd3..799f64c 100644 --- a/bin/cuirass.in +++ b/bin/cuirass.in @@ -2,8 +2,7 @@ # -*- scheme -*- exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@" !# -;;;; cuirass - continuous integration system -;;; +;;; cuirass -- continuous integration tool ;;; Copyright © 2016 Mathieu Lirzin ;;; ;;; This file is part of Cuirass. @@ -21,8 +20,8 @@ exec ${GUILE:-@GUILE@} --no-auto-compile -e main -s "$0" "$@" ;;; You should have received a copy of the GNU General Public License ;;; along with Cuirass. If not, see . -(use-modules (cuirass config) - (cuirass base) +(use-modules (cuirass base) + (cuirass config) (cuirass database) (cuirass ui) (cuirass utils) diff --git a/src/cuirass/base.scm b/src/cuirass/base.scm index f535ac6..81fba6e 100644 --- a/src/cuirass/base.scm +++ b/src/cuirass/base.scm @@ -24,19 +24,8 @@ #:export (;; Procedures. call-with-time-display ;; Parameters. - %program-name %package-cachedir)) -(define %program-name - ;; Similar in spirit to Gnulib 'progname' module. - (make-parameter "" - (λ (val) - (cond ((not (string? val)) - (scm-error 'wrong-type-arg - "%program-name" "Not a string: ~S" (list #f) #f)) - ((string-rindex val #\/) => (λ (idx) (substring val (1+ idx)))) - (else val))))) - (define %package-cachedir ;; Define to location of cache directory of this package. (make-parameter (or (getenv "CUIRASS_CACHEDIR") diff --git a/src/cuirass/ui.scm b/src/cuirass/ui.scm index d351e4e..c63a3e5 100644 --- a/src/cuirass/ui.scm +++ b/src/cuirass/ui.scm @@ -18,10 +18,22 @@ ;;; along with Cuirass. If not, see . (define-module (cuirass ui) - #:use-module (cuirass base) #:use-module (cuirass config) - #:export (show-version - show-package-information)) + #:export (;; Procedures. + show-version + show-package-information + ;; Parameters. + %program-name)) + +(define %program-name + ;; Similar in spirit to Gnulib 'progname' module. + (make-parameter "" + (λ (val) + (cond ((not (string? val)) + (scm-error 'wrong-type-arg + "%program-name" "Not a string: ~S" (list #f) #f)) + ((string-rindex val #\/) => (λ (idx) (substring val (1+ idx)))) + (else val))))) (define (show-version) "Display version information for COMMAND." diff --git a/tests/base.scm b/tests/base.scm index fb3bfd1..f902da2 100644 --- a/tests/base.scm +++ b/tests/base.scm @@ -1,16 +1,15 @@ -;;;; base.scm - tests for (cuirass base) module -;;; +;;; base.scm -- tests for (cuirass base) module ;;; Copyright © 2016 Mathieu Lirzin ;;; ;;; This file is part of Cuirass. ;;; -;;; Cuirass 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. +;;; Cuirass 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. ;;; -;;; Cuirass is distributed in the hope that it will be useful, but -;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; Cuirass 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. ;;; @@ -20,10 +19,6 @@ (use-modules (cuirass base) (srfi srfi-64)) -(test-error "invalid program name" - 'wrong-type-arg - (%program-name #f)) - (test-error "invalid cache directory" 'wrong-type-arg (%package-cachedir #f)) diff --git a/tests/ui.scm b/tests/ui.scm new file mode 100644 index 0000000..34b1ffd --- /dev/null +++ b/tests/ui.scm @@ -0,0 +1,24 @@ +;;; ui.scm -- tests for (cuirass ui) module +;;; Copyright © 2016 Mathieu Lirzin +;;; +;;; This file is part of Cuirass. +;;; +;;; Cuirass 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. +;;; +;;; Cuirass 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 Cuirass. If not, see . + +(use-modules (cuirass ui) + (srfi srfi-64)) + +(test-error "invalid program name" + 'wrong-type-arg + (%program-name #f)) -- cgit v1.2.3