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
--- /dev/null
+#!/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
(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)))))
(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)
(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))))))
(defvar *self* nil)
(defun show (n)
- (format t "Showing: ~A~%" n))
+ (format t "Showing: ~A~%" (dump-object n)))
(defun create-turtle ()
(push
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)))))
(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~%~}"
(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")
(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)
(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)
; 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 ())
(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)
(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~}"
(defpackage #:cl-nl-test (:use :common-lisp :cl-nl)
- (:export :run-all-tests :run :diagnose-test))
+ (:export :run-all-tests :run :test-debug))
(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")
projects / clnl / commitdiff