Basic tests

6 files changed, 121 insertions, 7 deletions

diff --git a/src/CoreBindings.kt b/src/CoreBindings.kt
index b344dc7..48ecdad 100644
--- a/src/CoreBindings.kt
+++ b/src/CoreBindings.kt
@@ -108,7 +108,7 @@ object CoreBindings {
         lastResult ?: context.reportError("Seq cannot be invoked with 0 argumens", callsite)
     }
 
-    private fun stringify(thing: LispData): String {
+    internal fun stringify(thing: LispData): String {
         return when (thing) {
             is LispData.Atom -> ":${thing.label}"
             is LispData.JavaExecutable -> "<native code>"
@@ -119,7 +119,6 @@ object CoreBindings {
             is LispData.LispNumber -> thing.value.toString()
             is LispData.LispInterpretedCallable -> "<function ${thing.name ?: "<anonymous>"} ${thing.argNames} ${thing.body.toSource()}>"
         }
-
     }
 
     val debuglog = LispData.externalRawCall { context, callsite, stackFrame, args ->
diff --git a/src/LispExecutionContext.kt b/src/LispExecutionContext.kt
index 181c06b..ed5c091 100644
--- a/src/LispExecutionContext.kt
+++ b/src/LispExecutionContext.kt
@@ -20,13 +20,25 @@ class LispExecutionContext() {
     fun setupStandardBindings() {
         CoreBindings.offerAllTo(rootStackFrame)
         registerModule("builtins", Builtins.builtinProgram)
+        modules["ntest"] = TestFramework.realizedTestModule
         importModule("builtins", rootStackFrame, object : HasLispPosition {
             override val position: LispPosition
                 get() = error("Builtin import failed")
-
         })
     }
 
+    fun runTests(
+        program: LispAst.Program,
+        stackFrame: StackFrame = genBindings(),
+        testList: List<String> = emptyList(),
+        isWhitelist: Boolean = false
+    ): TestFramework.TestSuite {
+        val testSuite = TestFramework.setup(stackFrame, testList, isWhitelist)
+        executeProgram(stackFrame, program)
+        return testSuite
+    }
+
+
     fun registerModule(moduleName: String, program: LispAst.Program) {
         if (moduleName in unloadedModules || moduleName in modules) {
             error("Cannot register already registered module $moduleName")
diff --git a/src/StackFrame.kt b/src/StackFrame.kt
index 66d74b2..9a0832f 100644
--- a/src/StackFrame.kt
+++ b/src/StackFrame.kt
@@ -9,7 +9,7 @@ class StackFrame(val parent: StackFrame?) {
     private val meta: MutableMap<MetaKey<*>, Any> = mutableMapOf()
 
     fun <T : Any> getMeta(key: MetaKey<T>): T? {
-        return meta[key] as? T
+        return meta[key]?.let { it as T } ?: parent?.meta?.get(key)?.let { it as T }
     }
 
     fun <T : Any> setMeta(key: MetaKey<T>, value: T) {
diff --git a/src/TestFramework.kt b/src/TestFramework.kt
new file mode 100644
index 0000000..8406a79
--- /dev/null
+++ b/src/TestFramework.kt
@@ -0,0 +1,91 @@
+package moe.nea.lisp
+
+object TestFramework {
+    data class TestFailure(
+        val callsite: LispAst,
+        val message: String,
+    )
+
+    data class TestResult(
+        val name: String,
+        val failures: List<TestFailure>,
+        val wasSkipped: Boolean,
+    )
+
+    data class TestSuite(
+        val name: String,
+        var isTesting: Boolean,
+        val allTests: MutableList<TestResult>,
+        val testList: List<String>,
+        val isWhitelist: Boolean,
+    )
+
+    data class ActiveTest(
+        val testName: String,
+        val currentFailures: MutableList<TestFailure>,
+        var canMultifail: Boolean,
+        val suite: TestSuite,
+    )
+
+    object TestSuiteMeta : StackFrame.MetaKey<TestSuite>
+    object ActiveTestMeta : StackFrame.MetaKey<ActiveTest>
+
+    val testBinding = LispData.externalRawCall { context, callsite, stackFrame, args ->
+        runTest(context, callsite, stackFrame, args)
+        return@externalRawCall LispData.LispNil
+    }
+
+    val failTestBinding = LispData.externalCall { args, reportError ->
+        val message = CoreBindings.stringify(args.singleOrNull() ?: return@externalCall reportError("Needs a message"))
+        LispData.externalRawCall { context, callsite, stackFrame, args ->
+            val activeTest = stackFrame.getMeta(ActiveTestMeta)
+                ?: return@externalRawCall context.reportError("No active test", callsite)
+            activeTest.currentFailures.add(TestFailure(callsite, message))
+            return@externalRawCall LispData.LispNil
+        }
+    }
+
+    val realizedTestModule = mapOf(
+        "ntest.test" to testBinding,
+        "ntest.fail" to failTestBinding,
+    )
+
+    fun runTest(
+        context: LispExecutionContext,
+        callsite: LispAst,
+        stackFrame: StackFrame,
+        args: List<LispAst.LispNode>
+    ) {
+        val meta = stackFrame.getMeta(TestSuiteMeta) ?: return
+        if (!meta.isTesting) return
+        if (args.size != 2) {
+            context.reportError("Test case needs to be defined by a name and an executable", callsite)
+            return
+        }
+        val (name, prog) = args
+        val testName = when (val n = context.resolveValue(stackFrame, name)) {
+            is LispData.Atom -> n.label
+            is LispData.LispString -> n.string
+            else -> {
+                context.reportError("Test case needs an atom or string as name", name)
+                return
+            }
+        }
+        if (testName in meta.testList != meta.isWhitelist) {
+            meta.allTests.add(TestResult(testName, listOf(), true))
+            return
+        }
+        val child = stackFrame.fork()
+        val test = ActiveTest(testName, mutableListOf(), false, meta)
+        child.setMeta(ActiveTestMeta, test)
+        context.resolveValue(child, prog)
+        meta.allTests.add(TestResult(test.testName, test.currentFailures, false))
+    }
+
+    fun setup(stackFrame: StackFrame, name: String, testList: List<String>, isWhitelist: Boolean): TestSuite {
+        val ts = TestSuite(name, true, mutableListOf(), testList, isWhitelist)
+        stackFrame.setMeta(TestSuiteMeta, ts)
+        ts.isTesting = false
+        return ts
+    }
+}
diff --git a/test/res/test.lisp b/test/res/test.lisp
index c4406b0..f3b870c 100644
--- a/test/res/test.lisp
+++ b/test/res/test.lisp
@@ -20,4 +20,13 @@
 (debuglog "============")
 (debuglog "This should fail" sc)
 (import :secondary)
-(debuglog "This should work" sc)
\ No newline at end of file
+(debuglog "This should work" sc)
+
+(debuglog "============")
+(debuglog "Running tests")
+(import :ntest)
+(ntest.test "Funny test" (seq
+    (debuglog "Funny test running")
+    (debuglog ((ntest.fail "Test failed")))))
+
+
diff --git a/test/src/TestLisp.kt b/test/src/TestLisp.kt
index 5563042..fa90468 100644
--- a/test/src/TestLisp.kt
+++ b/test/src/TestLisp.kt
@@ -8,7 +8,10 @@ fun main() {
     val otherP = LispParser.parse(File(T::class.java.getResource("/test.lisp")!!.file))
     val executionContext = LispExecutionContext()
     executionContext.setupStandardBindings()
-    executionContext.registerModule("secondary", LispParser.parse(File(T::class.java.getResource("/secondary.lisp")!!.file)))
+    executionContext.registerModule(
+        "secondary",
+        LispParser.parse(File(T::class.java.getResource("/secondary.lisp")!!.file))
+    )
     val bindings = executionContext.genBindings()
-    executionContext.executeProgram(bindings, otherP)
+    println("The results are in: ${executionContext.runTests(otherP, bindings)}")
 }