diff options
| -rw-r--r-- | src/CoreBindings.kt | 3 | ||||
| -rw-r--r-- | src/LispExecutionContext.kt | 14 | ||||
| -rw-r--r-- | src/StackFrame.kt | 2 | ||||
| -rw-r--r-- | src/TestFramework.kt | 91 | ||||
| -rw-r--r-- | test/res/test.lisp | 11 | ||||
| -rw-r--r-- | test/src/TestLisp.kt | 7 |
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)}") } |