tests/common.scm (start-session-loop): New procedure

* tests/common.scm (start-session-loop): New procedure.
  (start-server-loop, start-server/dist-test): Use it.
  (make-session-loop): Remove the macro.
* tests/client-server.scm ("userauth-none!, success")
  ("userauth-none!, denied", "userauth-none!, partial")
  ("userauth-password!, success", "userauth-password!, denied")
  ("userauth-password!, partial", "userauth-public-key!, success")
  ("userauth-get-list"): Use 'start-session-loop'.
* tests/dist.scm ("with-ssh"): Likewise.

3 files changed, 72 insertions, 63 deletions

diff --git a/tests/client-server.scm b/tests/client-server.scm
index e8e8ea0..f360a1d 100644
--- a/tests/client-server.scm
+++ b/tests/client-server.scm
@@ -173,9 +173,10 @@
      (server-listen server)
      (let ((session (server-accept server)))
        (server-handle-key-exchange session)
-       (make-session-loop session
-                          (message-auth-set-methods! msg '(none))
-                          (message-reply-success msg))))
+       (start-session-loop session
+                           (lambda (msg type)
+                             (message-auth-set-methods! msg '(none))
+                             (message-reply-success msg)))))
 
    ;; client
    (lambda ()
@@ -197,9 +198,10 @@
      (server-listen server)
      (let ((session (server-accept server)))
        (server-handle-key-exchange session)
-       (make-session-loop session
-                          (message-auth-set-methods! msg '(public-key))
-                          (message-reply-default msg))))
+       (start-session-loop session
+                           (lambda (msg type)
+                             (message-auth-set-methods! msg '(public-key))
+                             (message-reply-default msg)))))
 
    ;; client
    (lambda ()
@@ -221,9 +223,10 @@
      (server-listen server)
      (let ((session (server-accept server)))
        (server-handle-key-exchange session)
-       (make-session-loop session
-                          (message-auth-set-methods! msg '(none))
-                          (message-reply-success msg 'partial))))
+       (start-session-loop session
+                           (lambda (msg type)
+                             (message-auth-set-methods! msg '(none))
+                             (message-reply-success msg 'partial)))))
 
    ;; client
    (lambda ()
@@ -244,9 +247,10 @@
      (server-listen server)
      (let ((session (server-accept server)))
        (server-handle-key-exchange session)
-       (make-session-loop session
-                          (message-auth-set-methods! msg '(password))
-                          (message-reply-success msg))))
+       (start-session-loop session
+                           (lambda (msg type)
+                             (message-auth-set-methods! msg '(password))
+                             (message-reply-success msg)))))
 
    ;; client
    (lambda ()
@@ -267,9 +271,10 @@
      (server-listen server)
      (let ((session (server-accept server)))
        (server-handle-key-exchange session)
-       (make-session-loop session
-                          (message-auth-set-methods! msg '(password))
-                          (message-reply-default msg))))
+       (start-session-loop session
+                           (lambda (msg type)
+                             (message-auth-set-methods! msg '(password))
+                             (message-reply-default msg)))))
 
    ;; client
    (lambda ()
@@ -290,9 +295,10 @@
      (server-listen server)
      (let ((session (server-accept server)))
        (server-handle-key-exchange session)
-       (make-session-loop session
-                          (message-auth-set-methods! msg '(password))
-                          (message-reply-success msg 'partial))))
+       (start-session-loop session
+                           (lambda (msg type)
+                             (message-auth-set-methods! msg '(password))
+                             (message-reply-success msg 'partial)))))
 
    ;; client
    (lambda ()
@@ -313,8 +319,9 @@
      (server-listen server)
      (let ((session (server-accept server)))
        (server-handle-key-exchange session)
-       (make-session-loop session
-                          (message-reply-success msg))))
+       (start-session-loop session
+                           (lambda (msg type)
+                             (message-reply-success msg)))))
 
    ;; client
    (lambda ()
@@ -337,9 +344,10 @@
    (lambda (server)
      (let ((session (server-accept server)))
        (server-handle-key-exchange session)
-       (make-session-loop session
-                          (message-auth-set-methods! msg '(password public-key))
-                          (message-reply-default msg))))
+       (start-session-loop session
+                           (lambda (msg type)
+                             (message-auth-set-methods! msg '(password public-key))
+                             (message-reply-default msg)))))
 
    ;; client
    (lambda ()
diff --git a/tests/common.scm b/tests/common.scm
index b789683..30b0c68 100644
--- a/tests/common.scm
+++ b/tests/common.scm
@@ -41,7 +41,7 @@
             ;; Procedures
             get-unused-port
             test-assert-with-log
-            make-session-loop
+            start-session-loop
             make-session-for-test
             make-server-for-test
             make-libssh-log-printer
@@ -88,11 +88,12 @@
          (set-log-userdata! name)
          body ...)))))
 
-(define-macro (make-session-loop session . body)
-  `(let session-loop ((msg (server-message-get ,session)))
-     (and msg (begin ,@body))
-     (and (connected? session)
-          (session-loop (server-message-get ,session)))))
+(define (start-session-loop session body)
+  (let session-loop ((msg (server-message-get session)))
+    (when (and msg (not (eof-object? msg)))
+      (body msg (message-get-type msg)))
+    (when (connected? session)
+      (session-loop (server-message-get session)))))
 
 (define (make-session-for-test)
   "Make a session with predefined parameters for a test."
@@ -176,9 +177,9 @@
   (server-listen server)
   (let ((session (server-accept server)))
     (server-handle-key-exchange session)
-    (make-session-loop session
-      (unless (eof-object? msg)
-        (proc msg)))
+    (start-session-loop session
+                        (lambda (msg type)
+                          (proc msg)))
     (primitive-exit)))
 
 
@@ -239,9 +240,9 @@
                         (global-request-callback . ,proc))))
       (session-set! session 'callbacks callbacks))
 
-    (make-session-loop session
-      (unless (eof-object? msg)
-        (message-reply-success msg)))))
+    (start-session-loop session
+                        (lambda (msg type)
+                          (message-reply-success msg)))))
 
 
 ;;; Tests
diff --git a/tests/dist.scm b/tests/dist.scm
index 6ec50d9..7524a94 100644
--- a/tests/dist.scm
+++ b/tests/dist.scm
@@ -177,39 +177,39 @@
      (server-set! server 'log-verbosity 'functions)
      (let ((session (server-accept server)))
        (server-handle-key-exchange session)
-       (make-session-loop session
-         (unless (eof-object? msg)
-           (let ((type (message-get-type msg)))
-             (case (car type)
-               ((request-channel-open)
-                (let ((c (message-channel-request-open-reply-accept msg)))
+       (start-session-loop
+        session
+        (lambda (msg type)
+          (case (car type)
+            ((request-channel-open)
+             (let ((c (message-channel-request-open-reply-accept msg)))
 
-                  ;; Write the last line of Guile REPL greeting message to
-                  ;; pretend that we're a REPL server.
-                  (write-line "Enter `,help' for help." c)
+               ;; Write the last line of Guile REPL greeting message to
+               ;; pretend that we're a REPL server.
+               (write-line "Enter `,help' for help." c)
 
-                  (usleep 100)
-                  (poll c
-                        (lambda args
-                          ;; Read expression
-                          (let ((result (read-line c)))
-                            (format-log 'nolog "server"
-                                        "[SCM] sexp: ~a" result)
-                            (or (string=? result "(begin (+ 21 21))")
-                                (error "Wrong result 1" result)))
+               (usleep 100)
+               (poll c
+                     (lambda args
+                       ;; Read expression
+                       (let ((result (read-line c)))
+                         (format-log 'nolog "server"
+                                     "[SCM] sexp: ~a" result)
+                         (or (string=? result "(begin (+ 21 21))")
+                             (error "Wrong result 1" result)))
 
-                          ;; Read newline
-                          (let ((result (read-line c)))
-                            (format-log 'nolog "server"
-                                        "[SCM] sexp: ~a" result)
-                            (or (string=? result "(newline)")
-                                (error "Wrong result 2" result)))
+                       ;; Read newline
+                       (let ((result (read-line c)))
+                         (format-log 'nolog "server"
+                                     "[SCM] sexp: ~a" result)
+                         (or (string=? result "(newline)")
+                             (error "Wrong result 2" result)))
 
-                          (write-line "scheme@(guile-user)> $1 = 42\n" c)
+                       (write-line "scheme@(guile-user)> $1 = 42\n" c)
 
-                          (sleep 60)))))
-               (else
-                (message-reply-success msg))))))))
+                       (sleep 60)))))
+            (else
+             (message-reply-success msg)))))))
    ;; Client
    (lambda ()
      (let ((session (make-session-for-test)))