Miroirs/waforth
1
0
Fork 0
mirror of https://github.com/remko/waforth synced 2025-01-13 08:01:32 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

tests: Enable parts of test suite

Browse source
This commit is contained in:
Remko Tronçon 2022-04-26 22:11:24 +02:00
parent 3d9b10c860
commit a07772536c
1 changed files with 37 additions and 37 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

74
src/standard-testsuite/core.f
View file

@ -411,16 +411,16 @@ T{ MAX-INT MAX-INT M* MAX-INT FM/MOD -> 0 MAX-INT }T
\ THE SYSTEM MIGHT DO EITHER FLOORED OR SYMMETRIC DIVISION.
\ SINCE WE HAVE ALREADY TESTED M*, FM/MOD, AND SM/REM WE CAN USE THEM IN TEST.
\ TODO IFFLOORED : T/MOD >R S>D R> FM/MOD ;
\ TODO IFFLOORED : T/ T/MOD SWAP DROP ;
\ TODO IFFLOORED : TMOD T/MOD DROP ;
\ TODO IFFLOORED : T*/MOD >R M* R> FM/MOD ;
\ TODO IFFLOORED : T*/ T*/MOD SWAP DROP ;
\ TODO IFSYM : T/MOD >R S>D R> SM/REM ;
\ TODO IFSYM : T/ T/MOD SWAP DROP ;
\ TODO IFSYM : TMOD T/MOD DROP ;
\ TODO IFSYM : T*/MOD >R M* R> SM/REM ;
\ TODO IFSYM : T*/ T*/MOD SWAP DROP ;
IFFLOORED : T/MOD >R S>D R> FM/MOD ;
IFFLOORED : T/ T/MOD SWAP DROP ;
IFFLOORED : TMOD T/MOD DROP ;
IFFLOORED : T*/MOD >R M* R> FM/MOD ;
IFFLOORED : T*/ T*/MOD SWAP DROP ;
IFSYM : T/MOD >R S>D R> SM/REM ;
IFSYM : T/ T/MOD SWAP DROP ;
IFSYM : TMOD T/MOD DROP ;
IFSYM : T*/MOD >R M* R> SM/REM ;
IFSYM : T*/ T*/MOD SWAP DROP ;
\ TODO T{ 0 1 /MOD -> 0 1 T/MOD }T
\ TODO T{ 1 1 /MOD -> 1 1 T/MOD }T
@ -803,21 +803,21 @@ T{ GS4 123 456
-> }T
\ ------------------------------------------------------------------------
\ TODO TESTING <# # #S #> HOLD SIGN BASE >NUMBER HEX DECIMAL
TESTING <# # #S #> HOLD SIGN BASE >NUMBER HEX DECIMAL
: S= \ ( ADDR1 C1 ADDR2 C2 -- T/F ) COMPARE TWO STRINGS.
>R SWAP R@ = IF \ MAKE SURE STRINGS HAVE SAME LENGTH
R> ?DUP IF \ IF NON-EMPTY STRINGS
0 DO
OVER C@ OVER C@ - IF 2DROP <FALSE> UNLOOP EXIT THEN
SWAP CHAR+ SWAP CHAR+
LOOP
THEN
2DROP <TRUE> \ IF WE GET HERE, STRINGS MATCH
ELSE
R> DROP 2DROP <FALSE> \ LENGTHS MISMATCH
THEN ;
\ TODO : S= \ ( ADDR1 C1 ADDR2 C2 -- T/F ) COMPARE TWO STRINGS.
\ TODO >R SWAP R@ = IF \ MAKE SURE STRINGS HAVE SAME LENGTH
\ TODO R> ?DUP IF \ IF NON-EMPTY STRINGS
\ TODO 0 DO
\ TODO OVER C@ OVER C@ - IF 2DROP <FALSE> UNLOOP EXIT THEN
\ TODO SWAP CHAR+ SWAP CHAR+
\ TODO LOOP
\ TODO THEN
\ TODO 2DROP <TRUE> \ IF WE GET HERE, STRINGS MATCH
\ TODO ELSE
\ TODO R> DROP 2DROP <FALSE> \ LENGTHS MISMATCH
\ TODO THEN ;
\ TODO
\ TODO : GP1 <# 41 HOLD 42 HOLD 0 0 #> S" BA" S= ;
\ TODO T{ GP1 -> <TRUE> }T
\ TODO
@ -829,12 +829,12 @@ T{ GS4 123 456
\ TODO
\ TODO : GP4 <# 1 0 #S #> S" 1" S= ;
\ TODO T{ GP4 -> <TRUE> }T
\ TODO
\ TODO 24 CONSTANT MAX-BASE \ BASE 2 .. 36
\ TODO : COUNT-BITS
\ TODO 0 0 INVERT BEGIN DUP WHILE >R 1+ R> 2* REPEAT DROP ;
\ TODO COUNT-BITS 2* CONSTANT #BITS-UD \ NUMBER OF BITS IN UD
\ TODO
24 CONSTANT MAX-BASE \ BASE 2 .. 36
: COUNT-BITS
0 0 INVERT BEGIN DUP WHILE >R 1+ R> 2* REPEAT DROP ;
COUNT-BITS 2* CONSTANT #BITS-UD \ NUMBER OF BITS IN UD
\ TODO : GP5
\ TODO BASE @ <TRUE>
\ TODO MAX-BASE 1+ 2 DO \ FOR EACH POSSIBLE BASE
@ -869,13 +869,13 @@ T{ GS4 123 456
\ TODO R> BASE ! ;
\ TODO
\ TODO T{ GP7 -> <TRUE> }T
\ TODO
\ TODO \ >NUMBER TESTS
\ TODO CREATE GN-BUF 0 C,
\ TODO : GN-STRING GN-BUF 1 ;
\ TODO : GN-CONSUMED GN-BUF CHAR+ 0 ;
\ TODO : GN' [CHAR] ' WORD CHAR+ C@ GN-BUF C! GN-STRING ;
\ TODO
\ >NUMBER TESTS
CREATE GN-BUF 0 C,
: GN-STRING GN-BUF 1 ;
: GN-CONSUMED GN-BUF CHAR+ 0 ;
: GN' [CHAR] ' WORD CHAR+ C@ GN-BUF C! GN-STRING ;
\ TODO T{ 0 0 GN' 0' >NUMBER -> 0 0 GN-CONSUMED }T
\ TODO T{ 0 0 GN' 1' >NUMBER -> 1 0 GN-CONSUMED }T
\ TODO T{ 1 0 GN' 1' >NUMBER -> BASE @ 1+ 0 GN-CONSUMED }T