From: Frank Duncan <frank@kank.net>
Date: Tue, 9 Jun 2015 02:18:58 +0000 (-0500)
Subject: Added random-float and reporter tests
X-Git-Tag: v0.0.0~12
X-Git-Url: https://code.consxy.com/gitweb/gitweb.cgi?a=commitdiff_plain;h=d4ab333;p=clnl

Added random-float and reporter tests
---

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")