136 lines
3.2 KiB
Plaintext
Executable File
136 lines
3.2 KiB
Plaintext
Executable File
#!/usr/bin/newlisp
|
|
|
|
(println)
|
|
(println "testing message API")
|
|
|
|
; qa-message, check send and receive functions
|
|
; child processes
|
|
|
|
(when (find ostype '("Windows"))
|
|
(println "qa-message runs only run on Unix - exit")
|
|
(exit)
|
|
)
|
|
|
|
(sleep 1000)
|
|
|
|
; --------------------------------- status update
|
|
(set 'N 100)
|
|
(set 'k 10)
|
|
|
|
(println k " child processes transmit " 100 " random status numbers")
|
|
|
|
(define (child-process N)
|
|
(set 'ppid (sys-info -4)) ; get parent pid
|
|
(set 'cpid (sys-info -3)) ; get this pid
|
|
(dotimes (i N)
|
|
(until (send ppid (random) ))
|
|
)
|
|
)
|
|
|
|
; parent starts k child processes, listens and displays
|
|
|
|
(dotimes (i k) (spawn 'result (child-process N) true))
|
|
|
|
(set 'start (time-of-day));
|
|
(set 'cnt 0)
|
|
(while (< cnt (* k N))
|
|
(dolist (cpid (receive)) ; iterate thru child pids
|
|
(receive cpid msg) (inc cnt)
|
|
)
|
|
)
|
|
|
|
(abort) ; cancel child-processes
|
|
|
|
(set 'ms (div (- (time-of-day) start) (* k N )))
|
|
(println ">>>>> Time per simple message: " (mul ms 1000) " micro seconds")
|
|
|
|
; --------------------------------- roundtrip test
|
|
(set 'N 10)
|
|
(set 'k 10)
|
|
|
|
(println)
|
|
(println N " round trips to " k " child processes")
|
|
(println "send out and receive it back uppercased with child pid appended")
|
|
|
|
(define (child-process , pid pppid msg)
|
|
(setq ppid (sys-info -4)) ; parent pid
|
|
(setq pid (sys-info -3)) ; this child pid
|
|
(while true
|
|
(until (receive ppid msg) )
|
|
(until (send ppid (upper-case (string msg "-" pid)))) )
|
|
)
|
|
|
|
(dotimes (i k)
|
|
(spawn 'r (child-process) true))
|
|
|
|
(set 'start (time-of-day))
|
|
(dotimes (i N)
|
|
(dolist (ch (sync))
|
|
(until (send ch "pid") ) ; send out message
|
|
(until (receive ch msg)) ; get response
|
|
(unless (= msg (string "PID-" ch)) ; check
|
|
(setq error-msg (append " >>>> ERROR in round trip test: " msg )))
|
|
)
|
|
)
|
|
|
|
(set 'ms (div (- (time-of-day) start) (* k N )))
|
|
(println ">>>>> Time per round trip : " (mul ms 1000) " micros seconds")
|
|
|
|
(abort) (sleep 100)
|
|
|
|
; --------------------------------- proxy test
|
|
(set 'N 100)
|
|
(println)
|
|
; proxy messageing A -> parent -> B
|
|
|
|
; sender child process of the message
|
|
(set 'A (spawn 'result
|
|
(begin
|
|
(dotimes (i N)
|
|
(set 'ppid (sys-info -4))
|
|
/* the following statement in msg will be evaluated in the proxy */
|
|
(set 'msg '(until (send B (string "greetings from " A))))
|
|
(until (send ppid msg)))
|
|
(until (send ppid '(begin
|
|
(println "parent exiting ...\n")
|
|
(set 'finished true))))
|
|
) true))
|
|
|
|
; receiver child process of the message
|
|
(set 'B (spawn 'result
|
|
(begin
|
|
(set 'ppid (sys-info -4))
|
|
(while true
|
|
(until (receive ppid msg))
|
|
(unless (= msg (string "greetings from " A))
|
|
(println ">>> ERROR in proxy message: " msg))
|
|
)
|
|
(println)
|
|
) true))
|
|
|
|
; parent functioning as a proxy evaluating messages or any other code
|
|
(println "A:" A "-> parent-proxy:" (sys-info -3) " -> B:" B "\n")
|
|
|
|
(sleep 200)
|
|
|
|
(set 'start (time-of-day))
|
|
; listen to messages from A
|
|
(until finished (if (receive A msg) (eval msg)))
|
|
|
|
(set 'ms (div (- (time-of-day) start) N))
|
|
(println ">>>>> Time per proxy trip: " (mul ms 1000) " micro seconds")
|
|
(println)
|
|
|
|
(sleep 300)
|
|
(abort)
|
|
(sleep 300)
|
|
|
|
(if error-msg
|
|
(println ">>>>> PROBLEM " error-msg)
|
|
(println ">>>>> Message API tested SUCCESSFUL"))
|
|
|
|
(exit)
|
|
|
|
;; eof
|
|
|