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

Refine.

Browse Source
This commit is contained in:
Brad Nelson
2023-12-31 23:00:11 -08:00
parent 311a2d88f0
commit b8f4a7b3c4
3 changed files with 17 additions and 4 deletions
Download Patch File Download Diff File Expand all files Collapse all files

16
common/testing.fs
View File

@ -87,8 +87,20 @@ variable tests-found variable tests-run variable tests-passed
: check-fresh depth if }confirm ." DEPTH LEAK! " depth . 1 throw then
fdepth if }confirm ." FDEPTH LEAK! " fdepth . 1 throw then ;
: wrap-test ( xt -- ) expect-reset >r check-fresh r> execute check-fresh expect-finish ;
: red 1 fg ; : green 2 fg ; : hr 40 for [char] - emit next cr ;
: replace-line 13 emit clear-to-eol ;
: red ; : green ; : replace-line cr ; : old-normal normal ; : normal ;
DEFINED? posix [IF]
also posix stdout isatty previous [IF]
: red 1 fg ; : green 2 fg ;
: replace-line 13 emit clear-to-eol ;
: normal old-normal ;
[THEN]
[THEN]
DEFINED? windows [IF]
: red 1 fg ; : green 2 fg ;
: replace-line 13 emit clear-to-eol ;
: normal old-normal ;
[THEN]
: hr 40 for [char] - emit next cr ;
: label-test ( xt -- ) replace-line >name type ;
: run-test ( xt -- ) dup label-test only forth confirm{ ['] wrap-test catch }confirm
if drop ( cause xt restored on throw ) red ." FAILED" normal cr