diff --git a/ueforth/Makefile b/ueforth/Makefile index 106a2de..36a2a32 100644 --- a/ueforth/Makefile +++ b/ueforth/Makefile @@ -103,13 +103,16 @@ clean: # ---- TESTS ---- -tests: core_test +tests: core_test unit_tests core_test: $(POSIX)/ueforth common/core_test.fs \ common/core_test.fs.golden echo "include common/core_test.fs" | $< | \ diff - common/core_test.fs.golden +unit_tests: $(POSIX)/ueforth common/all_tests.fs + echo "include common/all_tests.fs" | $< + # ---- GENERATED ---- $(GEN): diff --git a/ueforth/common/all_tests.fs b/ueforth/common/all_tests.fs new file mode 100644 index 0000000..3a355e7 --- /dev/null +++ b/ueforth/common/all_tests.fs @@ -0,0 +1,3 @@ +include common/testing.fs +include common/base_tests.fs +run-tests diff --git a/ueforth/common/base_tests.fs b/ueforth/common/base_tests.fs new file mode 100644 index 0000000..5670aac --- /dev/null +++ b/ueforth/common/base_tests.fs @@ -0,0 +1,11 @@ +( Tests Base Operations ) +: test-empty-stack depth 0= assert ; +: test-add 123 111 + 234 = assert ; +: test-dup-depth 123 depth 1 = assert dup depth 2 = assert 2drop ; +: test-dup-values 456 dup 456 = assert 456 = assert ; +: test-2drop 123 456 2drop depth 0= assert ; +: test-nip 123 456 nip depth 1 = assert 456 = assert ; +: test-rdrop 111 >r 222 >r rdrop r> 111 = assert ; +: test-*/ 1000000 22 7 */ 3142857 = assert ; +: test-bl bl 32 = assert ; +: test-0= 123 0= 0= assert 0 0= assert ; diff --git a/ueforth/common/testing.fs b/ueforth/common/testing.fs new file mode 100644 index 0000000..d6883a5 --- /dev/null +++ b/ueforth/common/testing.fs @@ -0,0 +1,29 @@ +( Testing Framework ) +( run-tests runs all words starting with "test-", use assert to assert things. ) +variable tests-found variable tests-run variable tests-passed +: assert ( f -- ) 0= throw ; +: startswith? ( a n a n -- f ) + >r swap r@ < if rdrop 2drop 0 exit then + r> for aft 2dup c@ swap c@ <> if 2drop rdrop 0 exit then 1+ swap 1+ then next 2drop -1 ; +: test? ( xt -- f ) >name s" test-" startswith? ; +: for-tests ( xt -- ) + last @ begin dup while dup test? if 2dup >r >r swap execute r> r> then >link repeat 2drop ; +: reset-test-counters 0 tests-found ! 0 tests-run ! 0 tests-passed ! ; +: count-test ( xt -- ) drop 1 tests-found +! ; +: wrap-test ( xt -- ) depth 1 <> if ." depth leak! " 1 throw then execute depth 0= assert ; +: red 1 fg ; : green 2 fg ; : hr 40 for [char] - emit next cr ; +: run-test ( xt -- ) dup >name type ['] wrap-test catch + if red ." FAILED" normal cr else green ." OK" normal cr 1 tests-passed +! then 1 tests-run +! ; +: pre-test-run cr hr tests-found @ . ." Tests found." cr hr ; +: show-test-results + hr ." PASSED: " green tests-passed @ . normal ." RUN: " tests-run @ . + ." FOUND: " tests-found @ . cr + tests-passed @ tests-found @ = if + green ." ALL TESTS PASSED" normal cr + else + ." FAILED: " red tests-run @ tests-passed @ - . normal cr + then hr ; +: run-tests + reset-test-counters ['] count-test for-tests pre-test-run + ['] run-test for-tests show-test-results + tests-passed @ tests-found @ <> sysexit ;