source: project/release/3/remote-mailbox/tags/1.1/tests/remote-mailbox-test.scm @ 11637

Last change on this file since 11637 was 11637, checked in by Kon Lovett, 12 years ago

Cosmetic changes

File size: 1.4 KB
Line 
1 ;;;; remote-mailbox-test.scm
2 
3 ;; The "server" MUST be started before the client!
4
5(use srfi-1 posix srfi-18)
6(use remote-mailbox mailbox miscmacros)
7
8(define-constant NUM-MSG 5)
9(define-constant RCV-NAM "Wong Foo")
10
11(define (client)
12  (print "* Client - Sending " NUM-MSG " messages")
13        (let ([rmb (get-remote-mailbox 'foo)])
14                (dotimes (n NUM-MSG)
15                        (printf "Sending message number ~A to ~A~%" n RCV-NAM)
16                        (remote-mailbox-send! rmb (list "to" RCV-NAM ":" n))
17                        ; Semblance of computation
18                        (thread-sleep! 1) )
19                (print "Send quit")
20                (remote-mailbox-send! rmb 'quit) ) )
21       
22(define (server)
23  (print "* Server - Receiving messages until 'quit")
24        (run-remote-mailbox-server)
25        (thread-start!
26                (lambda ()
27                        (let loop ([msg (mailbox-receive! (get-local-mailbox 'foo))])
28                                (print "Received " msg)
29                                (if (eq? 'quit msg)
30            (exit 0)
31            (loop (mailbox-receive! (get-local-mailbox 'foo))) ) ) ))
32        (thread-join! (run-remote-mailbox-server)) )
33
34(define operation
35        (let ([args (command-line-arguments)])
36                (and (pair? args)
37                     (string->symbol (car args))) ) )
38
39(if operation
40    (select operation
41      [('client)
42        (client)]
43      [('server)
44        (server)]
45      [else
46        (error 'remote-mailbox-test "Unrecognized operation: " operation) ] )
47    (let ([cmd (first (argv))])
48      (process-run cmd `("server"))
49      #;(sleep 1)
50      (process-execute cmd `("client")) ) )
Note: See TracBrowser for help on using the repository browser.