X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?p=clnl;a=blobdiff_plain;f=src%2Ftest%2Fmain.lisp;h=6d3282d6a28cf22d40368708054c6c5810b909c1;hp=a62cd60f7433abd08019d77e4ee49daf3be7ade2;hb=89cb3482de1fefc2d8e5f67e1e04a0790e8cd243;hpb=bb7b48443976f5cea04f5dd1c9bac64659d0a2c7 diff --git a/src/test/main.lisp b/src/test/main.lisp index a62cd60..6d3282d 100644 --- a/src/test/main.lisp +++ b/src/test/main.lisp @@ -169,7 +169,15 @@ GRAPHICS-WINDOW~%210~%10~%649~%470~%-1~%-1~%13.0~%1~%10~%1~%1~%1~%0~%1~%1~%1~%-1 (defmacro defmodelreportertest (name model commands reporter value checksum) `(defmodeltest (format nil "Model Reporter - ~A" ,name) ,model ,commands ,reporter ,value ,checksum)) -(defmacro defmodelfiletest (name file commands checksum) +(defun wait-for-forever () + (loop + :while + (find-if + (lambda (name) (cl-ppcre:scan "Forever button:" name)) + (mapcar #'sb-thread:thread-name (sb-thread:list-all-threads))) + :do (sleep .1))) + +(defmacro defmodelfiletest (name file commands checksum &optional wait-for-forever) `(defsimpletest ,(format nil "File Model - ~A" name) (lambda () @@ -181,6 +189,7 @@ GRAPHICS-WINDOW~%210~%10~%649~%470~%-1~%-1~%13.0~%1~%10~%1~%1~%1~%0~%1~%1~%1~%-1 (declaim (sb-ext:muffle-conditions cl:warning)) (eval (clnl:model->single-form-lisp model :netlogo-callback (lambda (f) (setf callback f)))) (when ,(clnl-commands commands) (funcall callback ,(clnl-commands commands))) + ,(when wait-for-forever `(wait-for-forever)) (checksum= ,checksum (checksum-world))) (let* ((pkg (make-package (gensym))) @@ -195,6 +204,7 @@ GRAPHICS-WINDOW~%210~%10~%649~%470~%-1~%-1~%13.0~%1~%10~%1~%1~%1~%0~%1~%1~%1~%-1 (funcall (symbol-function (intern "BOOT-ME" pkg))) (when ,(clnl-commands commands) (funcall (symbol-function (intern "NETLOGO-CALLBACK" pkg)) ,(clnl-commands commands))) + ,(when wait-for-forever `(wait-for-forever)) (checksum= ,checksum (checksum-world)))))) (lambda () (let @@ -205,6 +215,7 @@ GRAPHICS-WINDOW~%210~%10~%649~%470~%-1~%-1~%13.0~%1~%10~%1~%1~%1~%0~%1~%1~%1~%-1 (with-open-file (str ,file) (clnl-model:read-from-nlogo str)) :netlogo-callback (lambda (f) (setf callback f)))) (when ,(clnl-commands commands) (funcall callback ,(clnl-commands commands))) + ,(when wait-for-forever `(wait-for-forever)) (format nil "~A~A" (clnl-nvm:export-world) (checksum-world))))