[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[shepherd] 02/02: service: 'enable' and other actions now have a fixed a
From: |
Ludovic Courtès |
Subject: |
[shepherd] 02/02: service: 'enable' and other actions now have a fixed arity. |
Date: |
Sun, 16 Oct 2016 13:50:27 +0000 (UTC) |
civodul pushed a commit to branch master
in repository shepherd.
commit a84ecf34be2a35e8b068d4232d8932acc5986c33
Author: Ludovic Courtès <address@hidden>
Date: Sun Oct 16 15:46:42 2016 +0200
service: 'enable' and other actions now have a fixed arity.
* modules/shepherd/service.scm (action)[default-action]: Return
fixed-arity procedures for 'status', 'enable', and 'disable'.
* tests/basic.sh: Add test.
---
modules/shepherd/service.scm | 33 +++++++++++++++++++--------------
tests/basic.sh | 7 ++++++-
2 files changed, 25 insertions(+), 15 deletions(-)
diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index 675639e..a62962c 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -388,31 +388,36 @@ wire."
;; Call action THE-ACTION with ARGS.
(define-method (action (obj <service>) the-action . args)
- (define (default-action running . args)
+ (define default-action
;; All actions which are handled here might be called even if the
;; service is not running, so they have to take this into account.
(case the-action
;; Restarting is done in the obvious way.
((restart)
- (if running
- (stop obj)
- (local-output "~a was not running." (canonical-name obj)))
- (start obj))
+ (lambda (running . args)
+ (if running
+ (stop obj)
+ (local-output "~a was not running." (canonical-name obj)))
+ (start obj args)))
((status)
;; Return the service itself. It is automatically converted to an sexp
;; via 'result->sexp' and sent to the client.
- obj)
+ (lambda (_) obj))
((enable)
- (enable obj))
+ (lambda (_)
+ (enable obj)))
((disable)
- (disable obj))
+ (lambda (_)
+ (disable obj)))
((doc)
- (apply doc obj args))
+ (lambda (_ . args)
+ (apply doc obj args)))
(else
- ;; FIXME: Unknown service.
- (raise (condition (&unknown-action-error
- (service obj)
- (action the-action)))))))
+ (lambda _
+ ;; FIXME: Unknown service.
+ (raise (condition (&unknown-action-error
+ (service obj)
+ (action the-action))))))))
(let ((proc (or (and=> (lookup-action obj the-action)
action-procedure)
@@ -425,7 +430,7 @@ wire."
(catch #t
(lambda ()
(cond ((eq? proc default-action)
- (apply default-action (slot-ref obj 'running) args))
+ (apply default-action obj args))
((not (running? obj))
(local-output "Service ~a is not running." (canonical-name obj))
#f)
diff --git a/tests/basic.sh b/tests/basic.sh
index f706ec9..e80d2f5 100644
--- a/tests/basic.sh
+++ b/tests/basic.sh
@@ -95,10 +95,15 @@ $herd enable test-2
$herd start test-2
# This used to crash shepherd: <http://bugs.gnu.org/24684>.
-$herd enable test-2 with extra arguments
+if $herd enable test-2 with extra arguments
+then false; else true; fi
$herd status test-2 | grep started
+# Make sure extra arguments lead to an error.
+if $herd status test-2 something else that is useless
+then false; else true; fi
+
for action in status start stop
do
if $herd $action does-not-exist