From d4ab3334d216c9963f9459d9e8870c6abafce8f1 Mon Sep 17 00:00:00 2001 From: Frank Duncan Date: Mon, 8 Jun 2015 21:18:58 -0500 Subject: [PATCH] Added random-float and reporter tests --- bin/diagnose-test | 20 +++++++---- bin/runreporter.scala | 38 +++++++++++++++++++++ src/main/lex.lisp | 6 ++-- src/main/main.lisp | 3 ++ src/main/nvm.lisp | 17 +++++---- src/main/package.lisp | 6 ++-- src/main/parse.lisp | 3 ++ src/main/transpile.lisp | 1 + src/test/main.lisp | 72 ++++++++++++++++++++++++--------------- src/test/package.lisp | 2 +- src/test/simpletests.lisp | 10 +++--- 11 files changed, 128 insertions(+), 50 deletions(-) create mode 100755 bin/runreporter.scala diff --git a/bin/diagnose-test b/bin/diagnose-test index 7744fe0..57fbf28 100755 --- a/bin/diagnose-test +++ b/bin/diagnose-test @@ -4,16 +4,24 @@ if ! [ -n "$1" ] ; then echo "Uhm, need a test name, yo" exit 1 fi -TEST=$1 +TEST=$@ sbcl --eval "(asdf:load-system :cl-nl-test)" --eval "(quit)" &> /dev/null -COMMANDS=$(sbcl --noinform --disable-ldb --lose-on-corruption --end-runtime-options --eval "(asdf:load-system :cl-nl-test)" --eval "(cl-nl-test::test-commands \"$1\")" --eval "(quit)" 2> /dev/null | sed -n '/^----$/,$p' | tail -n +2) -scalafile=$(mktemp -u -p .) -clfile=$(mktemp -u -p .) +runtestfn() { + sbcl --noinform --disable-ldb --lose-on-corruption --end-runtime-options \ + --eval "(asdf:load-system :cl-nl-test)" \ + --eval "(cl-nl-test::$1 \"$TEST\")" \ + --eval "(quit)" 2> /dev/null | sed -n '/^----$/,$p' | tail -n +2 +} -echo "$COMMANDS" | bin/runcmd.scala | sed -n '/^----$/,$p' | tail -n +2 > $scalafile -sbcl --noinform --disable-ldb --lose-on-corruption --end-runtime-options --eval "(asdf:load-system :cl-nl-test)" --eval "(cl-nl-test::diagnose-test \"$1\")" --eval "(quit)" 2> /dev/null | sed -n '/^----$/,$p' | tail -n +2 > $clfile +scalaprog=$(runtestfn "test-scala-prog") + +scalafile=$(mktemp -u -p . --suffix .scala.dat) +clfile=$(mktemp -u -p . --suffix .cl.dat) + +runtestfn "test-scala-input" | $scalaprog | sed -n '/^----$/,$p' | tail -n +2 > $scalafile +runtestfn "test-debug" >$clfile vimdiff $scalafile $clfile diff --git a/bin/runreporter.scala b/bin/runreporter.scala new file mode 100755 index 0000000..f0e35e1 --- /dev/null +++ b/bin/runreporter.scala @@ -0,0 +1,38 @@ +#!/bin/sh +exec scalas "$0" -q "$@" +!# + +/*** + logLevel := Level.Error + + logLevel in Global := Level.Error + + scalaVersion := "2.10.3" + + libraryDependencies ++= Seq( + "asm" % "asm-all" % "3.3.1", + "org.picocontainer" % "picocontainer" % "2.13.6", + "org.nlogo" % "NetLogo" % "6.0.0-M3" from "http://ccl.northwestern.edu/devel/6.0.0-M3/NetLogo.jar", + "org.nlogo" % "NetLogoHeadless" % "6.0.0-M3" from "http://ccl.northwestern.edu/devel/6.0.0-M3/NetLogoHeadless.jar" + ) +*/ + +import org.nlogo.headless.HeadlessWorkspace +import org.nlogo.mirror +import org.nlogo.api +import org.nlogo.nvm +import org.nlogo.util.Utils.url2String + +System.out.println("----") +val workspace = HeadlessWorkspace.newInstance +workspace.silent = true +workspace.openFromSource(url2String("file:resources/empty.nlogo")) + +val reporter = io.Source.stdin.getLines.mkString("\n") + +workspace.mainRNG.setSeed(15) +System.out.println(org.nlogo.api.Dump.logoObject(workspace.runCompiledReporter(new api.SimpleJobOwner("test", workspace.world.mainRNG, api.AgentKind.Observer), workspace.compileReporter(reporter)))) + +workspace.world.exportWorld(new java.io.PrintWriter(System.out, true), true) +System.out.println(org.nlogo.headless.Checksummer.calculateChecksum(workspace.world.exportWorld(_, true))) +workspace.dispose diff --git a/src/main/lex.lisp b/src/main/lex.lisp index 93343e6..c7f082f 100644 --- a/src/main/lex.lisp +++ b/src/main/lex.lisp @@ -33,10 +33,10 @@ (defun lex (text) (if (string= "" text) (let - ((lex (find-if (lambda (f) (funcall f *state* :eof)) *lexes* :key #'car))) + ((lex (find-if (lambda (f) (funcall f *state* :eof)) *lexes* :from-end t :key #'car))) (when lex (list (funcall (third lex) :eof)))) (let - ((lex (find-if (lambda (f) (funcall f *state* text)) *lexes* :key #'car))) + ((lex (find-if (lambda (f) (funcall f *state* text)) *lexes* :from-end t :key #'car))) (when (not lex) (error "Can't lex this: ~S" text)) (let ((val (funcall (third lex) (subseq text 0 (funcall (cadr lex) text))))) @@ -54,7 +54,7 @@ (defvar *letter* "\\w") (defvar *digit* "\\d") ;(defparameter *identifier-char* "[\\w\\d_\\.?=\*!<>:#\+/%\$\^\'&-]") -(defvar *identifier-char* "[\\w\\d]") +(defvar *identifier-char* "[\\w\\d-.]") ;(defvar *extension-literal-depth* 0) ;(defstruct extension-literal text) diff --git a/src/main/main.lisp b/src/main/main.lisp index 00107fa..35cb2f7 100644 --- a/src/main/main.lisp +++ b/src/main/main.lisp @@ -23,3 +23,6 @@ (defun run-commands (cmds) (eval (cl-nl.transpiler:transpile-commands (cl-nl.parser:parse (cl-nl.lexer:lex cmds))))) + +(defun run-reporter (reporter) + (eval (cl-nl.transpiler:transpile-reporter (car (cl-nl.parser:parse (cl-nl.lexer:lex reporter)))))) diff --git a/src/main/nvm.lisp b/src/main/nvm.lisp index 091bfe4..c203ebe 100644 --- a/src/main/nvm.lisp +++ b/src/main/nvm.lisp @@ -10,7 +10,7 @@ (defvar *self* nil) (defun show (n) - (format t "Showing: ~A~%" n)) + (format t "Showing: ~A~%" (dump-object n))) (defun create-turtle () (push @@ -44,6 +44,9 @@ collect next) (last copy)))) +(defun random-float (n) + (cl-nl.random:next-double n)) + (defun fd (n) (when (not (turtle-p *self*)) (error "Gotta call fd in turtle scope, dude")) (setf (turtle-xcor *self*) (+ (turtle-xcor *self*) (sin (* pi (/ (turtle-heading *self*) 180))))) @@ -56,11 +59,13 @@ (setf *turtles* nil) (setf *current-id* 0)) -(defun format-num (n) +(defgeneric dump-object (o)) +(defmethod dump-object ((n double-float)) (multiple-value-bind (int rem) (floor n) (if (eql 0d0 rem) (format nil "~A" int) (format nil "~F" n)))) +(defmethod dump-object ((o string)) o) (defun export-world () (format nil "~{~A~%~}" @@ -80,10 +85,10 @@ (format nil "\"~A\",\"~A\",\"~A\",\"~A\",\"~A\",\"\"\"default\"\"\",\"\"\"\"\"\",\"9.9\",\"{all-turtles}\",\"false\",\"1\",\"1\",\"\"\"up\"\"\"" (turtle-who turtle) - (format-num (turtle-color turtle)) - (format-num (turtle-heading turtle)) - (format-num (turtle-xcor turtle)) - (format-num (turtle-ycor turtle)) + (dump-object (turtle-color turtle)) + (dump-object (turtle-heading turtle)) + (dump-object (turtle-xcor turtle)) + (dump-object (turtle-ycor turtle)) )) (reverse *turtles*))) (format nil "~S" "PATCHES") diff --git a/src/main/package.lisp b/src/main/package.lisp index a6ca2df..cde6c07 100644 --- a/src/main/package.lisp +++ b/src/main/package.lisp @@ -1,5 +1,5 @@ (defpackage #:cl-nl (:use :common-lisp) - (:export :run :boot :run-commands)) + (:export :run :boot :run-commands :run-reporter)) (defpackage #:cl-nl.parser (:use :common-lisp) @@ -12,11 +12,11 @@ (defpackage #:cl-nl.transpiler (:use :common-lisp) - (:export :transpile-commands)) + (:export :transpile-commands :transpile-reporter)) (defpackage #:cl-nl.nvm (:use :common-lisp) - (:export :export-world :create-world)) + (:export :export-world :create-world :dump-object)) (defpackage #:cl-nl.lexer (:use :common-lisp) diff --git a/src/main/parse.lisp b/src/main/parse.lisp index a88d833..65200d3 100644 --- a/src/main/parse.lisp +++ b/src/main/parse.lisp @@ -83,9 +83,12 @@ ; This list of prims will get combined with the mapping to actual code later ; Current list of argument types we accept: ; - :number +; - :agentset +; - :command-block ; - t - any type (defprim :ask (:agentset :command-block)) (defprim :crt (:number)) (defprim :fd (:number)) +(defprim :random-float (:number)) (defprim :show (t)) (defprim :turtles ()) diff --git a/src/main/transpile.lisp b/src/main/transpile.lisp index a9cf77b..db31840 100644 --- a/src/main/transpile.lisp +++ b/src/main/transpile.lisp @@ -54,5 +54,6 @@ (defprim :ask :command cl-nl.nvm::ask) (defprim :crt :command cl-nl.nvm::create-turtles) (defprim :fd :command cl-nl.nvm::fd) +(defprim :random-float :reporter cl-nl.nvm::random-float) (defprim :show :command cl-nl.nvm::show) (defprim :turtles :reporter cl-nl.nvm::turtles) diff --git a/src/test/main.lisp b/src/test/main.lisp index dbcbd58..4c375c6 100644 --- a/src/test/main.lisp +++ b/src/test/main.lisp @@ -25,38 +25,56 @@ (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 find-test (name) + (or + (find name *tests* :test #'string= :key #'car) + (error "Couldn't find test with name: ~A" name))) -(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 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)))) -(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))))) - -; 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*))) + +; 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 + ,name + (lambda () + (cl-nl:boot) + (cl-nl:run-commands ,commands) + (string= ,checksum (checksum-world))) + (lambda () + (cl-nl:boot) + (cl-nl:run-commands ,commands) + (format nil "~A~A" + (cl-nl.nvm:export-world) + (checksum-world))) + "bin/runcmd.scala" + (format nil "~A~%" ,commands))) + +(defmacro defsimplereportertest (name reporter value checksum) + `(defsimpletest + ,name + (lambda () + (cl-nl:boot) + (and + (string= (cl-nl.nvm:dump-object (cl-nl:run-reporter ,reporter)) ,value) + (string= ,checksum (checksum-world)))) + (lambda () + (cl-nl:boot) + (format nil "~A~%~A~A" + (cl-nl.nvm:dump-object (cl-nl:run-reporter ,reporter)) + (cl-nl.nvm:export-world) + (checksum-world))) + "bin/runreporter.scala" + (format nil "~A~%" ,reporter))) (defun checksum-world () (format nil "~{~2,'0X~}" diff --git a/src/test/package.lisp b/src/test/package.lisp index 3dfefe7..316d07d 100644 --- a/src/test/package.lisp +++ b/src/test/package.lisp @@ -1,2 +1,2 @@ (defpackage #:cl-nl-test (:use :common-lisp :cl-nl) - (:export :run-all-tests :run :diagnose-test)) + (:export :run-all-tests :run :test-debug)) diff --git a/src/test/simpletests.lisp b/src/test/simpletests.lisp index cb7bbed..41c91ed 100644 --- a/src/test/simpletests.lisp +++ b/src/test/simpletests.lisp @@ -1,6 +1,8 @@ (in-package #:cl-nl-test) -(defsimpletest "Nothing" "" "E1DE30F072D785E0D0B59F28B0F7853E3D3E0D8B") -(defsimpletest "Simple crt" "crt 1" "2F08B31AC06C9D5339E6B3E953C2B4B71FDB9CDE") -(defsimpletest "Simple crt 2" "crt 5" "9FE588C2749CD9CE66CB0EA451EFB80476E881FB") -(defsimpletest "Simple crt and fd" "crt 5 ask turtles [ fd 1 ]" "BEB43404EDC7852985A9A7FC312481785FE553A0") +(defsimplecommandtest "Nothing" "" "E1DE30F072D785E0D0B59F28B0F7853E3D3E0D8B") +(defsimplecommandtest "Simple crt" "crt 1" "2F08B31AC06C9D5339E6B3E953C2B4B71FDB9CDE") +(defsimplecommandtest "Simple crt 2" "crt 5" "9FE588C2749CD9CE66CB0EA451EFB80476E881FB") +(defsimplecommandtest "Simple crt and fd" "crt 5 ask turtles [ fd 1 ]" "BEB43404EDC7852985A9A7FC312481785FE553A0") + +(defsimplereportertest "Random 1" "random-float 5" "4.244088516651127" "17D1BF7FF7BF2C7F3F5F7DD7CF67CFF2772CFFFC") -- 2.25.1