UI/Model Parse - Sliders - WIP

[clnl] / src / test / main.lisp

diff --git a/src/test/main.lisp b/src/test/main.lisp
index e02a5d45dc20bb234703ae90172f825fe0e98a47..6d3282d6a28cf22d40368708054c6c5810b909c1 100644 (file)
--- a/src/test/main.lisp
+++ b/src/test/main.lisp
@@ -35,6 +35,9 @@
 (defun test-scala-prog (name) (format t "----~%~A~%" (fourth (find-test name))))
 (defun test-scala-input (name) (format t "----~%~A~%" (fifth (find-test name))))
 
+(defun clnl-commands (commands) (if (listp commands) (car commands) commands))
+(defun scala-commands (commands) (if (listp commands) (cadr commands) commands))
+
 (defmacro defsimpletest (name test-fn debug-fn scala-prog scala-input)
  `(progn
    ;(when (find-test ,name) (error "Test with name ~S already exists, abort, abort" ,name))
@@ -166,6 +169,59 @@ 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))
 
+(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 ()
+    (let
+     ((model (with-open-file (str ,file) (clnl-model:read-from-nlogo str))))
+     (and
+      (let
+       ((callback nil))
+       (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)))
+        (clnl:*model-package* pkg)
+        (prev-package *package*))
+       (eval
+        (cons
+         'progn
+         (clnl:model->multi-form-lisp model (intern "BOOT-ME" pkg)
+          :netlogo-callback-fn (intern "NETLOGO-CALLBACK" pkg))))
+       (eval `(in-package ,(package-name prev-package)))
+       (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
+     ((callback nil))
+     (declaim (sb-ext:muffle-conditions cl:warning))
+     (eval
+      (clnl:model->single-form-lisp
+       (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))))
+   "bin/runcmd.scala"
+   (format nil "~A@#$#@#$#@@#$#@#$#@@#$#@#$#@~A" ,(scala-commands commands) ,file)))
+
 (defmacro defviewtest (name commands checksum)
  `(defsimpletest
    (format nil "Simple View - ~A" ,name)
@@ -220,4 +276,9 @@ GRAPHICS-WINDOW~%210~%10~%649~%470~%-1~%-1~%13.0~%1~%10~%1~%1~%1~%0~%1~%1~%1~%-1
  (loop
   :for str := (progn (format t "> ") (force-output) (read-line))
   :while str
-  :do (progn (asdf:load-system :clnl-test) (run-tests-matching str))))
+  :do
+  (handler-case
+   (progn
+    (asdf:load-system :clnl-test)
+    (run-tests-matching str))
+   (error (e) (format t "Ok, something went wrong: ~A~%" e)))))