qa-message

#!/usr/bin/env 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