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 : check-fresh depth if }confirm ." DEPTH LEAK! " depth . 1 throw then
fdepth if }confirm ." FDEPTH LEAK! " fdepth . 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 ; : 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 ; : red ; : green ; : replace-line cr ; : old-normal normal ; : normal ;
: replace-line 13 emit clear-to-eol ; 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 ; : label-test ( xt -- ) replace-line >name type ;
: run-test ( xt -- ) dup label-test only forth confirm{ ['] wrap-test catch }confirm : run-test ( xt -- ) dup label-test only forth confirm{ ['] wrap-test catch }confirm
if drop ( cause xt restored on throw ) red ." FAILED" normal cr if drop ( cause xt restored on throw ) red ." FAILED" normal cr

1
posix/posix.fs
View File

@ -53,6 +53,7 @@ z" free" 1 sysfunc sysfree
z" realloc" 2 sysfunc realloc z" realloc" 2 sysfunc realloc
z" usleep" 1 sysfunc usleep z" usleep" 1 sysfunc usleep
z" signal" 2 sysfunc signal z" signal" 2 sysfunc signal
z" isatty" 1 sysfunc isatty
( Processes ) ( Processes )
z" fork" 0 sysfunc fork z" fork" 0 sysfunc fork

4
windows/BUILD
View File

@ -23,7 +23,7 @@ Importation('gen/windows_boot_extra.h', '$src/windows/windows_boot_extra.fs',
# Compile Win32. # Compile Win32.
Alias('win32', ' '.join([ Alias('win32', ' '.join([
ForthTest('tests/win32_all_tests.out', 'windows/uEf32.exe', '$src/common/all_tests.fs', ForthTest('tests/win32_all_tests.out', 'windows/uEf32.exe', '$src/common/all_tests.fs',
interp='wine', pool='console'), interp='wine'),
])) ]))
CompileW32('windows/uEf32.obj', '$src/windows/main.c', CompileW32('windows/uEf32.obj', '$src/windows/main.c',
implicit=['gen/windows_boot.h', 'gen/windows_boot_extra.h']) implicit=['gen/windows_boot.h', 'gen/windows_boot_extra.h'])
@ -33,7 +33,7 @@ LinkW32('windows/uEf32.exe',
# Compile Win64. # Compile Win64.
Alias('win64', ' '.join([ Alias('win64', ' '.join([
ForthTest('tests/win64_all_tests.out', 'windows/uEf64.exe', '$src/common/all_tests.fs', ForthTest('tests/win64_all_tests.out', 'windows/uEf64.exe', '$src/common/all_tests.fs',
interp='wine', pool='console'), interp='wine'),
])) ]))
CompileW64('windows/uEf64.obj', '$src/windows/main.c', CompileW64('windows/uEf64.obj', '$src/windows/main.c',
implicit=['gen/windows_boot.h', 'gen/windows_boot_extra.h']) implicit=['gen/windows_boot.h', 'gen/windows_boot_extra.h'])