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

Adding more tests.

Browse Source 
Still a mystery why stack leaks happen on failed tests.
This commit is contained in:
Brad Nelson
2021-01-31 23:13:09 -08:00
parent 43364e3699
commit 42b3ae71f9
3 changed files with 22 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

19
ueforth/common/base_tests.fs
View File

@ -5,7 +5,26 @@
: 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 ;
: 8throw 8 throw ;
: test-catch ['] 8throw catch 8 = assert depth 0= assert ;
: throw-layer 456 >r 123 123 123 8throw 123 123 123 r> ;
: test-catch2 9 ['] throw-layer catch 8 = assert 9 = assert depth 0= 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 ;
: test-cells 123 cells cell+ cell/ 124 = assert ;
: test-aligned 127 aligned 128 = assert ;
: test-[char] [char] * 42 = assert ;
2 3 * 4 * 5 * 6 * 7 * 8 * 9 * 10 * 11 * 12 * constant 2-12*
: test-fornext 1 10 for r@ 2 + * next 2-12* = assert ;
: test-foraft 1 11 for aft r@ 2 + * then next 2-12* = assert ;
: test-doloop 1 13 2 do i * loop 2-12* = assert ;
: inc-times ( a n -- a+n ) 0 ?do 1+ loop ;
: test-?do 123 40 inc-times 163 = assert ;
: test-?do2 123 0 inc-times 123 = assert ;
: test-<> 123 456 <> assert ;
: test-<>2 123 123 <> 0= assert ;
: inc/2-times ( a n -- a+n/2 ) 0 ?do 1+ 2 +loop ;
: test-+loop 123 0 inc/2-times 123 = assert ;
: test-+loop2 123 6 inc/2-times 126 = assert ;

2
ueforth/common/boot.fs
View File

@ -124,7 +124,7 @@ variable handler
: catch ( xt -- n )
sp@ >r handler @ >r rp@ handler ! execute r> handler ! r> drop 0 ;
: throw ( n -- )
dup if handler @ rp! r> handler ! r> swap >r sp! drop r> else drop then ;
dup if handler @ rp! r> handler ! r> swap >r sp! drop r> else drop then ;
' throw 'notfound !
( Values )

3
ueforth/common/testing.fs
View File

@ -10,7 +10,8 @@ variable tests-found variable tests-run variable tests-passed
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 ;
: check-fresh depth if ." DEPTH LEAK! " depth . 1 throw then ;
: wrap-test ( xt -- ) >r check-fresh r> execute check-fresh ;
: 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 +! ;