guix-commits
[Top][All Lists]
Advanced

[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



reply via email to

[Prev in Thread] Current Thread [Next in Thread]