From 89b1f89cfc88c1cdc4e61834e8e1b497b978ee99 Mon Sep 17 00:00:00 2001
From: Mathieu Lirzin <mthl@gnu.org>
Date: Thu, 14 Jul 2016 17:56:27 +0200
Subject: [PATCH] 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 f178cf77..85cac051 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 180ecd31..799f64c1 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 <mthl@gnu.org>
;;;
;;; 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 <http://www.gnu.org/licenses/>.
-(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 f535ac60..81fba6e6 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 d351e4ea..c63a3e50 100644
--- a/src/cuirass/ui.scm
+++ b/src/cuirass/ui.scm
@@ -18,10 +18,22 @@
;;; along with Cuirass. If not, see <http://www.gnu.org/licenses/>.
(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 fb3bfd19..f902da2e 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 <mthl@gnu.org>
;;;
;;; 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 00000000..34b1ffdd
--- /dev/null
+++ b/tests/ui.scm
@@ -0,0 +1,24 @@
+;;; ui.scm -- tests for (cuirass ui) module
+;;; Copyright 漏 2016 Mathieu Lirzin <mthl@gnu.org>
+;;;
+;;; 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 <http://www.gnu.org/licenses/>.
+
+(use-modules (cuirass ui)
+ (srfi srfi-64))
+
+(test-error "invalid program name"
+ 'wrong-type-arg
+ (%program-name #f))
--
GitLab