alx/ueforth
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Adding unit tests.

Browse Source
This commit is contained in:
Brad Nelson
2021-01-31 21:58:43 -08:00
parent 778bc96c3a
commit 43364e3699
4 changed files with 47 additions and 1 deletions
Download Patch File Download Diff File Expand all files Collapse all files

5
ueforth/Makefile
View File

@ -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):

3
ueforth/common/all_tests.fs Normal file
View File

@ -0,0 +1,3 @@
include common/testing.fs
include common/base_tests.fs
run-tests

11
ueforth/common/base_tests.fs Normal file
View File

@ -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 ;

29
ueforth/common/testing.fs Normal file
View File

@ -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 ;