X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?a=blobdiff_plain;f=src%2Ftest%2Fmain.lisp;h=99dfe184a59cdfeb6be718bd0003cc3cc9adf8e6;hb=b018550f2029475c8bececad3c6658048c8c80f0;hp=dbcbd58529cb8b0c45ee6c09eef384c22c0d1982;hpb=4a9ed570e6d2c79ac7cac0a6a84d414ee658cd3e;p=clnl diff --git a/src/test/main.lisp b/src/test/main.lisp index dbcbd58..99dfe18 100644 --- a/src/test/main.lisp +++ b/src/test/main.lisp @@ -1,4 +1,4 @@ -(in-package #:cl-nl-test) +(in-package #:clnl-test) (defparameter *tests* nil) @@ -13,59 +13,146 @@ (defun run-tests (tests) (let ((final-result t)) - (loop for test in tests - for result = (run-and-print-test test) - do (setf final-result (and final-result result))) + (loop + :for test :in tests + :for result := (run-and-print-test test) + :do (setf final-result (and final-result result))) final-result)) (defun run-all-tests () - (format t "~%Here we goooooooo~%") (run-tests (reverse *tests*))) - -(defun run-tests-matching (match) - (run-tests (remove-if-not (lambda (test-name) (cl-ppcre:scan (format nil "^~A$" match) test-name)) *tests* :key #'car))) -(defun find-test (name) (find name *tests* :test #'string= :key #'car)) +(defun run-tests-matching (match) + (run-tests + (remove-if-not (lambda (test-name) (cl-ppcre:scan (format nil "^~A$" match) test-name)) *tests* :key #'car))) -(defun diagnose-test (name) - (when (not (find-test name)) (error "Couldn't find test with name: ~A" name)) - (format t "----~%~A~%" (funcall (caddr (find-test name))))) +(defun find-test (name) + (or + (find name *tests* :test #'string= :key #'car) + (error "Couldn't find test with name: ~A" name))) -(defun test-commands (name) - (let - ((test (find-test name))) - (when (not test) (error "Couldn't find test with name: ~A" name)) - (format t "----~%") - (format t "~A~%" (funcall (fourth test))))) +(defun test-debug (name) (format t "----~%~A~%" (funcall (third (find-test name))))) +(defun test-scala-prog (name) (format t "----~%~A~%" (fourth (find-test name)))) +(defun test-scala-input (name) (format t "----~%~A~%" (fifth (find-test name)))) -; To be used only with the simplest of tests, just a list of commands and a checksum of the -; world after they've been run. -(defmacro defsimpletest (name commands checksum) +(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)) (push - (list - ,name - (lambda () - (cl-nl:boot) - (cl-nl:run-commands ,commands) - (string= ,checksum (checksum-world))) - (lambda () - (cl-nl:boot) - (cl-nl:run-commands ,commands) - (cl-nl.nvm:export-world) - ) - (lambda () ,commands)) - *tests*))) + (list ,name ,test-fn ,debug-fn ,scala-prog ,scala-input) + *tests*))) + +(defun checksum= (expected got) + (if (stringp expected) + (string= got expected) + (find got expected :test #'string=))) + +; To be used only with the simplest of tests, just a list of commands and a checksum of the +; world after they've been run. +(defmacro defsimplecommandtest (name commands checksum) + `(defsimpletest + (format nil "Simple Command - ~A" ,name) + (lambda () + (clnl:boot "resources/empty.nlogo") + (clnl:run-commands ,commands) + (checksum= ,checksum (checksum-world))) + (lambda () + (clnl:boot "resources/empty.nlogo") + (clnl:run-commands ,commands) + (format nil "~A~A" + (clnl-nvm:export-world) + (checksum-world))) + "bin/runcmd.scala" + (format nil "~A~%" ,commands))) + +(defmacro defsimplereportertest (name reporter value checksum) + `(defsimpletest + (format nil "Simple Reporter - ~A" ,name) + (lambda () + (clnl:boot "resources/empty.nlogo") + (and + (string= (funcall (intern "DUMP-OBJECT" :clnl-nvm) (clnl:run-reporter ,reporter)) ,value) + (checksum= ,checksum (checksum-world)))) + (lambda () + (clnl:boot "resources/empty.nlogo") + (format nil "~A~%~A~A" + (funcall (intern "DUMP-OBJECT" :clnl-nvm) (clnl:run-reporter ,reporter)) + (clnl-nvm:export-world) + (checksum-world))) + "bin/runcmd.scala" + (format nil "~%@#$#@#$#@~A~%" ,reporter))) + +(defmacro defreportertestwithsetup (name setup reporter value checksum) + `(defsimpletest + (format nil "Reporter With Setup - ~A" ,name) + (lambda () + (clnl:boot "resources/empty.nlogo") + (clnl:run-commands ,setup) + (and + (string= (funcall (intern "DUMP-OBJECT" :clnl-nvm) (clnl:run-reporter ,reporter)) ,value) + (checksum= ,checksum (checksum-world)))) + (lambda () + (clnl:boot "resources/empty.nlogo") + (clnl:run-commands ,setup) + (format nil "~A~%~A~A" + (funcall (intern "DUMP-OBJECT" :clnl-nvm) (clnl:run-reporter ,reporter)) + (clnl-nvm:export-world) + (checksum-world))) + "bin/runcmd.scala" + (format nil "~A~%@#$#@#$#@~A" ,setup ,reporter))) + +(defmacro defviewtest (name commands checksum) + `(defsimpletest + (format nil "Simple View - ~A" ,name) + (lambda () + (clnl:boot "resources/empty55.nlogo") + (clnl:run-commands ,commands) + (let + ((viewsum (checksum-view))) + (when (not (checksum= ,checksum viewsum)) + (format t "~c[1;35m-- For ~A, got ~A but expected ~A~c[0m~%" #\Esc ,name viewsum ,checksum #\Esc)) + (checksum= ,checksum (checksum-view)))) + (lambda () + (clnl:boot "resources/empty55.nlogo") + (clnl:run-commands ,commands) + (save-view-to-ppm) + (format nil "~A" (checksum-view))) + "" + (format nil "~A~%" ,commands))) (defun checksum-world () (format nil "~{~2,'0X~}" (map 'list #'identity (ironclad:digest-sequence :sha1 - (map '(vector (unsigned-byte 8)) #'char-code (cl-nl.nvm:export-world)))))) + (map '(vector (unsigned-byte 8)) #'char-code (clnl-nvm:export-world)))))) + +(defun checksum-view () + (format nil "~{~2,'0X~}" + (map 'list #'identity + (ironclad:digest-sequence :sha1 (coerce (clnl-interface:export-view) '(vector (unsigned-byte 8))))))) + +(defun save-view-to-ppm () + (let + ((height 143) (width 143)) ; hardcoded in interface, hardcoded here, cry for me + (with-open-file (str "cl.ppm" + :direction :output + :if-exists :supersede + :if-does-not-exist :create + :element-type '(unsigned-byte 8)) + (write-sequence (map 'vector #'char-code (format nil "P6~%")) str) + (write-sequence (map 'vector #'char-code (format nil "143 143~%")) str) + (write-sequence (map 'vector #'char-code (format nil "255~%")) str) + (let + ((image-data (clnl-interface:export-view))) + (dotimes (i width) + (dotimes (j height) + (write-byte (aref image-data (+ 0 (* 4 (+ (* (- (1- height) i) width) j)))) str) + (write-byte (aref image-data (+ 1 (* 4 (+ (* (- (1- height) i) width) j)))) str) + (write-byte (aref image-data (+ 2 (* 4 (+ (* (- (1- height) i) width) j)))) str))))))) (defun run () - (loop for str = (progn (format t "> ") (force-output) (read-line)) - while str - do (progn (asdf:load-system :cl-nl-test) (run-tests-matching str)))) + (loop + :for str := (progn (format t "> ") (force-output) (read-line)) + :while str + :do (progn (asdf:load-system :clnl-test) (run-tests-matching str))))