mirror of
https://github.com/nineties/planckforth
synced 2024-12-27 21:58:35 +01:00
79 lines
2.2 KiB
Forth
79 lines
2.2 KiB
Forth
|
\ planckforth -
|
||
|
|
\ Copyright (C) 2021 nineties
|
||
|
|
|
||
|
|
\ test/tester.fs and test codes are base on
|
||
|
|
\ https://github.com/gerryjackson/forth2012-test-suite
|
||
|
|
|
||
|
|
decimal
|
||
|
|
|
||
|
|
variable total-errors
|
||
|
|
|
||
|
|
: error-count ( "name" n1 -- n2 ) \ n2 = n1 + 1cell
|
||
|
|
create dup , cell+
|
||
|
|
does> ( -- offset ) @ \ offset in address units
|
||
|
|
;
|
||
|
|
|
||
|
|
0 \ Offset into errors[] array
|
||
|
|
error-count core-errors error-count core-ext-errors
|
||
|
|
error-count double-errors error-count exception-errors
|
||
|
|
error-count facility-errors error-count file-errors
|
||
|
|
error-count locals-errors error-count memory-errors
|
||
|
|
error-count searchorder-errors error-count string-errors
|
||
|
|
error-count tools-errors error-count block-errors
|
||
|
|
create errors[] dup allot constant #error-counts
|
||
|
|
|
||
|
|
\ set-error-count called at the end of each test file with its own offset into
|
||
|
|
\ the errors[] array. #error is in files tester.fr and ttester.fs
|
||
|
|
|
||
|
|
: set-error-count ( offset -- )
|
||
|
|
#error @ swap errors[] + !
|
||
|
|
#error @ total-errors +!
|
||
|
|
0 #error !
|
||
|
|
;
|
||
|
|
|
||
|
|
: init-errors ( -- )
|
||
|
|
errors[] #error-counts over + swap do -1 i ! 1 cells +loop
|
||
|
|
0 total-errors !
|
||
|
|
core-errors set-error-count
|
||
|
|
;
|
||
|
|
|
||
|
|
init-errors
|
||
|
|
|
||
|
|
\ Report summary of errors
|
||
|
|
|
||
|
|
25 constant margin
|
||
|
|
|
||
|
|
: show-error-line ( n caddr -- )
|
||
|
|
cr dup strlen swap type margin - abs >r
|
||
|
|
dup -1 = if drop r> 1- spaces ." -" else
|
||
|
|
r> .r then
|
||
|
|
;
|
||
|
|
|
||
|
|
: show-error-count ( caddr offset -- )
|
||
|
|
errors[] + @ swap show-error-line
|
||
|
|
;
|
||
|
|
|
||
|
|
: hline ( -- ) cr ." ---------------------------" ;
|
||
|
|
|
||
|
|
: report-errors
|
||
|
|
hline
|
||
|
|
cr 8 spaces ." Error Report"
|
||
|
|
cr ." Word Set" 13 spaces ." Errors"
|
||
|
|
hline
|
||
|
|
s" Core" core-errors show-error-count
|
||
|
|
s" Core extension" core-ext-errors show-error-count
|
||
|
|
s" Block" block-errors show-error-count
|
||
|
|
s" Double number" double-errors show-error-count
|
||
|
|
s" Exception" exception-errors show-error-count
|
||
|
|
s" Facility" facility-errors show-error-count
|
||
|
|
s" File-access" file-errors show-error-count
|
||
|
|
s" Locals" locals-errors show-error-count
|
||
|
|
s" Memory-allocation" memory-errors show-error-count
|
||
|
|
s" Programming-tools" tools-errors show-error-count
|
||
|
|
s" Search-order" searchorder-errors show-error-count
|
||
|
|
s" String" string-errors show-error-count
|
||
|
|
hline
|
||
|
|
total-errors @ s" Total" show-error-line
|
||
|
|
hline cr cr
|
||
|
|
;
|