mirror of
https://github.com/forth-ev/VolksForth.git
synced 2024-07-10 05:29:03 +00:00
9a568b3a03
Names are adapted to DOS 8.3 file names, PETSCII adaptions of core.fth are reverted (DOS uses ASCII), the input test is disabled, since no way was yet found to inject keystrokes into dosbox. And some tweaks were applied to ans-shim.fth and the golden files to make the first tests (preliminary & core) to pass.
234 lines
9.3 KiB
Forth
234 lines
9.3 KiB
Forth
CR CR SOURCE TYPE ( Preliminary test ) CR
|
|
SOURCE ( These lines test SOURCE, TYPE, CR and parenthetic comments ) TYPE CR
|
|
( The next line of output should be blank to test CR ) SOURCE TYPE CR CR
|
|
|
|
( It is now assumed that SOURCE, TYPE, CR and comments work. SOURCE and )
|
|
( TYPE will be used to report test passes until something better can be )
|
|
( defined to report errors. Until then reporting failures will depend on the )
|
|
( system under test and will usually be via reporting an unrecognised word )
|
|
( or possibly the system crashing. Tests will be numbered by #n from now on )
|
|
( to assist fault finding. Test successes will be indicated by )
|
|
( 'Pass: #n ...' and failures by 'Error: #n ...' )
|
|
|
|
( Initial tests of >IN +! and 1+ )
|
|
( Check that n >IN +! acts as an interpretive IF, where n >= 0 )
|
|
( Pass #1: testing 0 >IN +! ) 0 >IN +! SOURCE TYPE CR
|
|
( Pass #2: testing 1 >IN +! ) 1 >IN +! xSOURCE TYPE CR
|
|
( Pass #3: testing 1+ ) 1 1+ >IN +! xxSOURCE TYPE CR
|
|
|
|
( Test results can now be reported using the >IN +! trick to skip )
|
|
( 1 or more characters )
|
|
|
|
( The value of BASE is unknown so it is not safe to use digits > 1, therefore )
|
|
( it will be set it to binary and then decimal, this also tests @ and ! )
|
|
|
|
( Pass #4: testing @ ! BASE ) 0 1+ 1+ BASE ! BASE @ >IN +! xxSOURCE TYPE CR
|
|
( Set BASE to decimal ) 1010 BASE !
|
|
( Pass #5: testing decimal BASE ) BASE @ >IN +! xxxxxxxxxxSOURCE TYPE CR
|
|
|
|
( Now in decimal mode and digits >1 can be used )
|
|
|
|
( A better error reporting word is needed, much like .( which can't )
|
|
( be used as it is in the Core Extension word set, similarly PARSE can't be )
|
|
( used either, only WORD is available to parse a message and must be used )
|
|
( in a colon definition. Therefore a simple colon definition is tested next )
|
|
|
|
( Pass #6: testing : ; ) : .SRC SOURCE TYPE CR ; 6 >IN +! xxxxxx.SRC
|
|
( Pass #7: testing number input ) 19 >IN +! xxxxxxxxxxxxxxxxxxx.SRC
|
|
|
|
( VARIABLE is now tested as one will be used instead of DROP e.g. Y ! )
|
|
|
|
( Pass #8: testing VARIABLE ) VARIABLE Y 2 Y ! Y @ >IN +! xx.SRC
|
|
|
|
: MSG 41 WORD COUNT ; ( 41 is the ASCII code for right parenthesis )
|
|
( The next tests MSG leaves 2 items on the data stack )
|
|
( Pass #9: testing WORD COUNT ) 5 MSG abcdef) Y ! Y ! >IN +! xxxxx.SRC
|
|
( Pass #10: testing WORD COUNT ) MSG ab) >IN +! xxY ! .SRC
|
|
|
|
( For reporting success .MSG( is now defined )
|
|
: .MSG( MSG TYPE ; .MSG( Pass #11: testing WORD COUNT .MSG) CR
|
|
|
|
( To define an error reporting word, = 2* AND will be needed, test them first )
|
|
( This assumes 2's complement arithmetic )
|
|
1 1 = 1+ 1+ >IN +! x.MSG( Pass #12: testing = returns all 1's for true) CR
|
|
1 0 = 1+ >IN +! x.MSG( Pass #13: testing = returns 0 for false) CR
|
|
1 1 = -1 = 1+ 1+ >IN +! x.MSG( Pass #14: testing -1 interpreted correctly) CR
|
|
|
|
1 2* >IN +! xx.MSG( Pass #15: testing 2*) CR
|
|
-1 2* 1+ 1+ 1+ >IN +! x.MSG( Pass #16: testing 2*) CR
|
|
|
|
-1 -1 AND 1+ 1+ >IN +! x.MSG( Pass #17: testing AND) CR
|
|
-1 0 AND 1+ >IN +! x.MSG( Pass #18: testing AND) CR
|
|
6 -1 AND >IN +! xxxxxx.MSG( Pass #19: testing AND) CR
|
|
|
|
( Define ~ to use as a 'to end of line' comment. \ cannot be used as it a )
|
|
( Core Extension word )
|
|
: ~ ( -- ) SOURCE >IN ! Y ! ;
|
|
|
|
( Rather than relying on a pass message test words can now be defined to )
|
|
( report errors in the event of a failure. For convenience words ?T~ and )
|
|
( ?F~ are defined together with a helper ?~~ to test for TRUE and FALSE )
|
|
( Usage is: <test> ?T~ Error #n: <message> )
|
|
( Success makes >IN index the ~ in ?T~ or ?F~ to skip the error message. )
|
|
( Hence it is essential there is only 1 space between ?T~ and Error )
|
|
|
|
: ?~~ ( -1 | 0 -- ) 2* >IN +! ;
|
|
: ?F~ ( f -- ) 0 = ?~~ ;
|
|
: ?T~ ( f -- ) -1 = ?~~ ;
|
|
|
|
( Errors will be counted )
|
|
VARIABLE #ERRS 0 #ERRS !
|
|
: Error 1 #ERRS +! -6 >IN +! .MSG( CR ;
|
|
: Pass -1 #ERRS +! 1 >IN +! Error ; ~ Pass is defined solely to test Error
|
|
|
|
-1 ?F~ Pass #20: testing ?F~ ?~~ Pass Error
|
|
-1 ?T~ Error #1: testing ?T~ ?~~ ~
|
|
|
|
0 0 = 0= ?F~ Error #2: testing 0=
|
|
1 0 = 0= ?T~ Error #3: testing 0=
|
|
-1 0 = 0= ?T~ Error #4: testing 0=
|
|
|
|
0 0 = ?T~ Error #5: testing =
|
|
0 1 = ?F~ Error #6: testing =
|
|
1 0 = ?F~ Error #7: testing =
|
|
-1 1 = ?F~ Error #8: testing =
|
|
1 -1 = ?F~ Error #9: testing =
|
|
|
|
-1 0< ?T~ Error #10: testing 0<
|
|
0 0< ?F~ Error #11: testing 0<
|
|
1 0< ?F~ Error #12: testing 0<
|
|
|
|
DEPTH 1+ DEPTH = ?~~ Error #13: testing DEPTH
|
|
~ Up to now whether the data stack was empty or not hasn't mattered as
|
|
~ long as it didn't overflow. Now it will be emptied - also
|
|
~ removing any unreported underflow
|
|
DEPTH 0< 0= 1+ >IN +! ~ 0 0 >IN ! Remove any underflow
|
|
DEPTH 0= 1+ >IN +! ~ Y ! 0 >IN ! Empty the stack
|
|
DEPTH 0= ?T~ Error #14: data stack not emptied
|
|
|
|
4 -5 SWAP 4 = SWAP -5 = = ?T~ Error #15: testing SWAP
|
|
111 222 333 444
|
|
DEPTH 4 = ?T~ Error #16: testing DEPTH
|
|
444 = SWAP 333 = = DEPTH 3 = = ?T~ Error #17: testing SWAP DEPTH
|
|
222 = SWAP 111 = = DEPTH 1 = = ?T~ Error #18: testing SWAP DEPTH
|
|
DEPTH 0= ?T~ Error #19: testing DEPTH = 0
|
|
|
|
~ From now on the stack is expected to be empty after a test so
|
|
~ ?~ will be defined to include a check on the stack depth. Note
|
|
~ that ?~~ was defined and used earlier instead of ?~ to avoid
|
|
~ (irritating) redefinition messages that many systems display had
|
|
~ ?~ simply been redefined
|
|
|
|
: ?~ ( -1 | 0 -- ) DEPTH 1 = AND ?~~ ; ~ -1 test success, 0 test failure
|
|
|
|
123 -1 ?~ Pass #21: testing ?~
|
|
Y ! ~ equivalent to DROP
|
|
|
|
~ Testing the remaining Core words used in the Hayes tester, with the above
|
|
~ definitions these are straightforward
|
|
|
|
1 DROP DEPTH 0= ?~ Error #20: testing DROP
|
|
123 DUP = ?~ Error #21: testing DUP
|
|
123 ?DUP = ?~ Error #22: testing ?DUP
|
|
0 ?DUP 0= ?~ Error #23: testing ?DUP
|
|
123 111 + 234 = ?~ Error #24: testing +
|
|
123 -111 + 12 = ?~ Error #25: testing +
|
|
-123 111 + -12 = ?~ Error #26: testing +
|
|
-123 -111 + -234 = ?~ Error #27: testing +
|
|
-1 NEGATE 1 = ?~ Error #28: testing NEGATE
|
|
0 NEGATE 0= ?~ Error #29: testing NEGATE
|
|
987 NEGATE -987 = ?~ Error #30: testing NEGATE
|
|
HERE DEPTH SWAP DROP 1 = ?~ Error #31: testing HERE
|
|
CREATE TST1 HERE TST1 = ?~ Error #32: testing CREATE HERE
|
|
16 ALLOT HERE TST1 NEGATE + 16 = ?~ Error #33: testing ALLOT
|
|
-16 ALLOT HERE TST1 = ?~ Error #34: testing ALLOT
|
|
0 CELLS 0= ?~ Error #35: testing CELLS
|
|
1 CELLS ALLOT HERE TST1 NEGATE + VARIABLE CSZ CSZ !
|
|
CSZ @ 0= 0= ?~ Error #36: testing CELLS
|
|
3 CELLS CSZ @ DUP 2* + = ?~ Error #37: testing CELLS
|
|
-3 CELLS CSZ @ DUP 2* + + 0= ?~ Error #38: testing CELLS
|
|
: TST2 ( f -- n ) DUP IF 1+ THEN ;
|
|
0 TST2 0= ?~ Error #39: testing IF THEN
|
|
1 TST2 2 = ?~ Error #40: testing IF THEN
|
|
: TST3 ( n1 -- n2 ) IF 123 ELSE 234 THEN ;
|
|
0 TST3 234 = ?~ Error #41: testing IF ELSE THEN
|
|
1 TST3 123 = ?~ Error #42: testing IF ELSE THEN
|
|
: TST4 ( -- n ) 0 5 0 DO 1+ LOOP ;
|
|
TST4 5 = ?~ Error #43: testing DO LOOP
|
|
: TST5 ( -- n ) 0 10 0 DO I + LOOP ;
|
|
TST5 45 = ?~ Error #44: testing I
|
|
: TST6 ( -- n ) 0 10 0 DO DUP 5 = IF LEAVE ELSE 1+ THEN LOOP ;
|
|
TST6 5 = ?~ Error #45: testing LEAVE
|
|
: TST7 ( -- n1 n2 ) 123 >R 234 R> ;
|
|
TST7 NEGATE + 111 = ?~ Error #46: testing >R R>
|
|
: TST8 ( -- ch ) [CHAR] A ;
|
|
TST8 65 = ?~ Error #47: testing [CHAR]
|
|
: TST9 ( -- ) [CHAR] s [CHAR] s [CHAR] a [CHAR] P 4 0 DO EMIT LOOP ;
|
|
TST9 .MSG( #22: testing EMIT) CR
|
|
: TST10 ( -- ) S" Pass #23: testing S" TYPE [CHAR] " EMIT CR ; TST10
|
|
|
|
~ The Hayes core test core.fr uses CONSTANT before it is tested therefore
|
|
~ we test CONSTANT here
|
|
|
|
1234 CONSTANT CTEST
|
|
CTEST 1234 = ?~ Error #48: testing CONSTANT
|
|
|
|
~ The Hayes tester uses some words from the Core extension word set
|
|
~ These will be conditionally defined following definition of a
|
|
~ word called ?DEFINED to determine whether these are already defined
|
|
|
|
VARIABLE TIMM1 0 TIMM1 !
|
|
: TIMM2 123 TIMM1 ! ; IMMEDIATE
|
|
: TIMM3 TIMM2 ; TIMM1 @ 123 = ?~ Error #49: testing IMMEDIATE
|
|
|
|
: ?DEFINED ( "name" -- 0 | -1 ) 32 WORD FIND SWAP DROP 0= 0= ;
|
|
?DEFINED SWAP ?~ Error #50: testing FIND ?DEFINED
|
|
?DEFINED <<no-such-word-hopefully>> 0= ?~ Error #51 testing FIND ?DEFINED
|
|
|
|
?DEFINED \ ?~ : \ ~ ; IMMEDIATE
|
|
\ Error #52: testing \
|
|
: TIMM4 \ Error #53: testing \ is IMMEDIATE
|
|
;
|
|
|
|
~ TRUE and FALSE are defined as colon definitions as they have been used
|
|
~ more than CONSTANT above
|
|
|
|
?DEFINED TRUE ?~ : TRUE 1 NEGATE ;
|
|
?DEFINED FALSE ?~ : FALSE 0 ;
|
|
?DEFINED HEX ?~ : HEX 16 BASE ! ;
|
|
|
|
TRUE -1 = ?~ Error #54: testing TRUE
|
|
FALSE 0= ?~ Error #55: testing FALSE
|
|
10 HEX 0A = ?~ Error #56: testing HEX
|
|
AB 0A BASE ! 171 = ?~ Error #57: testing hex number
|
|
|
|
~ Delete the ~ on the next 2 lines to check the final error report
|
|
~ Error #998: testing a deliberate failure
|
|
~ Error #999: testing a deliberate failure
|
|
|
|
~ Describe the messages that should be seen. The previously defined .MSG(
|
|
~ can be used for text messages
|
|
|
|
CR .MSG( Results: ) CR
|
|
CR .MSG( Pass messages #1 to #23 should be displayed above)
|
|
CR .MSG( and no error messages) CR
|
|
|
|
~ Finally display a message giving the number of tests that failed.
|
|
~ This is complicated by the fact that untested words including .( ." and .
|
|
~ cannot be used. Also more colon definitions shouldn't be defined than are
|
|
~ needed. To display a number, note that the number of errors will have
|
|
~ one or two digits at most and an interpretive loop can be used to
|
|
~ display those.
|
|
|
|
CR
|
|
0 #ERRS @
|
|
~ Loop to calculate the 10's digit (if any)
|
|
DUP NEGATE 9 + 0< NEGATE >IN +! ( -10 + SWAP 1+ SWAP 0 >IN ! )
|
|
~ Display the error count
|
|
SWAP ?DUP 0= 1+ >IN +! ( 48 + EMIT ( ) 48 + EMIT
|
|
|
|
.MSG( test) #ERRS @ 1 = 1+ >IN +! ~ .MSG( s)
|
|
.MSG( failed out of 57 additional tests) CR
|
|
|
|
CR CR .MSG( --- End of Preliminary Tests --- ) CR
|