- Foreword
- Proposals Process
- 200x Membership
- 1 Introduction
- 2 Terms, notation, and references
- 3 Usage requirements
- 4 Documentation requirements
- 5 Compliance and labeling
- 6 Glossary
- 7 The optional Block word set
- 8 The optional Double-Number word set
- 9 The optional Exception word set
- 10 The optional Facility word set
- 11 The optional File-Access word set
- 12 The optional Floating-Point word set
- 13 The optional Locals word set
- 14 The optional Memory-Allocation word set
- 15 The optional Programming-Tools word set
- 16 The optional Search-Order word set
- 17 The optional String word set
- 18 The optional Extended-Character word set
- Annex A: Rationale
- Annex B: Bibliography
- Annex C: Compatibility analysis
- Annex D: Portability guide
- Annex E: Reference Implementations
- Annex F: Test Suite
- Annex H: Alphabetic list of words
Annex F: Test Suite
F.1 Introduction
After the publication of the original ANS Forth document (ANSI X3.215-1994), John Hayes developed a test suite, which included both a test harness and a suite of core tests. The harness was extended by Anton Ertl and David N. Williams to allow the testing of floating point operations. The current revision of the test harness is available from the web site:
The teat harness can be used to define regression tests for a set of application words. It can also be used to define tests of words in a standard-conforming implementation. Numerous people have contributed to the test cases given in section F.3 onwards. The majority of the test cases have been taken from John Hayes' test suite[1], Gerry Jackson's test suite[2] and David Williams with significant contributions from the committee.
[1] http://www.taygeta.com/forth.html
[2] http://soton.mpeforth.com/flag/anstests/index.html
F.2 Test Harness
The tester defines functions that compare the results of a test with
a set of expected results. The syntax for each test starts with
"T{" (T-open brace) followed by a code sequence to test.
This is followed by "->", the expected results, and
"}T" (close brace-T). For example, the following:
tests that one plus one indeed equals two.
The "T{" records the stack depth prior to the test code
so that they can be eliminated from the test.
The "->" records the stack depth and moves the entire stack
contents to an array. In the example test, the recorded stack depth
is one and the saved array contains one value, two.
The "}T" compares the current stack depth to the saved
stack depth. If they are equal each value on the stack is removed
from the stack and compared to its corresponding value in the array.
If the depths are not equal or if the stack comparison fails, an error
is reported. For example:
T{ 1 2 3 SWAP -> 1 3 2 }T
T{ 1 2 3 SWAP -> 1 2 3 }T INCORRECT RESULT: T{ 1 2 3 SWAP -> 1 2 3 }T
T{ 1 2 SWAP -> 1 }T WRONG NUMBER OF RESULTS: T{ 1 2 SWAP -> 1 }T
F.2.1 Floating-Point
Floating point testing can involve further complications. The harness attempts to determine whether floating-point support is present, and if so, whether there is a separate floating-point stack, and behave accordingly. The CONSTANTsHAS-FLOATING and
HAS-FLOATING-STACK contain the results of its efforts, so
the behavior of the code can be modified by the user if necessary.
Then there are the perennial issues of floating point value
comparisons. Exact equality is specified by SET-EXACT
(the default). If approximate equality tests are desired, execute
SET-NEAR. Then the
FVARIABLEs REL-NEAR (default 1E-12) and
ABS-NEAR (default 0E) contain the values to be used in
comparisons by the (internal) word FNEARLY=.
When there is not a separate floating point stack, and you want to use
approximate equality for FP values, it is necessary to identify which
stack items are floating point quantities. This can be done by
replacing the closing }T with a version that specifies
this, such as RRXR}T which identifies the stack picture
(r r x r). The harness provides such words for all
combinations of R and X with up to four stack items. They can be
used with either an integrated or a separate floating point stacks.
Adding more if you need them is straightforward; see the examples in
the source. Here is an example which also illustrates controlling
the precision of comparisons:
F.2.2 Error Processing
The internal word ERROR is vectored, through the
ERROR-XT variable, so that its action can be changed by
the user (for example, to add a counter for the number of errors).
The default action ERROR1 can be used as a factor in the
display of error reports.
F.2.3 Source
The following source code provides the test harness.
\ harness originally developed by John Hayes
\ (C) 1995 JOHNS HOPKINS UNIVERSITY / APPLIED PHYSICS LABORATORY
\ MAY BE DISTRIBUTED FREELY AS LONG AS THIS COPYRIGHT NOTICE REMAINS.
\ VERSION 1.1
\ Revision history and possibly newer versions can be found at
\ http://www.forth200x/tests/ttester.fs
BASE @
HEX
VARIABLE ACTUAL-DEPTH \ stack record
CREATE ACTUAL-RESULTS 20 CELLS ALLOT
VARIABLE START-DEPTH
VARIABLE XCURSOR \ for ...}T
VARIABLE ERROR-XT
: ERROR ERROR-XT @ EXECUTE ; \ for vectoring of error reporting
: "FLOATING" S" FLOATING" ; \ only compiled S" in CORE
: "FLOATING-STACK" S" FLOATING-STACK" ;
"FLOATING" ENVIRONMENT? [IF]
[IF]
TRUE
[ELSE]
FALSE
[THEN]
[ELSE]
FALSE
[THEN] CONSTANT HAS-FLOATING
"FLOATING-STACK" ENVIRONMENT? [IF]
[IF]
TRUE
[ELSE]
FALSE
[THEN]
[ELSE] \ We don't know whether the FP stack is separate.
HAS-FLOATING \ If we have FLOATING, we assume it is.
[THEN] CONSTANT HAS-FLOATING-STACK
HAS-FLOATING [IF]
\ Set the following to the relative and absolute tolerances you
\ want for approximate float equality, to be used with F in
\ FNEARLY=. Keep the signs, because F needs them.
FVARIABLE REL-NEAR DECIMAL 1E-12 HEX REL-NEAR F!
FVARIABLE ABS-NEAR DECIMAL 0E HEX ABS-NEAR F!
\ When EXACT? is TRUE, }F uses FEXACTLY=, otherwise FNEARLY=.
TRUE VALUE EXACT?
: SET-EXACT ( -- ) TRUE TO EXACT? ;
: SET-NEAR ( -- ) FALSE TO EXACT? ;
DECIMAL
: FEXACTLY= ( F: X Y -- S: FLAG )
(
Leave TRUE if the two floats are identical.
)
0E F~ ;
HEX
: FABS= ( F: X Y -- S: FLAG )
(
Leave TRUE if the two floats are equal within the tolerance
stored in ABS-NEAR.
)
ABS-NEAR F@ F~ ;
: FREL= ( F: X Y -- S: FLAG )
(
Leave TRUE if the two floats are relatively equal based on the
tolerance stored in ABS-NEAR.
)
REL-NEAR F@ FNEGATE F~ ;
: F2DUP FOVER FOVER ;
: F2DROP FDROP FDROP ;
: FNEARLY= ( F: X Y -- S: FLAG )
(
Leave TRUE if the two floats are nearly equal. This is a
refinement of Dirk Zoller's FEQ to also allow X = Y, including
both zero, or to allow approximately equality when X and Y are too
small to satisfy the relative approximation mode in the F~
specification.
)
F2DUP FEXACTLY= IF F2DROP TRUE EXIT THEN
F2DUP FREL= IF F2DROP TRUE EXIT THEN
FABS= ;
: FCONF= ( R1 R2 -- F )
EXACT? IF
FEXACTLY=
ELSE
FNEARLY=
THEN ;
[THEN]
HAS-FLOATING-STACK [IF]
VARIABLE ACTUAL-FDEPTH
CREATE ACTUAL-FRESULTS 20 FLOATS ALLOT
VARIABLE START-FDEPTH
VARIABLE FCURSOR
: EMPTY-FSTACK ( ... -- ... )
FDEPTH START-FDEPTH @ < IF
FDEPTH START-FDEPTH @ SWAP DO 0E LOOP
THEN
FDEPTH START-FDEPTH @ > IF
FDEPTH START-FDEPTH @ DO FDROP LOOP
THEN ;
: F{ ( -- )
FDEPTH START-FDEPTH ! 0 FCURSOR ! ;
: F-> ( ... -- ... )
FDEPTH DUP ACTUAL-FDEPTH !
START-FDEPTH @ > IF
FDEPTH START-FDEPTH @ - 0 DO ACTUAL-FRESULTS I FLOATS + F! LOOP
THEN ;
: F} ( ... -- ... )
FDEPTH ACTUAL-FDEPTH @ = IF
FDEPTH START-FDEPTH @ > IF
FDEPTH START-FDEPTH @ - 0 DO
ACTUAL-FRESULTS I FLOATS + F@ FCONF= INVERT IF
S" INCORRECT FP RESULT: " ERROR LEAVE
THEN
LOOP
THEN
ELSE
S" WRONG NUMBER OF FP RESULTS: " ERROR
THEN ;
: F...}T ( -- )
FCURSOR @ START-FDEPTH @ + ACTUAL-FDEPTH @ <> IF
S" NUMBER OF FLOAT RESULTS BEFORE '->' DOES NOT MATCH ...}T "
S" SPECIFICATION: " ERROR
ELSE FDEPTH START-FDEPTH @ = 0= IF
S" NUMBER OF FLOAT RESULTS BEFORE AND AFTER '->' DOES NOT MATCH: "
ERROR
THEN THEN ;
: FTESTER ( R -- )
FDEPTH 0= ACTUAL-FDEPTH @ FCURSOR @ START-FDEPTH @ + 1+ < OR IF
S" NUMBER OF FLOAT RESULTS AFTER '->' BELOW ...}T SPECIFICATION: "
ERROR
ELSE ACTUAL-FRESULTS FCURSOR @ FLOATS + F@ FCONF= 0= IF
S" INCORRECT FP RESULT: " ERROR
THEN THEN
1 FCURSOR +! ;
[ELSE]
: EMPTY-FSTACK ;
: F{ ;
: F-> ;
: F} ;
: F...}T ;
HAS-FLOATING [IF]
DECIMAL
: COMPUTE-CELLS-PER-FP ( -- U )
DEPTH 0E DEPTH 1- >R FDROP R> SWAP - ;
HEX
COMPUTE-CELLS-PER-FP CONSTANT CELLS-PER-FP
: FTESTER ( R -- )
DEPTH CELLS-PER-FP <
ACTUAL-DEPTH @ XCURSOR @ START-DEPTH @ + CELLS-PER-FP + <
OR IF
S" NUMBER OF RESULTS AFTER '->' BELOW ...}T SPECIFICATION: "
ERROR EXIT
ELSE ACTUAL-RESULTS XCURSOR @ CELLS + F@ FCONF= 0= IF
S" INCORRECT FP RESULT: " ERROR
THEN THEN
CELLS-PER-FP XCURSOR +! ;
[THEN]
[THEN]
: EMPTY-STACK \ ( ... -- ) empty stack; handles underflowed stack too.
DEPTH START-DEPTH @ < IF
DEPTH START-DEPTH @ SWAP DO 0 LOOP
THEN
DEPTH START-DEPTH @ > IF
DEPTH START-DEPTH @ DO DROP LOOP
THEN
EMPTY-FSTACK ;
: ERROR1 \ ( C-ADDR U -- ) display an error message
\ followed by the line that had the error.
TYPE SOURCE TYPE CR \ display line corresponding to error
EMPTY-STACK \ throw away everything else
;
' ERROR1 ERROR-XT !
: T{ \ ( -- ) record the pre-test depth.
DEPTH START-DEPTH ! 0 XCURSOR ! F{ ;
: -> \ ( ... -- ) record depth and contents of stack.
DEPTH DUP ACTUAL-DEPTH ! \ record depth
START-DEPTH @ > IF \ if there is something on the stack
DEPTH START-DEPTH @ - 0 DO \ save them
ACTUAL-RESULTS I CELLS + !
LOOP
THEN
F-> ;
: }T \ ( ... -- ) comapre stack (expected) contents with saved
\ (actual) contents.
DEPTH ACTUAL-DEPTH @ = IF \ if depths match
DEPTH START-DEPTH @ > IF \ if something on the stack
DEPTH START-DEPTH @ - 0 DO \ for each stack item
ACTUAL-RESULTS I CELLS + @ \ compare actual with expected
<> IF S" INCORRECT RESULT: " ERROR LEAVE THEN
LOOP
THEN
ELSE \ depth mismatch
S" WRONG NUMBER OF RESULTS: " ERROR
THEN
F} ;
: ...}T ( -- )
XCURSOR @ START-DEPTH @ + ACTUAL-DEPTH @ <> IF
S" NUMBER OF CELL RESULTS BEFORE '->' DOES NOT MATCH ...}T "
S" SPECIFICATION: " ERROR
ELSE DEPTH START-DEPTH @ = 0= IF
S" NUMBER OF CELL RESULTS BEFORE AND AFTER '->' DOES NOT MATCH: "
ERROR
THEN THEN
F...}T ;
: XTESTER ( X -- )
DEPTH 0= ACTUAL-DEPTH @ XCURSOR @ START-DEPTH @ + 1+ < OR IF
S" NUMBER OF CELL RESULTS AFTER '->' BELOW ...}T SPECIFICATION: "
ERROR EXIT
ELSE ACTUAL-RESULTS XCURSOR @ CELLS + @ <> IF
S" INCORRECT CELL RESULT: " ERROR
THEN THEN
1 XCURSOR +! ;
: X}T XTESTER ...}T ;
: XX}T XTESTER XTESTER ...}T ;
: XXX}T XTESTER XTESTER XTESTER ...}T ;
: XXXX}T XTESTER XTESTER XTESTER XTESTER ...}T ;
HAS-FLOATING [IF]
: R}T FTESTER ...}T ;
: XR}T FTESTER XTESTER ...}T ;
: RX}T XTESTER FTESTER ...}T ;
: RR}T FTESTER FTESTER ...}T ;
: XXR}T FTESTER XTESTER XTESTER ...}T ;
: XRX}T XTESTER FTESTER XTESTER ...}T ;
: XRR}T FTESTER FTESTER XTESTER ...}T ;
: RXX}T XTESTER XTESTER FTESTER ...}T ;
: RXR}T FTESTER XTESTER FTESTER ...}T ;
: RRX}T XTESTER FTESTER FTESTER ...}T ;
: RRR}T FTESTER FTESTER FTESTER ...}T ;
: XXXR}T FTESTER XTESTER XTESTER XTESTER ...}T ;
: XXRX}T XTESTER FTESTER XTESTER XTESTER ...}T ;
: XXRR}T FTESTER FTESTER XTESTER XTESTER ...}T ;
: XRXX}T XTESTER XTESTER FTESTER XTESTER ...}T ;
: XRXR}T FTESTER XTESTER FTESTER XTESTER ...}T ;
: XRRX}T XTESTER FTESTER FTESTER XTESTER ...}T ;
: XRRR}T FTESTER FTESTER FTESTER XTESTER ...}T ;
: RXXX}T XTESTER XTESTER XTESTER FTESTER ...}T ;
: RXXR}T FTESTER XTESTER XTESTER FTESTER ...}T ;
: RXRX}T XTESTER FTESTER XTESTER FTESTER ...}T ;
: RXRR}T FTESTER FTESTER XTESTER FTESTER ...}T ;
: RRXX}T XTESTER XTESTER FTESTER FTESTER ...}T ;
: RRXR}T FTESTER XTESTER FTESTER FTESTER ...}T ;
: RRRX}T XTESTER FTESTER FTESTER FTESTER ...}T ;
: RRRR}T FTESTER FTESTER FTESTER FTESTER ...}T ;
[THEN]
\ Set the following flag to TRUE for more verbose output; this may
\ allow you to tell which test caused your system to hang.
VARIABLE VERBOSE
FALSE VERBOSE !
: TESTING \ ( -- ) TALKING COMMENT.
SOURCE VERBOSE @
IF DUP >R TYPE CR R> >IN !
ELSE >IN ! DROP
THEN ;
BASE !
F.3 Core Tests
The test cases in John Hayes' original test suite were designed to test features before they were used in later tests. Due to the structure of this annex the progressive testing has been lost. This section attempts to retain the integrity of the original test suite by laying out the test progression for the core word set.
While this suite does test many aspects of the core word set, it is not comprehensive. A standard system should pass all of the tests within this suite. A system cannot claim to be standard simply because it passes this test suite.
The test starts by verifying basic assumptions about number representation. It then builds on this with tests of boolean logic, shifting, and comparisons. It then tests the basic stack manipulations and arithmetic. Ultimately, it tests the Forth interpreter and compiler.
Note that all of the tests in this suite assume the current base is hexadecimal.
F.3.1 Basic Assumptions
These test assume a two's complement implementation where the range of signed numbers is -2n-1 ... 2n-1-1 and the range of unsinged numbers is 0 ... 2n-1.
A method for testing KEY, QUIT, ABORT, ABORT", ENVIRONMENT?, etc has yet to be proposed.
T{ -> }T ( Start with a clean slate )
( Test if any bits are set; Answer in base 1 )
T{ : BITSSET? IF 0 0 ELSE 0 THEN ; -> }T
T{ 0 BITSSET? -> 0 }T ( Zero is all bits clear )
T{ 1 BITSSET? -> 0 0 }T ( Other numbers have at least one bit )
T{ -1 BITSSET? -> 0 0 }T
F.3.2 Booleans
To test the booleans it is first neccessary to test
F.6.1.0720 AND, and F.6.1.1720 INVERT. Before moving
on to the test F.6.1.0950 CONSTANT. The latter defines
two constants (0S and 1S) which will be used in the
further test.
It is now possible to complete the testing of F.6.1.0720 AND, F.6.1.1980 OR, and F.6.1.2490 XOR.
F.3.3 Shifts
To test the shift operators it is necessary to calculate the most significant bit of a cell:
RSHIFT is tested later.
MSB must have at least one bit set:
The test F.6.1.0320 2*, F.6.1.0330 2/, F.6.1.1805 LSHIFT, and F.6.1.2162 RSHIFT can now be performed.
F.3.4 Numeric notation
The numeric representation can be tested with the following test cases:
T{ #1289 -> 1289 }T
T{ #12346789. -> 12346789. }T
T{ #-1289 -> -1289 }T
T{ #-12346789. -> -12346789. }T
T{ $12eF -> 4847 }T
T{ $12aBcDeF. -> 313249263. }T
T{ $-12eF -> -4847 }T
T{ $-12AbCdEf. -> -313249263. }T
T{ %10010110 -> 150 }T
T{ %10010110. -> 150. }T
T{ %-10010110 -> -150 }T
T{ %-10010110. -> -150. }T
T{ 'z' -> 122 }T
F.3.5 Comparisons
Before testing the comparison operators it is necessary to define a few constants to allow the testing of the upper and lower bounds.
With these constants defined, it is now possible to perform the F.6.1.0270 0=, F.6.1.0530 =, F.6.1.0250 0<, F.6.1.0480 <, F.6.1.0540 >, F.6.1.2340 U<, F.6.1.1880 MIN, and F.6.1.1870 MAX test.
F.3.6 Stack Operators
The stack operators can be tested without any prepatory work. The "normal" operators (F.6.1.1260 DROP, F.6.1.1290 DUP, F.6.1.1990 OVER, F.6.1.2160 ROT, and F.6.1.2260 SWAP) should be tested first, followed by the two-cell variants (F.6.1.0370 2DROP, F.6.1.0380 2DUP, F.6.1.0400 2OVER and F.6.1.0430 2SWAP) with F.6.1.0630 ?DUP and F.6.1.1200 DEPTH being performed last.
F.3.7 Return Stack Operators
The test F.6.1.0580 >R will test all three basic return stack operators (>R, R>, and R@).
F.3.8 Addition and Subtraction
Basic addition and subtraction should be tested in the order: F.6.1.0120 +, F.6.1.0160 -, F.6.1.0290 1+, F.6.1.0300 1-, F.6.1.0690 ABS and F.6.1.1910 NEGATE.
F.3.9 Multiplication
The multiplication operators should be tested in the order: F.6.1.2170 S>D, F.6.1.0090 *, F.6.1.1810 M*, and F.6.1.2360 UM*.
F.3.10 Division
Due to the complexity of the division operators they are tested separately from the multiplication operators. The basic division operators are tested first: F.6.1.1561 FM/MOD, F.6.1.2214 SM/REM, and F.6.1.2370 UM/MOD.
As the standard allows a system to provide either floored or symmetric division, the remaining operators have to be tested depending on the system behaviour. Two words are defined that provide a form of conditional compilation.
: IFSYM [ -3 2 / -1 = INVERT ] LITERAL IF POSTPONE \ THEN ;
IFSYM will ignore the rest of the line when it is performed
on a system with floored division and perform the line on a system
with symmetric division. IFFLOORED is the direct inverse,
ignoring the rest of the line on systems with symmetric division and
processing it on systems with floored division.
The remaining division operators are tested by defining a version of the operator using words which have already been tested (S>D, M*, FM/MOD and SM/REM). The test definition handles the special case of differing signes. As the test definitions use the words which have just been tested, the tests must be performed in the order: F.6.1.0240 /MOD, F.6.1.0230 /, F.6.1.1890 MOD, F.6.1.0100 */, and F.6.1.0110 */MOD.
F.3.11 Memory
As with the other sections, the tests for the memory access words build on previously tested words and thus require an order to the testing.
The first test (F.6.1.0150 , (comma)) tests HERE, the signle cell memory access words @, ! and CELL+ as well as the double cell access words 2@ and 2!. The tests F.6.1.0130 +! and F.6.1.0890 CELLS should then be performed.
The test (F.6.1.0860 C,) also tests the single character memory words C@, C!, and CHAR+, leaving the test F.6.1.0898 CHARS to be performed seperatly.
Finally, the memory access alignment test F.6.1.0705 ALIGN includes a test of ALIGNED, leaving F.6.1.0710 ALLOT as the final test in this group.
F.3.12 Characters
Basic character handling: F.6.1.0770 BL, F.6.1.0895 CHAR, F.6.1.2520 [CHAR], F.6.1.2500 [ which also tests ], and F.6.1.2165 S".
F.3.13 Dictionary
The dictionary tests define a number of words as part of the test, these are included in the approperate test: F.6.1.0070 ', F.6.1.2510 ['] both of which also test EXECUTE, F.6.1.1550 FIND, F.6.1.1780 LITERAL, F.6.1.0980 COUNT, F.6.1.2033 POSTPONE, F.6.1.2250 STATE
F.3.14 Flow Control
The flow control words have to be tested in matching groups. First test F.6.1.1700 IF, ELSE, THEN group. Followed by the BEGIN, F.6.1.2430 WHILE, REPEAT group, and the BEGIN, F.6.1.2390 UNTIL pairing. Finally the F.6.1.2120 RECURSE function should be tested.
F.3.15 Counted Loops
Counted loops have a set of special condition that require testing. As with the flow control words, these words have to be tested as a group. First the basic counted loop: DO; I; F.6.1.1800 LOOP, followed by loops with a non regular increment: F.6.1.0140 +LOOP, loops within loops: F.6.1.1730 J, and aborted loops: F.6.1.1760 LEAVE; F.6.1.2380 UNLOOP which includes a test for EXIT.
F.3.16 Defining Words
Although most of the defining words have already been used within the test suite, they still need to be tested fully. The tests include F.6.1.0450 : which also tests ;, F.6.1.0950 CONSTANT, F.6.1.2410 VARIABLE, F.6.1.1250 DOES> which includes tests CREATE, and F.6.1.0550 >BODY which also tests CREATE.
F.3.17 Evaluate
As with the defining words, F.6.1.1360 EVALUATE has already been used, but it must still be tested fully.
F.3.18 Parser Input Source Control
Testing of the input source can be quit dificult. The tests require line breaks within the test: F.6.1.2216 SOURCE, F.6.1.0560 >IN, and F.6.1.2450 WORD.
F.3.19 Number Patterns
The number formatting words produce a string, a word that compares two strings is required. This test suite assumes that the optional String word set is unavailable. Thus a string comparison word is defined, using only trusted words:
>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 ;
The number formatting words have to be tested as a group with F.6.1.1670 HOLD, F.6.1.2210 SIGN, and F.6.1.0030 # all including tests for <# and #>.
Before the F.6.1.0050 #S test can be performed it is necessary to calculate the number of bits required to store the largest double value.
: 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
The F.6.1.0570 >NUMBER test can now be performed. Finally, the F.6.1.0750 BASE test, which includes tests for HEX and DECIMAL, can be performed.
F.3.20 Memory Movement
Frist two memory buffers are defined:
CREATE SBUF 12 C, 34 C, 56 C,
: SEEBUF FBUF C@ FBUF CHAR+ C@ FBUF CHAR+ CHAR+ C@ ;
As the content of FBUF is changed by the
F.6.1.1540 FILL test, this must be executed before the
F.6.1.1900 MOVE test.
F.3.21 Output
As there is no provision for capturing the output stream so that it can be compared to an expected result there is not automatic method of testing the output generation words. The user is required to validate the output for the F.6.1.1320 EMIT test. This tests the selection of output words ., .", CR, SPACE, SPACES, TYPE, and U..
F.3.22 Input
To test the input word (F.6.1.0695 ACCEPT) the user is required to type up to 80 characters. The system will buffer the input sequence and output it to the user for inspection.
F.3.23 Dictionary Search Rules
The final test in this suite is included with F.6.1.0450 : and tests the search order of the dictionary. It asserts that a definition that uses its own name in the definition is not recursive but rather refers to the previous definition of the word.
T{ : GDX 123 ; -> }T \ First defintion
T{ : GDX GDX 234 ; -> }T \ Second defintion
T{ GDX -> 123 234 }T
F.6 The Core word set
: GP4 <# 1 0 #S #> S" 1" S= ; T{ GP4 -> <TRUE> }T
: GP5
BASE @ <TRUE>
MAX-BASE 1+ 2 DO \ FOR EACH POSSIBLE BASE
I BASE ! \ TBD: ASSUMES BASE WORKS
I 0 <# #S #> S" 10" S= AND
LOOP
SWAP BASE ! ;
T{ GP5 -> <TRUE> }T
: GP6
BASE @ >R 2 BASE !
MAX-UINT MAX-UINT <# #S #> \ MAXIMUM UD TO BINARY
R> BASE ! \ S: C-ADDR U
DUP #BITS-UD = SWAP
0 DO \ S: C-ADDR FLAG
OVER C@ [CHAR] 1 = AND \ ALL ONES
>R CHAR+ R>
LOOP SWAP DROP ;
T{ GP6 -> <TRUE> }T
: GP7
BASE @ >R MAX-BASE BASE !
<TRUE>
A 0 DO
I 0 <# #S #>
1 = SWAP C@ I 30 + = AND AND
LOOP
MAX-BASE A DO
I 0 <# #S #>
1 = SWAP C@ 41 I A - + = AND AND
LOOP
R> BASE ! ;
T{ GP7 -> <TRUE> }T
T{ 0 1 * -> 0 }T
T{ 1 0 * -> 0 }T
T{ 1 2 * -> 2 }T
T{ 2 1 * -> 2 }T
T{ 3 3 * -> 9 }T
T{ -3 3 * -> -9 }T
T{ 3 -3 * -> -9 }T
T{ -3 -3 * -> 9 }T
T{ MID-UINT+1 1 RSHIFT 2 * -> MID-UINT+1 }T
T{ MID-UINT+1 2 RSHIFT 4 * -> MID-UINT+1 }T
T{ MID-UINT+1 1 RSHIFT MID-UINT+1 OR 2 * -> MID-UINT+1 }T
IFSYM : T*/ T*/MOD SWAP DROP ;
T{ 0 2 1 */ -> 0 2 1 T*/ }T
T{ 1 2 1 */ -> 1 2 1 T*/ }T
T{ 2 2 1 */ -> 2 2 1 T*/ }T
T{ -1 2 1 */ -> -1 2 1 T*/ }T
T{ -2 2 1 */ -> -2 2 1 T*/ }T
T{ 0 2 -1 */ -> 0 2 -1 T*/ }T
T{ 1 2 -1 */ -> 1 2 -1 T*/ }T
T{ 2 2 -1 */ -> 2 2 -1 T*/ }T
T{ -1 2 -1 */ -> -1 2 -1 T*/ }T
T{ -2 2 -1 */ -> -2 2 -1 T*/ }T
T{ 2 2 2 */ -> 2 2 2 T*/ }T
T{ -1 2 -1 */ -> -1 2 -1 T*/ }T
T{ -2 2 -2 */ -> -2 2 -2 T*/ }T
T{ 7 2 3 */ -> 7 2 3 T*/ }T
T{ 7 2 -3 */ -> 7 2 -3 T*/ }T
T{ -7 2 3 */ -> -7 2 3 T*/ }T
T{ -7 2 -3 */ -> -7 2 -3 T*/ }T
T{ MAX-INT 2 MAX-INT */ -> MAX-INT 2 MAX-INT T*/ }T
T{ MIN-INT 2 MIN-INT */ -> MIN-INT 2 MIN-INT T*/ }T
IFSYM : T*/MOD >R M* R> SM/REM ;
T{ 0 2 1 */MOD -> 0 2 1 T*/MOD }T
T{ 1 2 1 */MOD -> 1 2 1 T*/MOD }T
T{ 2 2 1 */MOD -> 2 2 1 T*/MOD }T
T{ -1 2 1 */MOD -> -1 2 1 T*/MOD }T
T{ -2 2 1 */MOD -> -2 2 1 T*/MOD }T
T{ 0 2 -1 */MOD -> 0 2 -1 T*/MOD }T
T{ 1 2 -1 */MOD -> 1 2 -1 T*/MOD }T
T{ 2 2 -1 */MOD -> 2 2 -1 T*/MOD }T
T{ -1 2 -1 */MOD -> -1 2 -1 T*/MOD }T
T{ -2 2 -1 */MOD -> -2 2 -1 T*/MOD }T
T{ 2 2 2 */MOD -> 2 2 2 T*/MOD }T
T{ -1 2 -1 */MOD -> -1 2 -1 T*/MOD }T
T{ -2 2 -2 */MOD -> -2 2 -2 T*/MOD }T
T{ 7 2 3 */MOD -> 7 2 3 T*/MOD }T
T{ 7 2 -3 */MOD -> 7 2 -3 T*/MOD }T
T{ -7 2 3 */MOD -> -7 2 3 T*/MOD }T
T{ -7 2 -3 */MOD -> -7 2 -3 T*/MOD }T
T{ MAX-INT 2 MAX-INT */MOD -> MAX-INT 2 MAX-INT T*/MOD }T
T{ MIN-INT 2 MIN-INT */MOD -> MIN-INT 2 MIN-INT T*/MOD }T
T{ 5 0 + -> 5 }T
T{ 0 -5 + -> -5 }T
T{ -5 0 + -> -5 }T
T{ 1 2 + -> 3 }T
T{ 1 -2 + -> -1 }T
T{ -1 2 + -> 1 }T
T{ -1 -2 + -> -3 }T
T{ -1 1 + -> 0 }T
T{ MID-UINT 1 + -> MID-UINT+1 }T
T{ 1 4 GD2 -> 4 3 2 1 }T
T{ -1 2 GD2 -> 2 1 0 -1 }T
T{ MID-UINT MID-UINT+1 GD2 -> MID-UINT+1 MID-UINT }T
VARIABLE gditerations
VARIABLE gdincrement
: gd7 ( limit start increment -- )
gdincrement !
0 gditerations !
DO
1 gditerations +!
I
gditerations @ 6 = IF LEAVE THEN
gdincrement @
+LOOP gditerations @
;
T{ 4 4 -1 gd7 -> 4 1 }T
T{ 1 4 -1 gd7 -> 4 3 2 1 4 }T
T{ 4 1 -1 gd7 -> 1 0 -1 -2 -3 -4 6 }T
T{ 4 1 0 gd7 -> 1 1 1 1 1 1 6 }T
T{ 0 0 0 gd7 -> 0 0 0 0 0 0 6 }T
T{ 1 4 0 gd7 -> 4 4 4 4 4 4 6 }T
T{ 1 4 1 gd7 -> 4 5 6 7 8 9 6 }T
T{ 4 1 1 gd7 -> 1 2 3 3 }T
T{ 4 4 1 gd7 -> 4 5 6 7 8 9 6 }T
T{ 2 -1 -1 gd7 -> -1 -2 -3 -4 -5 -6 6 }T
T{ -1 2 -1 gd7 -> 2 1 0 -1 4 }T
T{ 2 -1 0 gd7 -> -1 -1 -1 -1 -1 -1 6 }T
T{ -1 2 0 gd7 -> 2 2 2 2 2 2 6 }T
T{ -1 2 1 gd7 -> 2 3 4 5 6 7 6 }T
T{ 2 -1 1 gd7 -> -1 0 1 3 }T
T{ -20 30 -10 gd7 -> 30 20 10 0 -10 -20 6 }T
T{ -20 31 -10 gd7 -> 31 21 11 1 -9 -19 6 }T
T{ -20 29 -10 gd7 -> 29 19 9 -1 -11 5 }T
\ With large and small increments
MAX-UINT 8 RSHIFT 1+ CONSTANT ustep
ustep NEGATE CONSTANT -ustep
MAX-INT 7 RSHIFT 1+ CONSTANT step
step NEGATE CONSTANT -step
VARIABLE bump
T{ : gd8 bump ! DO 1+ bump @ +LOOP ; -> }T
T{ 0 MAX-UINT 0 ustep gd8 -> 256 }T
T{ 0 0 MAX-UINT -ustep gd8 -> 256 }T
T{ 0 MAX-INT MIN-INT step gd8 -> 256 }T
T{ 0 MIN-INT MAX-INT -step gd8 -> 256 }T
HERE 2 ,
CONSTANT 2ND
CONSTANT 1ST
T{ 1ST 2ND U< -> <TRUE> }T \ HERE MUST GROW WITH ALLOT
T{ 1ST CELL+ -> 2ND }T \ ... BY ONE CELL
T{ 1ST 1 CELLS + -> 2ND }T
T{ 1ST @ 2ND @ -> 1 2 }T
T{ 5 1ST ! -> }T
T{ 1ST @ 2ND @ -> 5 2 }T
T{ 6 2ND ! -> }T
T{ 1ST @ 2ND @ -> 5 6 }T
T{ 1ST 2@ -> 6 5 }T
T{ 2 1 1ST 2! -> }T
T{ 1ST 2@ -> 2 1 }T
T{ 1S 1ST ! 1ST @ -> 1S }T \ CAN STORE CELL-WIDE VALUE
T{ 5 0 - -> 5 }T
T{ 0 -5 - -> 5 }T
T{ -5 0 - -> -5 }T
T{ 1 2 - -> -1 }T
T{ 1 -2 - -> 3 }T
T{ -1 2 - -> -3 }T
T{ -1 -2 - -> 1 }T
T{ 0 1 - -> -1 }T
T{ MID-UINT+1 1 - -> MID-UINT }T
See F.6.1.1320 EMIT.
IFSYM : T/ T/MOD SWAP DROP ;
T{ 0 1 / -> 0 1 T/ }T
T{ 1 1 / -> 1 1 T/ }T
T{ 2 1 / -> 2 1 T/ }T
T{ -1 1 / -> -1 1 T/ }T
T{ -2 1 / -> -2 1 T/ }T
T{ 0 -1 / -> 0 -1 T/ }T
T{ 1 -1 / -> 1 -1 T/ }T
T{ 2 -1 / -> 2 -1 T/ }T
T{ -1 -1 / -> -1 -1 T/ }T
T{ -2 -1 / -> -2 -1 T/ }T
T{ 2 2 / -> 2 2 T/ }T
T{ -1 -1 / -> -1 -1 T/ }T
T{ -2 -2 / -> -2 -2 T/ }T
T{ 7 3 / -> 7 3 T/ }T
T{ 7 -3 / -> 7 -3 T/ }T
T{ -7 3 / -> -7 3 T/ }T
T{ -7 -3 / -> -7 -3 T/ }T
T{ MAX-INT 1 / -> MAX-INT 1 T/ }T
T{ MIN-INT 1 / -> MIN-INT 1 T/ }T
T{ MAX-INT MAX-INT / -> MAX-INT MAX-INT T/ }T
T{ MIN-INT MIN-INT / -> MIN-INT MIN-INT T/ }T
IFSYM : T/MOD >R S>D R> SM/REM ;
T{ 0 1 /MOD -> 0 1 T/MOD }T
T{ 1 1 /MOD -> 1 1 T/MOD }T
T{ 2 1 /MOD -> 2 1 T/MOD }T
T{ -1 1 /MOD -> -1 1 T/MOD }T
T{ -2 1 /MOD -> -2 1 T/MOD }T
T{ 0 -1 /MOD -> 0 -1 T/MOD }T
T{ 1 -1 /MOD -> 1 -1 T/MOD }T
T{ 2 -1 /MOD -> 2 -1 T/MOD }T
T{ -1 -1 /MOD -> -1 -1 T/MOD }T
T{ -2 -1 /MOD -> -2 -1 T/MOD }T
T{ 2 2 /MOD -> 2 2 T/MOD }T
T{ -1 -1 /MOD -> -1 -1 T/MOD }T
T{ -2 -2 /MOD -> -2 -2 T/MOD }T
T{ 7 3 /MOD -> 7 3 T/MOD }T
T{ 7 -3 /MOD -> 7 -3 T/MOD }T
T{ -7 3 /MOD -> -7 3 T/MOD }T
T{ -7 -3 /MOD -> -7 -3 T/MOD }T
T{ MAX-INT 1 /MOD -> MAX-INT 1 T/MOD }T
T{ MIN-INT 1 /MOD -> MIN-INT 1 T/MOD }T
T{ MAX-INT MAX-INT /MOD -> MAX-INT MAX-INT T/MOD }T
T{ MIN-INT MIN-INT /MOD -> MIN-INT MIN-INT T/MOD }T
T{ -1 0< -> <TRUE> }T
T{ MIN-INT 0< -> <TRUE> }T
T{ 1 0< -> <FALSE> }T
T{ MAX-INT 0< -> <FALSE> }T
T{ 1 0= -> <FALSE> }T
T{ 2 0= -> <FALSE> }T
T{ -1 0= -> <FALSE> }T
T{ MAX-UINT 0= -> <FALSE> }T
T{ MIN-INT 0= -> <FALSE> }T
T{ MAX-INT 0= -> <FALSE> }T
T{ -1 1+ -> 0 }T
T{ 1 1+ -> 2 }T
T{ MID-UINT 1+ -> MID-UINT+1 }T
T{ 1 1- -> 0 }T
T{ 0 1- -> -1 }T
T{ MID-UINT+1 1- -> MID-UINT }T
T{ 1 2 < -> <TRUE> }T
T{ -1 0 < -> <TRUE> }T
T{ -1 1 < -> <TRUE> }T
T{ MIN-INT 0 < -> <TRUE> }T
T{ MIN-INT MAX-INT < -> <TRUE> }T
T{ 0 MAX-INT < -> <TRUE> }T
T{ 0 0 < -> <FALSE> }T
T{ 1 1 < -> <FALSE> }T
T{ 1 0 < -> <FALSE> }T
T{ 2 1 < -> <FALSE> }T
T{ 0 -1 < -> <FALSE> }T
T{ 1 -1 < -> <FALSE> }T
T{ 0 MIN-INT < -> <FALSE> }T
T{ MAX-INT MIN-INT < -> <FALSE> }T
T{ MAX-INT 0 < -> <FALSE> }T
T{ 1 1 = -> <TRUE> }T
T{ -1 -1 = -> <TRUE> }T
T{ 1 0 = -> <FALSE> }T
T{ -1 0 = -> <FALSE> }T
T{ 0 1 = -> <FALSE> }T
T{ 0 -1 = -> <FALSE> }T
T{ 1 2 > -> <FALSE> }T
T{ -1 0 > -> <FALSE> }T
T{ -1 1 > -> <FALSE> }T
T{ MIN-INT 0 > -> <FALSE> }T
T{ MIN-INT MAX-INT > -> <FALSE> }T
T{ 0 MAX-INT > -> <FALSE> }T
T{ 0 0 > -> <FALSE> }T
T{ 1 1 > -> <FALSE> }T
T{ 1 0 > -> <TRUE> }T
T{ 2 1 > -> <TRUE> }T
T{ 0 -1 > -> <TRUE> }T
T{ 1 -1 > -> <TRUE> }T
T{ 0 MIN-INT > -> <TRUE> }T
T{ MAX-INT MIN-INT > -> <TRUE> }T
T{ MAX-INT 0 > -> <TRUE> }T
: RESCAN? -1 SCANS +! SCANS @ IF 0 >IN ! THEN ;
T{ 2 SCANS !
345 RESCAN?
-> 345 345 }T
: GS2 5 SCANS ! S" 123 RESCAN?" EVALUATE ;
T{ GS2 -> 123 123 123 123 123 }T
\ These tests must start on a new line
DECIMAL
T{ 123456 DEPTH OVER 9 < 35 AND + 3 + >IN !
-> 123456 23456 3456 456 56 6 }T
T{ 14145 8115 ?DUP 0= 34 AND >IN +! TUCK MOD 14 >IN ! GCD calculation
-> 15 }T
: GN-STRING GN-BUF 1 ;
: GN-CONSUMED GN-BUF CHAR+ 0 ;
: GN' [CHAR] ' WORD CHAR+ C@ GN-BUF C! GN-STRING ;
T{ 0 0 GN' 0' >NUMBER -> 0 0 GN-CONSUMED }T
T{ 0 0 GN' 1' >NUMBER -> 1 0 GN-CONSUMED }T
T{ 1 0 GN' 1' >NUMBER -> BASE @ 1+ 0 GN-CONSUMED }T
\ FOLLOWING SHOULD FAIL TO CONVERT
T{ 0 0 GN' -' >NUMBER -> 0 0 GN-STRING }T
T{ 0 0 GN' +' >NUMBER -> 0 0 GN-STRING }T
T{ 0 0 GN' .' >NUMBER -> 0 0 GN-STRING }T
: >NUMBER-BASED
BASE @ >R BASE ! >NUMBER R> BASE ! ;
T{ 0 0 GN' 2' 10 >NUMBER-BASED -> 2 0 GN-CONSUMED }T
T{ 0 0 GN' 2' 2 >NUMBER-BASED -> 0 0 GN-STRING }T
T{ 0 0 GN' F' 10 >NUMBER-BASED -> F 0 GN-CONSUMED }T
T{ 0 0 GN' G' 10 >NUMBER-BASED -> 0 0 GN-STRING }T
T{ 0 0 GN' G' MAX-BASE >NUMBER-BASED -> 10 0 GN-CONSUMED }T
T{ 0 0 GN' Z' MAX-BASE >NUMBER-BASED -> 23 0 GN-CONSUMED }T
: GN1 ( UD BASE -- UD' LEN )
\ UD SHOULD EQUAL UD' AND LEN SHOULD BE ZERO.
BASE @ >R BASE !
<# #S #>
0 0 2SWAP >NUMBER SWAP DROP \ RETURN LENGTH ONLY
R> BASE ! ;
T{ 0 0 2 GN1 -> 0 0 0 }T
T{ MAX-UINT 0 2 GN1 -> MAX-UINT 0 0 }T
T{ MAX-UINT DUP 2 GN1 -> MAX-UINT DUP 0 }T
T{ 0 0 MAX-BASE GN1 -> 0 0 0 }T
T{ MAX-UINT 0 MAX-BASE GN1 -> MAX-UINT 0 0 }T
T{ MAX-UINT DUP MAX-BASE GN1 -> MAX-UINT DUP 0 }T
T{ 0 ?DUP -> 0 }T
T{ 1 ?DUP -> 1 1 }T
T{ 1 ABS -> 1 }T
T{ -1 ABS -> 1 }T
T{ MIN-INT ABS -> MID-UINT+1 }T
CONSTANT A-ADDR CONSTANT UA-ADDR
T{ UA-ADDR ALIGNED -> A-ADDR }T
T{ 1 A-ADDR C! A-ADDR C@ -> 1 }T
T{ 1234 A-ADDR ! A-ADDR @ -> 1234 }T
T{ 123 456 A-ADDR 2! A-ADDR 2@ -> 123 456 }T
T{ 2 A-ADDR CHAR+ C! A-ADDR CHAR+ C@ -> 2 }T
T{ 3 A-ADDR CELL+ C! A-ADDR CELL+ C@ -> 3 }T
T{ 1234 A-ADDR CELL+ ! A-ADDR CELL+ @ -> 1234 }T
T{ 123 456 A-ADDR CELL+ 2! A-ADDR CELL+ 2@ -> 123 456 }T
HERE 2 C,
CONSTANT 2NDC
CONSTANT 1STC
T{ 1STC 2NDC U< -> <TRUE> }T \ HERE MUST GROW WITH ALLOT
T{ 1STC CHAR+ -> 2NDC }T \ ... BY ONE CHAR
T{ 1STC 1 CHARS + -> 2NDC }T
T{ 1STC C@ 2NDC C@ -> 1 2 }T
T{ 3 1STC C! -> }T
T{ 1STC C@ 2NDC C@ -> 3 2 }T
T{ 4 2NDC C! -> }T
T{ 1STC C@ 2NDC C@ -> 3 4 }T
T{ CHAR HELLO -> 48 }T
T{ 0 DEPTH -> 0 1 }T
T{ DEPTH -> 0 }T
T{ : DOES2 DOES> @ 2 + ; -> }T
T{ CREATE CR1 -> }T
T{ CR1 -> HERE }T
T{ 1 , -> }T
T{ CR1 @ -> 1 }T
T{ DOES1 -> }T
T{ CR1 -> 2 }T
T{ DOES2 -> }T
T{ CR1 -> 3 }T
T{ : WEIRD: CREATE DOES> 1 + DOES> 2 + ; -> }T
T{ WEIRD: W1 -> }T
T{ ' W1 >BODY -> HERE }T
T{ W1 -> HERE 1 + }T
T{ W1 -> HERE 2 + }T
T{ 0 DROP -> }T
." YOU SHOULD SEE THE STANDARD GRAPHIC CHARACTERS:" CR
41 BL DO I EMIT LOOP CR
61 41 DO I EMIT LOOP CR
7F 61 DO I EMIT LOOP CR
." YOU SHOULD SEE 0-9 SEPARATED BY A SPACE:" CR
9 1+ 0 DO I . LOOP CR
." YOU SHOULD SEE 0-9 (WITH NO SPACES):" CR
[CHAR] 9 1+ [CHAR] 0 DO I 0 SPACES EMIT LOOP CR
." YOU SHOULD SEE A-G SEPARATED BY A SPACE:" CR
[CHAR] G 1+ [CHAR] A DO I EMIT SPACE LOOP CR
." YOU SHOULD SEE 0-5 SEPARATED BY TWO SPACES:" CR
5 1+ 0 DO I [CHAR] 0 + EMIT 2 SPACES LOOP CR
." YOU SHOULD SEE TWO SEPARATE LINES:" CR
S" LINE 1" TYPE CR S" LINE 2" TYPE CR
." YOU SHOULD SEE THE NUMBER RANGES OF SIGNED AND UNSIGNED NUMBERS:" CR
." SIGNED: " MIN-INT . MAX-INT . CR
." UNSIGNED: " 0 U. MAX-UINT U. CR
;
T{ OUTPUT-TEST -> }T
: GE2 S" 123 1+" ; IMMEDIATE
: GE3 S" : GE4 345 ;" ;
: GE5 EVALUATE ; IMMEDIATE
T{ GE1 EVALUATE -> 123 }T ( TEST EVALUATE IN INTERP. STATE )
T{ GE2 EVALUATE -> 124 }T
T{ GE3 EVALUATE -> }T
T{ GE4 -> 345 }T
T{ : GE6 GE1 GE5 ; -> }T ( TEST EVALUATE IN COMPILE STATE )
T{ GE6 -> 123 }T
T{ : GE7 GE2 GE5 ; -> }T
T{ GE7 -> 124 }T
See F.9.3.6 for additional test.
T{ SEEBUF -> 00 00 00 }T
T{ FBUF 1 20 FILL -> }T
T{ SEEBUF -> 20 00 00 }T
T{ FBUF 3 20 FILL -> }T
T{ SEEBUF -> 20 20 20 }T
T{ 1 S>D 1 FM/MOD -> 0 1 }T
T{ 2 S>D 1 FM/MOD -> 0 2 }T
T{ -1 S>D 1 FM/MOD -> 0 -1 }T
T{ -2 S>D 1 FM/MOD -> 0 -2 }T
T{ 0 S>D -1 FM/MOD -> 0 0 }T
T{ 1 S>D -1 FM/MOD -> 0 -1 }T
T{ 2 S>D -1 FM/MOD -> 0 -2 }T
T{ -1 S>D -1 FM/MOD -> 0 1 }T
T{ -2 S>D -1 FM/MOD -> 0 2 }T
T{ 2 S>D 2 FM/MOD -> 0 1 }T
T{ -1 S>D -1 FM/MOD -> 0 1 }T
T{ -2 S>D -2 FM/MOD -> 0 1 }T
T{ 7 S>D 3 FM/MOD -> 1 2 }T
T{ 7 S>D -3 FM/MOD -> -2 -3 }T
T{ -7 S>D 3 FM/MOD -> 2 -3 }T
T{ -7 S>D -3 FM/MOD -> -1 2 }T
T{ MAX-INT S>D 1 FM/MOD -> 0 MAX-INT }T
T{ MIN-INT S>D 1 FM/MOD -> 0 MIN-INT }T
T{ MAX-INT S>D MAX-INT FM/MOD -> 0 1 }T
T{ MIN-INT S>D MIN-INT FM/MOD -> 0 1 }T
T{ 1S 1 4 FM/MOD -> 3 MAX-INT }T
T{ 1 MIN-INT M* 1 FM/MOD -> 0 MIN-INT }T
T{ 1 MIN-INT M* MIN-INT FM/MOD -> 0 1 }T
T{ 2 MIN-INT M* 2 FM/MOD -> 0 MIN-INT }T
T{ 2 MIN-INT M* MIN-INT FM/MOD -> 0 2 }T
T{ 1 MAX-INT M* 1 FM/MOD -> 0 MAX-INT }T
T{ 1 MAX-INT M* MAX-INT FM/MOD -> 0 1 }T
T{ 2 MAX-INT M* 2 FM/MOD -> 0 MAX-INT }T
T{ 2 MAX-INT M* MAX-INT FM/MOD -> 0 2 }T
T{ MIN-INT MIN-INT M* MIN-INT FM/MOD -> 0 MIN-INT }T
T{ MIN-INT MAX-INT M* MIN-INT FM/MOD -> 0 MAX-INT }T
T{ MIN-INT MAX-INT M* MAX-INT FM/MOD -> 0 MIN-INT }T
T{ MAX-INT MAX-INT M* MAX-INT FM/MOD -> 0 MAX-INT }T
T{ : GI2 IF 123 ELSE 234 THEN ; -> }T
T{ 0 GI1 -> }T
T{ 1 GI1 -> 123 }T
T{ -1 GI1 -> 123 }T
T{ 0 GI2 -> 234 }T
T{ 1 GI2 -> 123 }T
T{ -1 GI1 -> 123 }T
\ Multiple ELSEs in an IF statement
: melse IF 1 ELSE 2 ELSE 3 ELSE 4 ELSE 5 THEN ;
T{ <FALSE> melse -> 2 4 }T
T{ <TRUE> melse -> 1 3 5 }T
T{ : iw2 iw1 LITERAL ; iw2 -> 123 }T
T{ VARIABLE iw3 IMMEDIATE 234 iw3 ! iw3 @ -> 234 }T
T{ : iw4 iw3 [ @ ] LITERAL ; iw4 -> 234 }T
T{ :NONAME [ 345 ] iw3 [ ! ] ; DROP iw3 @ -> 345 }T
T{ CREATE iw5 456 , IMMEDIATE -> }T
T{ :NONAME iw5 [ @ iw3 ! ] ; DROP iw3 @ -> 456 }T
T{ : iw6 CREATE , IMMEDIATE DOES> @ 1+ ; -> }T
T{ 111 iw6 iw7 iw7 -> 112 }T
T{ : iw8 iw7 LITERAL 1+ ; iw8 -> 113 }T
T{ : iw9 CREATE , DOES> @ 2 + IMMEDIATE ; -> }T
: find-iw BL WORD FIND NIP ;
T{ 222 iw9 iw10 find-iw iw10 -> -1 }T \ iw10 is not immediate
T{ iw10 find-iw iw10 -> 224 1 }T \ iw10 becomes immediate
See F.6.1.2510 ['], F.6.1.2033 POSTPONE, F.6.1.2250 STATE, F.6.1.2165 S".
T{ 1S INVERT -> 0S }T
T{ 0 1 M* -> 0 S>D }T
T{ 1 0 M* -> 0 S>D }T
T{ 1 2 M* -> 2 S>D }T
T{ 2 1 M* -> 2 S>D }T
T{ 3 3 M* -> 9 S>D }T
T{ -3 3 M* -> -9 S>D }T
T{ 3 -3 M* -> -9 S>D }T
T{ -3 -3 M* -> 9 S>D }T
T{ 0 MIN-INT M* -> 0 S>D }T
T{ 1 MIN-INT M* -> MIN-INT S>D }T
T{ 2 MIN-INT M* -> 0 1S }T
T{ 0 MAX-INT M* -> 0 S>D }T
T{ 1 MAX-INT M* -> MAX-INT S>D }T
T{ 2 MAX-INT M* -> MAX-INT 1 LSHIFT 0 }T
T{ MIN-INT MIN-INT M* -> 0 MSB 1 RSHIFT }T
T{ MAX-INT MIN-INT M* -> MSB MSB 2/ }T
T{ MAX-INT MAX-INT M* -> 1 MSB 2/ INVERT }T
T{ 1 2 MAX -> 2 }T
T{ -1 0 MAX -> 0 }T
T{ -1 1 MAX -> 1 }T
T{ MIN-INT 0 MAX -> 0 }T
T{ MIN-INT MAX-INT MAX -> MAX-INT }T
T{ 0 MAX-INT MAX -> MAX-INT }T
T{ 0 0 MAX -> 0 }T
T{ 1 1 MAX -> 1 }T
T{ 1 0 MAX -> 1 }T
T{ 2 1 MAX -> 2 }T
T{ 0 -1 MAX -> 0 }T
T{ 1 -1 MAX -> 1 }T
T{ 0 MIN-INT MAX -> 0 }T
T{ MAX-INT MIN-INT MAX -> MAX-INT }T
T{ MAX-INT 0 MAX -> MAX-INT }T
T{ 1 2 MIN -> 1 }T
T{ -1 0 MIN -> -1 }T
T{ -1 1 MIN -> -1 }T
T{ MIN-INT 0 MIN -> MIN-INT }T
T{ MIN-INT MAX-INT MIN -> MIN-INT }T
T{ 0 MAX-INT MIN -> 0 }T
T{ 0 0 MIN -> 0 }T
T{ 1 1 MIN -> 1 }T
T{ 1 0 MIN -> 0 }T
T{ 2 1 MIN -> 1 }T
T{ 0 -1 MIN -> -1 }T
T{ 1 -1 MIN -> -1 }T
T{ 0 MIN-INT MIN -> MIN-INT }T
T{ MAX-INT MIN-INT MIN -> MIN-INT }T
T{ MAX-INT 0 MIN -> 0 }T
IFSYM : TMOD T/MOD DROP ;
T{ 0 1 MOD -> 0 1 TMOD }T
T{ 1 1 MOD -> 1 1 TMOD }T
T{ 2 1 MOD -> 2 1 TMOD }T
T{ -1 1 MOD -> -1 1 TMOD }T
T{ -2 1 MOD -> -2 1 TMOD }T
T{ 0 -1 MOD -> 0 -1 TMOD }T
T{ 1 -1 MOD -> 1 -1 TMOD }T
T{ 2 -1 MOD -> 2 -1 TMOD }T
T{ -1 -1 MOD -> -1 -1 TMOD }T
T{ -2 -1 MOD -> -2 -1 TMOD }T
T{ 2 2 MOD -> 2 2 TMOD }T
T{ -1 -1 MOD -> -1 -1 TMOD }T
T{ -2 -2 MOD -> -2 -2 TMOD }T
T{ 7 3 MOD -> 7 3 TMOD }T
T{ 7 -3 MOD -> 7 -3 TMOD }T
T{ -7 3 MOD -> -7 3 TMOD }T
T{ -7 -3 MOD -> -7 -3 TMOD }T
T{ MAX-INT 1 MOD -> MAX-INT 1 TMOD }T
T{ MIN-INT 1 MOD -> MIN-INT 1 TMOD }T
T{ MAX-INT MAX-INT MOD -> MAX-INT MAX-INT TMOD }T
T{ MIN-INT MIN-INT MOD -> MIN-INT MIN-INT TMOD }T
T{ SEEBUF -> 20 20 20 }T
T{ SBUF FBUF 0 CHARS MOVE -> }T
T{ SEEBUF -> 20 20 20 }T
T{ SBUF FBUF 1 CHARS MOVE -> }T
T{ SEEBUF -> 12 20 20 }T
T{ SBUF FBUF 3 CHARS MOVE -> }T
T{ SEEBUF -> 12 34 56 }T
T{ FBUF FBUF CHAR+ 2 CHARS MOVE -> }T
T{ SEEBUF -> 12 12 34 }T
T{ FBUF CHAR+ FBUF 2 CHARS MOVE -> }T
T{ SEEBUF -> 12 34 34 }T
T{ 1 NEGATE -> -1 }T
T{ -1 NEGATE -> 1 }T
T{ 2 NEGATE -> -2 }T
T{ -2 NEGATE -> 2 }T
T{ 0S 1S OR -> 1S }T
T{ 1S 0S OR -> 1S }T
T{ 1S 1S OR -> 1S }T
DUP IF DUP >R 1- RECURSE R> THEN ; -> }T
T{ 0 GI6 -> 0 }T
T{ 1 GI6 -> 0 1 }T
T{ 2 GI6 -> 0 1 2 }T
T{ 3 GI6 -> 0 1 2 3 }T
T{ 4 GI6 -> 0 1 2 3 4 }T
DECIMAL
T{ :NONAME ( n -- 0, 1, .., n )
DUP IF DUP >R 1- RECURSE R> THEN
;
CONSTANT rn1 -> }T
T{ 0 rn1 EXECUTE -> 0 }T
T{ 4 rn1 EXECUTE -> 0 1 2 3 4 }T
:NONAME ( n -- n1 )
1- DUP
CASE 0 OF EXIT ENDOF
1 OF 11 SWAP RECURSE ENDOF
2 OF 22 SWAP RECURSE ENDOF
3 OF 33 SWAP RECURSE ENDOF
DROP ABS RECURSE EXIT
ENDCASE
; CONSTANT rn2
T{ 1 rn2 EXECUTE -> 0 }T
T{ 2 rn2 EXECUTE -> 11 0 }T
T{ 4 rn2 EXECUTE -> 33 22 11 0 }T
T{ 25 rn2 EXECUTE -> 33 22 11 0 }T
T{ 1 S>D -> 1 0 }T
T{ 2 S>D -> 2 0 }T
T{ -1 S>D -> -1 -1 }T
T{ -2 S>D -> -2 -1 }T
T{ MIN-INT S>D -> MIN-INT -1 }T
T{ MAX-INT S>D -> MAX-INT 0 }T
T{ 1 S>D 1 SM/REM -> 0 1 }T
T{ 2 S>D 1 SM/REM -> 0 2 }T
T{ -1 S>D 1 SM/REM -> 0 -1 }T
T{ -2 S>D 1 SM/REM -> 0 -2 }T
T{ 0 S>D -1 SM/REM -> 0 0 }T
T{ 1 S>D -1 SM/REM -> 0 -1 }T
T{ 2 S>D -1 SM/REM -> 0 -2 }T
T{ -1 S>D -1 SM/REM -> 0 1 }T
T{ -2 S>D -1 SM/REM -> 0 2 }T
T{ 2 S>D 2 SM/REM -> 0 1 }T
T{ -1 S>D -1 SM/REM -> 0 1 }T
T{ -2 S>D -2 SM/REM -> 0 1 }T
T{ 7 S>D 3 SM/REM -> 1 2 }T
T{ 7 S>D -3 SM/REM -> 1 -2 }T
T{ -7 S>D 3 SM/REM -> 1 -2 }T
T{ -7 S>D -3 SM/REM -> -1 2 }T
T{ MAX-INT S>D 1 SM/REM -> 0 MAX-INT }T
T{ MIN-INT S>D 1 SM/REM -> 0 MIN-INT }T
T{ MAX-INT S>D MAX-INT SM/REM -> 0 1 }T
T{ MIN-INT S>D MIN-INT SM/REM -> 0 1 }T
T{ 1S 1 4 SM/REM -> 3 MAX-INT }T
T{ 2 MIN-INT M* 2 SM/REM -> 0 MIN-INT }T
T{ 2 MIN-INT M* MIN-INT SM/REM -> 0 2 }T
T{ 2 MAX-INT M* 2 SM/REM -> 0 MAX-INT }T
T{ 2 MAX-INT M* MAX-INT SM/REM -> 0 2 }T
T{ MIN-INT MIN-INT M* MIN-INT SM/REM -> 0 MIN-INT }T
T{ MIN-INT MAX-INT M* MIN-INT SM/REM -> 0 MAX-INT }T
T{ MIN-INT MAX-INT M* MAX-INT SM/REM -> 0 MIN-INT }T
T{ MAX-INT MAX-INT M* MAX-INT SM/REM -> 0 MAX-INT }T
T{ 1 2 U< -> <TRUE> }T
T{ 0 MID-UINT U< -> <TRUE> }T
T{ 0 MAX-UINT U< -> <TRUE> }T
T{ MID-UINT MAX-UINT U< -> <TRUE> }T
T{ 0 0 U< -> <FALSE> }T
T{ 1 1 U< -> <FALSE> }T
T{ 1 0 U< -> <FALSE> }T
T{ 2 1 U< -> <FALSE> }T
T{ MID-UINT 0 U< -> <FALSE> }T
T{ MAX-UINT 0 U< -> <FALSE> }T
T{ MAX-UINT MID-UINT U< -> <FALSE> }T
T{ 0 1 UM* -> 0 0 }T
T{ 1 0 UM* -> 0 0 }T
T{ 1 2 UM* -> 2 0 }T
T{ 2 1 UM* -> 2 0 }T
T{ 3 3 UM* -> 9 0 }T
T{ MID-UINT+1 1 RSHIFT 2 UM* -> MID-UINT+1 0 }T
T{ MID-UINT+1 2 UM* -> 0 1 }T
T{ MID-UINT+1 4 UM* -> 0 2 }T
T{ 1S 2 UM* -> 1S 1 LSHIFT 1 }T
T{ MAX-UINT MAX-UINT UM* -> 1 1 INVERT }T
T{ 0 GI3 -> 0 1 2 3 4 5 }T
T{ 4 GI3 -> 4 5 }T
T{ 5 GI3 -> 5 }T
T{ 6 GI3 -> 6 }T
T{ : GI5 BEGIN DUP 2 > WHILE
DUP 5 < WHILE DUP 1+ REPEAT
123 ELSE 345 THEN ; -> }T
T{ 1 GI5 -> 1 345 }T
T{ 2 GI5 -> 2 345 }T
T{ 3 GI5 -> 3 4 5 123 }T
T{ 4 GI5 -> 4 5 123 }T
T{ 5 GI5 -> 5 123 }T
T{ 0S 1S XOR -> 1S }T
T{ 1S 0S XOR -> 1S }T
T{ 1S 1S XOR -> 0S }T
T{ : GC2 [CHAR] HELLO ; -> }T
T{ GC1 -> 58 }T
T{ GC2 -> 48 }T
: qd ?DO I LOOP ;
T{ 789 789 qd -> }T
T{ -9876 -9876 qd -> }T
T{ 5 0 qd -> 0 1 2 3 4 }T
: qd1 ?DO I 10 +LOOP ;
T{ 50 1 qd1 -> 1 11 21 31 41 }T
T{ 50 0 qd1 -> 0 10 20 30 40 }T
: qd2 ?DO I 3 > IF LEAVE ELSE I THEN LOOP ;
T{ 5 -1 qd2 -> -1 0 1 2 3 }T
: qd3 ?DO I 1 +LOOP ;
T{ 4 4 qd3 -> }T
T{ 4 1 qd3 -> 1 2 3 }T
T{ 2 -1 qd3 -> -1 0 1 }T
: qd4 ?DO I -1 +LOOP ;
T{ 4 4 qd4 -> }T
T{ 1 4 qd4 -> 4 3 2 1 }T
T{ -1 2 qd4 -> 2 1 0 -1 }T
: qd5 ?DO I -10 +LOOP ;
T{ 1 50 qd5 -> 50 40 30 20 10 }T
T{ 0 50 qd5 -> 50 40 30 20 10 0 }T
T{ -25 10 qd5 -> 10 0 -10 -20 }T
VARIABLE qditerations
VARIABLE qdincrement
: qd6 ( limit start increment -- )
qdincrement !
0 qditerations !
?DO
1 qditerations +!
I
qditerations @ 6 = IF LEAVE THEN
qdincrement @
+LOOP qditerations @
;
T{ 4 4 -1 qd6 -> 0 }T
T{ 1 4 -1 qd6 -> 4 3 2 1 4 }T
T{ 4 1 -1 qd6 -> 1 0 -1 -2 -3 -4 6 }T
T{ 4 1 0 qd6 -> 1 1 1 1 1 1 6 }T
T{ 0 0 0 qd6 -> 0 }T
T{ 1 4 0 qd6 -> 4 4 4 4 4 4 6 }T
T{ 1 4 1 qd6 -> 4 5 6 7 8 9 6 }T
T{ 4 1 1 qd6 -> 1 2 3 3 }T
T{ 4 4 1 qd6 -> 0 }T
T{ 2 -1 -1 qd6 -> -1 -2 -3 -4 -5 -6 6 }T
T{ -1 2 -1 qd6 -> 2 1 0 -1 4 }T
T{ 2 -1 0 qd6 -> -1 -1 -1 -1 -1 -1 6 }T
T{ -1 2 0 qd6 -> 2 2 2 2 2 2 6 }T
T{ -1 2 1 qd6 -> 2 3 4 5 6 7 6 }T
T{ 2 -1 1 qd6 -> -1 0 1 3 }T
T{ 127 CHARS BUFFER: TBUF1 -> }T
T{ 127 CHARS BUFFER: TBUF2 -> }T
\ Buffer is aligned
T{ TBUF1 ALIGNED -> TBUF1 }T
\ Buffers do not overlap
T{ TBUF2 TBUF1 - ABS 127 CHARS < -> <FALSE> }T
\ Buffer can be written to
1 CHARS CONSTANT /CHAR
: TFULL? ( c-addr n char -- flag )
TRUE 2SWAP CHARS OVER + SWAP ?DO
OVER I C@ = AND
/CHAR +LOOP NIP
;
T{ TBUF1 127 CHAR * FILL -> }T
T{ TBUF1 127 CHAR * TFULL? -> <TRUE> }T
T{ TBUF1 127 0 FILL -> }T
T{ TBUF1 127 0 TFULL? -> <TRUE> }T
2 OF 222 ENDOF
3 OF 333 ENDOF
>R 999 R>
ENDCASE
;
T{ 1 cs1 -> 111 }T
T{ 2 cs1 -> 222 }T
T{ 3 cs1 -> 333 }T
T{ 4 cs1 -> 999 }T
: cs2 >R CASE
-1 OF CASE R@ 1 OF 100 ENDOF
2 OF 200 ENDOF
>R -300 R>
ENDCASE
ENDOF
-2 OF CASE R@ 1 OF -99 ENDOF
>R -199 R>
ENDCASE
ENDOF
>R 299 R>
ENDCASE R> DROP
;
T{ -1 1 cs2 -> 100 }T
T{ -1 2 cs2 -> 200 }T
T{ -1 3 cs2 -> -300 }T
T{ -2 1 cs2 -> -99 }T
T{ -2 2 cs2 -> -199 }T
T{ 0 2 cs2 -> 299 }T
T{ FALSE -> <FALSE> }T
T{ PARSE-NAME abcde S" abcde" S= -> <TRUE> }T
\ test empty parse area
T{ PARSE-NAME
NIP -> 0 }T \ empty line
T{ PARSE-NAME
NIP -> 0 }T \ line with white space
T{ : parse-name-test ( "name1" "name2" -- n )
PARSE-NAME PARSE-NAME S= ; -> }T
T{ parse-name-test abcd abcd -> <TRUE> }T
T{ parse-name-test abcd abcd -> <TRUE> }T
T{ parse-name-test abcde abcdf -> <FALSE> }T
T{ parse-name-test abcdf abcde -> <FALSE> }T
T{ parse-name-test abcde abcde
-> <TRUE> }T
T{ parse-name-test abcde abcde
-> <TRUE> }T
\ line with white space
VARIABLE siv -1 siv !
: NeverExecuted
." This should never be executed" ABORT
;
11111 SAVE-INPUT
siv @
[IF]
0 siv !
RESTORE-INPUT
NeverExecuted
[ELSE]
\ Testing the ELSE part is executed
22222
[THEN]
T{ -> 11111 0 22222 }T \ 0 comes from RESTORE-INPUT
Testing with a string source
VARIABLE si_inc 0 si_inc !
: si1
si_inc @ >IN +!
15 si_inc !
;
: s$ S" SAVE-INPUT si1 RESTORE-INPUT 12345" ;
T{ s$ EVALUATE si_inc @ -> 0 2345 15 }T
Testing nesting
: read_a_line
REFILL 0=
ABORT" REFILL failed"
;
0 si_inc !
2VARIABLE 2res -1. 2res 2!
: si2
read_a_line
read_a_line
SAVE-INPUT
read_a_line
read_a_line
s$ EVALUATE 2res 2!
RESTORE-INPUT
;
WARNING: do not delete or insert lines of text after si2 is called otherwise the next test will fail
si2
33333 \ This line should be ignored
2res 2@ 44444 \ RESTORE-INPUT should return to this line
55555
T{ -> 0 0 2345 44444 55555 }T
T{ TRUE -> 0 INVERT }T
T{ : [c1] [COMPILE] DUP ; IMMEDIATE -> }T
T{ 123 [c1] -> 123 123 }T
With an immediate word
T{ : [c2] [COMPILE] [c1] ; -> }T
T{ 234 [c2] -> 234 234 }T
With special compilation semantics
T{ : [cif] [COMPILE] IF ; IMMEDIATE -> }T
T{ : [c3] [cif] 111 ELSE 222 THEN ; -> }T
T{ -1 [c3] -> 111 }T
T{ 0 [c3] -> 222 }T
F.8 The optional Double-Number word set
Two additional constants are defined to assist tests in this word set:
Before anything can be tested, the text interpreter must be tested (F.8.3.2). Once the F.8.6.1.0360 2CONSTANT test has been preformed we can also define a number of double constants:
The rest of the word set can be tesed: F.8.6.1.1230 DNEGATE, F.8.6.1.1040 D+, F.8.6.1.1050 D-, F.8.6.1.1075 D0<, F.8.6.1.1080 D0=, F.8.6.1.1090 D2*, F.8.6.1.1100 D2/, F.8.6.1.1110 D<, F.8.6.1.1120 D=, F.8.6.1.0390 2LITERAL, F.8.6.1.0440 2VARIABLE, F.8.6.1.1210 DMAX, F.8.6.1.1220 DMIN, F.8.6.1.1140 D>S, F.8.6.1.1160 DABS, F.8.6.1.1830 M+, F.8.6.1.1820 M*/ and F.8.6.1.1070 D.R which also tests D. before moving on to the existion words with the F.8.6.2.0420 2ROT and F.8.6.2.1270 DU< tests.
F.8.3.2 Text interpreter input number conversion
T{ 1. -> 1 0 }T
T{ -2. -> -2 -1 }T
T{ : rdl1 3. ; rdl1 -> 3 0 }T
T{ : rdl2 -4. ; rdl2 -> -4 -1 }T
T{ -5. 0. D+ -> -5. }T
T{ 1. 2. D+ -> 3. }T
T{ 1. -2. D+ -> -1. }T
T{ -1. 2. D+ -> 1. }T
T{ -1. -2. D+ -> -3. }T
T{ -1. 1. D+ -> 0. }T
T{ 0 0 0 5 D+ -> 0 5 }T \ mid range integers
T{ -1 5 0 0 D+ -> -1 5 }T
T{ 0 0 0 -5 D+ -> 0 -5 }T
T{ 0 -5 -1 0 D+ -> -1 -5 }T
T{ 0 1 0 2 D+ -> 0 3 }T
T{ -1 1 0 -2 D+ -> -1 -1 }T
T{ 0 -1 0 2 D+ -> 0 1 }T
T{ 0 -1 -1 -2 D+ -> -1 -3 }T
T{ -1 -1 0 1 D+ -> -1 0 }T
T{ MIN-INT 0 2DUP D+ -> 0 1 }T
T{ MIN-INT S>D MIN-INT 0 D+ -> 0 0 }T
T{ HI-2INT 1. D+ -> 0 HI-INT 1+ }T \ large double integers
T{ HI-2INT 2DUP D+ -> 1S 1- MAX-INT }T
T{ MAX-2INT MIN-2INT D+ -> -1. }T
T{ MAX-2INT LO-2INT D+ -> HI-2INT }T
T{ LO-2INT 2DUP D+ -> MIN-2INT }T
T{ HI-2INT MIN-2INT D+ 1. D+ -> LO-2INT }T
T{ 5. 0. D- -> 5. }T
T{ 0. -5. D- -> 5. }T
T{ 1. 2. D- -> -1. }T
T{ 1. -2. D- -> 3. }T
T{ -1. 2. D- -> -3. }T
T{ -1. -2. D- -> 1. }T
T{ -1. -1. D- -> 0. }T
T{ 0 0 0 5 D- -> 0 -5 }T \ mid-range integers
T{ -1 5 0 0 D- -> -1 5 }T
T{ 0 0 -1 -5 D- -> 1 4 }T
T{ 0 -5 0 0 D- -> 0 -5 }T
T{ -1 1 0 2 D- -> -1 -1 }T
T{ 0 1 -1 -2 D- -> 1 2 }T
T{ 0 -1 0 2 D- -> 0 -3 }T
T{ 0 -1 0 -2 D- -> 0 1 }T
T{ 0 0 0 1 D- -> 0 -1 }T
T{ MIN-INT 0 2DUP D- -> 0. }T
T{ MIN-INT S>D MAX-INT 0D- -> 1 1s }T
T{ MAX-2INT max-2INT D- -> 0. }T \ large integers
T{ MIN-2INT min-2INT D- -> 0. }T
T{ MAX-2INT hi-2INT D- -> lo-2INT DNEGATE }T
T{ HI-2INT lo-2INT D- -> max-2INT }T
T{ LO-2INT hi-2INT D- -> min-2INT 1. D+ }T
T{ MIN-2INT min-2INT D- -> 0. }T
T{ MIN-2INT lo-2INT D- -> lo-2INT }T
MIN-2INT 73 79 M*/ 2CONSTANT dbl2
: d>ascii ( d -- caddr u )
DUP >R <# DABS #S R> SIGN #> ( -- caddr1 u )
HERE SWAP 2DUP 2>R CHARS DUP ALLOT MOVE 2R>
;
dbl1 d>ascii 2CONSTANT "dbl1"
dbl2 d>ascii 2CONSTANT "dbl2"
: DoubleOutput
CR ." You should see lines duplicated:" CR
5 SPACES "dbl1" TYPE CR
5 SPACES dbl1 D. CR
8 SPACES "dbl1" DUP >R TYPE CR
5 SPACES dbl1 R> 3 + D.R CR
5 SPACES "dbl2" TYPE CR
5 SPACES dbl2 D. CR
10 SPACES "dbl2" DUP >R TYPE CR
5 SPACES dbl2 R> 5 + D.R CR
;
T{ DoubleOutput -> }T
T{ 1. D0< -> <FALSE> }T
T{ MIN-INT 0 D0< -> <FALSE> }T
T{ 0 MAX-INT D0< -> <FALSE> }T
T{ MAX-2INT D0< -> <FALSE> }T
T{ -1. D0< -> <TRUE> }T
T{ MIN-2INT D0< -> <TRUE> }T
T{ MIN-INT 0 D0= -> <FALSE> }T
T{ MAX-2INT D0= -> <FALSE> }T
T{ -1 MAX-INT D0= -> <FALSE> }T
T{ 0. D0= -> <TRUE> }T
T{ -1. D0= -> <FALSE> }T
T{ 0 MIN-INT D0= -> <FALSE> }T
T{ MIN-INT 0 D2* -> 0 1 }T
T{ HI-2INT D2* -> MAX-2INT 1. D- }T
T{ LO-2INT D2* -> MIN-2INT }T
T{ 1. D2/ -> 0. }T
T{ 0 1 D2/ -> MIN-INT 0 }T
T{ MAX-2INT D2/ -> HI-2INT }T
T{ -1. D2/ -> -1. }T
T{ MIN-2INT D2/ -> LO-2INT }T
T{ 0. 0. D< -> <FALSE> }T
T{ 1. 0. D< -> <FALSE> }T
T{ -1. 1. D< -> <TRUE> }T
T{ -1. 0. D< -> <TRUE> }T
T{ -2. -1. D< -> <TRUE> }T
T{ -1. -2. D< -> <FALSE> }T
T{ -1. MAX-2INT D< -> <TRUE> }T
T{ MIN-2INT MAX-2INT D< -> <TRUE> }T
T{ MAX-2INT -1. D< -> <FALSE> }T
T{ MAX-2INT MIN-2INT D< -> <FALSE> }T
T{ MAX-2INT 2DUP -1. D+ D< -> <FALSE> }T
T{ MIN-2INT 2DUP 1. D+ D< -> <TRUE> }T
T{ -1. 0. D= -> <FALSE> }T
T{ -1. 1. D= -> <FALSE> }T
T{ 0. -1. D= -> <FALSE> }T
T{ 0. 0. D= -> <TRUE> }T
T{ 0. 1. D= -> <FALSE> }T
T{ 1. -1. D= -> <FALSE> }T
T{ 1. 0. D= -> <FALSE> }T
T{ 1. 1. D= -> <TRUE> }T
T{ 0 -1 0 -1 D= -> <TRUE> }T
T{ 0 -1 0 0 D= -> <FALSE> }T
T{ 0 -1 0 1 D= -> <FALSE> }T
T{ 0 0 0 -1 D= -> <FALSE> }T
T{ 0 0 0 0 D= -> <TRUE> }T
T{ 0 0 0 1 D= -> <FALSE> }T
T{ 0 1 0 -1 D= -> <FALSE> }T
T{ 0 1 0 0 D= -> <FALSE> }T
T{ 0 1 0 1 D= -> <TRUE> }T
T{ MAX-2INT MIN-2INT D= -> <FALSE> }T
T{ MAX-2INT 0. D= -> <FALSE> }T
T{ MAX-2INT MAX-2INT D= -> <TRUE> }T
T{ MAX-2INT HI-2INT D= -> <FALSE> }T
T{ MAX-2INT MIN-2INT D= -> <FALSE> }T
T{ MIN-2INT MIN-2INT D= -> <TRUE> }T
T{ MIN-2INT LO-2INT D= -> <FALSE> }T
T{ MIN-2INT MAX-2INT D= -> <FALSE> }T
T{ -1234 -1 D>S -> -1234 }T
T{ MAX-INT 0 D>S -> MAX-INT }T
T{ MIN-INT -1 D>S -> MIN-INT }T
T{ -1. DABS -> 1. }T
T{ MAX-2INT DABS -> MAX-2INT }T
T{ MIN-2INT 1. D+ DABS -> MAX-2INT }T
T{ 1. 0. DMAX -> 1. }T
T{ 1. -1. DMAX -> 1. }T
T{ 1. 1. DMAX -> 1. }T
T{ 0. 1. DMAX -> 1. }T
T{ 0. -1. DMAX -> 0. }T
T{ -1. 1. DMAX -> 1. }T
T{ -1. -2. DMAX -> -1. }T
T{ MAX-2INT HI-2INT DMAX -> MAX-2INT }T
T{ MAX-2INT MIN-2INT DMAX -> MAX-2INT }T
T{ MIN-2INT MAX-2INT DMAX -> MAX-2INT }T
T{ MIN-2INT LO-2INT DMAX -> LO-2INT }T
T{ MAX-2INT 1. DMAX -> MAX-2INT }T
T{ MAX-2INT -1. DMAX -> MAX-2INT }T
T{ MIN-2INT 1. DMAX -> 1. }T
T{ MIN-2INT -1. DMAX -> -1. }T
T{ 1. 0. DMIN -> 0. }T
T{ 1. -1. DMIN -> -1. }T
T{ 1. 1. DMIN -> 1. }T
T{ 0. 1. DMIN -> 0. }T
T{ 0. -1. DMIN -> -1. }T
T{ -1. 1. DMIN -> -1. }T
T{ -1. -2. DMIN -> -2. }T
T{ MAX-2INT HI-2INT DMIN -> HI-2INT }T
T{ MAX-2INT MIN-2INT DMIN -> MIN-2INT }T
T{ MIN-2INT MAX-2INT DMIN -> MIN-2INT }T
T{ MIN-2INT LO-2INT DMIN -> MIN-2INT }T
T{ MAX-2INT 1. DMIN -> 1. }T
T{ MAX-2INT -1. DMIN -> -1. }T
T{ MIN-2INT 1. DMIN -> MIN-2INT }T
T{ MIN-2INT -1. DMIN -> MIN-2INT }T
: ?floored [ -3 2 / -2 = ] LITERAL IF 1. D- THEN ;
T{ 5. 7 11 M*/ -> 3. }T
T{ 5. -7 11 M*/ -> -3. ?floored }T
T{ -5. 7 11 M*/ -> -3. ?floored }T
T{ -5. -7 11 M*/ -> 3. }T
T{ MAX-2INT 8 16 M*/ -> HI-2INT }T
T{ MAX-2INT -8 16 M*/ -> HI-2INT DNEGATE ?floored }T
T{ MIN-2INT 8 16 M*/ -> LO-2INT }T
T{ MIN-2INT -8 16 M*/ -> LO-2INT DNEGATE }T
T{ MAX-2INT MAX-INT MAX-INT M*/ -> MAX-2INT }T
T{ MAX-2INT MAX-INT 2/ MAX-INT M*/ -> MAX-INT 1- HI-2INT NIP }T
T{ MIN-2INT LO-2INT NIP DUP NEGATE M*/ -> MIN-2INT }T
T{ MIN-2INT LO-2INT NIP 1- MAX-INT M*/ -> MIN-INT 3 + HI-2INT NIP 2 + }T
T{ MAX-2INT LO-2INT NIP DUP NEGATE M*/ -> MAX-2INT DNEGATE }T
T{ MIN-2INT MAX-INT DUP M*/ -> MIN-2INT }T
T{ MAX-2INT MIN-2INT 1. 2ROT -> MIN-2INT 1. MAX-2INT }T
T{ 1. -1. DU< -> <TRUE> }T
T{ -1. 1. DU< -> <FALSE> }T
T{ -1. -2. DU< -> <FALSE> }T
T{ MAX-2INT HI-2INT DU< -> <FALSE> }T
T{ HI-2INT MAX-2INT DU< -> <TRUE> }T
T{ MAX-2INT MIN-2INT DU< -> <TRUE> }T
T{ MIN-2INT MAX-2INT DU< -> <FALSE> }T
T{ MIN-2INT LO-2INT DU< -> <TRUE> }T
F.9 The optional Exception word set
The test F.9.6.1.0875 CATCH also test THROW. This should be followed by the test F.9.6.2.0680 ABORT" which also test ABORT. Finally, the general exception handling is tested in F.9.3.6.
F.9.3.6 Exception handling
Ideally all of the throw codes should be tested. Here only the
thow code for an "Undefined Word" exception is tested, assuming
that the word $$UndefedWord$$ is undefined.
: t7 S" 333 $$UndefedWord$$ 334" EVALUATE 335 ;
: t8 S" 222 t7 223" EVALUATE 224 ;
: t9 S" 111 112 t8 113" EVALUATE 114 ;
T{ 6 7 ' t9 c6 3 -> 6 7 13 3 }T
: t1 9 ;
: c1 1 2 3 ['] t1 CATCH ;
T{ c1 -> 1 2 3 9 0 }T \ No THROW executed
: t2 8 0 THROW ;
: c2 1 2 ['] t2 CATCH ;
T{ c2 -> 1 2 8 0 }T \ 0 THROW does nothing
: t3 7 8 9 99 THROW ;
: c3 1 2 ['] t3 CATCH ;
T{ c3 -> 1 2 99 }T \ Restores stack to CATCH depth
: t4 1- DUP 0> IF RECURSE ELSE 999 THROW -222 THEN ;
: c4 3 4 5 10 ['] t4 CATCH -111 ;
T{ c4 -> 3 4 5 0 999 -111 }T \ Test return stack unwinding
: t5 2DROP 2DROP 9999 THROW ;
: c5 1 2 3 4 ['] t5 CATCH \ Test depth restored correctly
DEPTH >R DROP 2DROP 2DROP R> ; \ after stack has been emptied
T{ c5 -> 5 }T
-1 CONSTANT exc_abort
-2 CONSTANT exc_abort"
-13 CONSTANT exc_undef
: t6 ABORT ;
The 77 in t10 is necessary for the second
ABORT" test as the data stack is restored to a
depth of 2 when THROW is executed. The 77 ensures
the top of stack value is known for the results check.
: t10 77 SWAP ABORT" This should not be displayed" ;
: c6 CATCH
CASE exc_abort OF 11 ENDOF
exc_abort" OF 12 ENDOF
exc_undef OF 13 ENDOF
ENDCASE
;
T{ 1 2 ' t6 c6 -> 1 2 11 }T \ Test that ABORT is caught
T{ 3 0 ' t10 c6 -> 3 77 }T \ ABORT" does nothing
T{ 4 5 ' t10 c6 -> 4 77 12 }T \ ABORT" caught, no message
F.11 The optional Facility word set
CR ." Please press " POSTPONE ." EKEY EKEY>FKEY ;
T{ TFKEY" <left>" -> K-LEFT <TRUE> }T
T{ TFKEY" <right>" -> K-RIGHT <TRUE> }T
T{ TFKEY" <up>" -> K-UP <TRUE> }T
T{ TFKEY" <down>" -> K-DOWN <TRUE> }T
T{ TFKEY" <home>" -> K-HOME <TRUE> }T
T{ TFKEY" <end>" -> K-END <TRUE> }T
T{ TFKEY" <prior>" -> K-PRIOR <TRUE> }T
T{ TFKEY" <next>" -> K-NEXT <TRUE> }T
T{ TFKEY" <F1>" -> K-F1 <TRUE> }T
T{ TFKEY" <F2>" -> K-F2 <TRUE> }T
T{ TFKEY" <F3>" -> K-F3 <TRUE> }T
T{ TFKEY" <F4>" -> K-F4 <TRUE> }T
T{ TFKEY" <F5>" -> K-F5 <TRUE> }T
T{ TFKEY" <F6>" -> K-F6 <TRUE> }T
T{ TFKEY" <F7>" -> K-F7 <TRUE> }T
T{ TFKEY" <F8>" -> K-F8 <TRUE> }T
T{ TFKEY" <F9>" -> K-F9 <TRUE> }T
T{ TFKEY" <F10>" -> K-F10 <TRUE> }T
T{ TFKEY" <F11>" -> K-F11 <TRUE> }T
T{ TFKEY" <F11>" -> K-F12 <TRUE> }T
T{ TFKEY" <shift-left>" -> K-LEFT K-SHIFT-MASK OR <TRUE> }T
T{ TFKEY" <ctrl-left>" -> K-LEFT K-CTRL-MASK OR <TRUE> }T
T{ TFKEY" <alt-left>" -> K-LEFT K-ALT-MASK OR <TRUE> }T
F.12 The optional File-Access word set
These tests create files in the current directory, if all goes well these will be deleted. If something fails they may not be deleted. If this is a problem ensure you set a suitable directory before running this test. Currently, there is no ANS standard way of doing this. the file names used in these test are: "fatest1.txt", "fatest2.txt" and
"fatest3.txt".
The test F.11.6.1.1010 CREATE-FILE also tests CLOSE-FILE, F.11.6.1.2485 WRITE-LINE also tests W/O and OPEN-FILE, F.11.6.1.2090 READ-LINE includes a test for R/O, F.11.6.1.2142 REPOSITION-FILE includes tests for R/W, WRITE-FILE, READ-FILE, FILE-POSITION, and S". The F.11.6.1.1522 FILE-SIZE test includes a test for BIN. The test F.11.6.1.2147 RESIZE-FILE should then be run followed by the F.11.6.1.1190 DELETE-FILE test.
The F.11.6.1.0080 ( test should be next, followed by F.11.6.1.2218 SOURCE-ID the test which test the extended versions of ( and SOURCE-ID respectively.
Finally F.11.6.2.2130 RENAME-FILE tests the extended words RENAME-FILE, FILE-STATUS, and FLUSH-FILE.
4 5 6
7 8 9 ) 11 22 33 -> 11 22 33 }T
: fn2 S" fatest2.txt" ;
VARIABLE fid2
: setpad PAD 50 0 DO I OVER C! CHAR+ LOOP DROP ;
setpad
Note: If anything else is defined
setpad must be called again as the pad may move
T{ fn2 R/W BIN CREATE-FILE SWAP fid2 ! -> 0 }T
T{ PAD 50 fid2 @ WRITE-FILE fid2 @ FLUSH-FILE -> 0 0 }T
T{ fid2 @ FILE-SIZE -> 50. 0 }T
T{ 0. fid2 @ REPOSITION-FILE -> 0 }T
T{ cbuf buf 29 fid2 @ READ-FILE -> 29 0 }T
T{ PAD 29 buf 29 COMPARE -> 0 }T
T{ PAD 30 buf 30 COMPARE -> 1 }T
T{ cbuf buf 29 fid2 @ READ-FILE -> 21 0 }T
T{ PAD 29 + 21 buf 21 COMPARE -> 0 }T
T{ fid2 @ FILE-SIZE DROP fid2 @ FILE-POSITION DROP D= -> <TRUE> }T
T{ buf 10 fid2 @ READ-FILE -> 0 0 }T
T{ fid2 @ CLOSE-FILE -> 0 }T
: rl1 buf 100 fid1 @ READ-LINE ;
2VARIABLE fp
T{ fn1 R/W OPEN-FILE SWAP fid1 ! -> 0 }T
T{ fid1 @ FILE-SIZE DROP fid1 @ REPOSITION-FILE -> 0 }T
T{ fid1 @ FILE-SIZE -> fid1 @ FILE-POSITION }T
T{ line2 fid1 @ WRITE-FILE -> 0 }T
T{ 10. fid1 @ REPOSITION-FILE -> 0 }T
T{ fid1 @ FILE-POSITION -> 10. 0 }T
T{ 0. fid1 @ REPOSITION-FILE -> 0 }T
T{ rl1 -> line1 SWAP DROP <TRUE> 0 }T
T{ rl1 -> ROT DUP #chars ! }T<TRUE> 0 line2 SWAP DROP
T{ buf #chars @ line2 COMPARE -> 0 }T
T{ rl1 -> 0 <FALSE> 0 }T
T{ fid1 @ FILE-POSITION ROT ROT fp 2! -> 0 }T
T{ fp 2@ fid1 @ FILE-SIZE DROP D= -> <TRUE> }T
T{ S" " fid1 @ WRITE-LINE -> 0 }T
T{ S" " fid1 @ WRITE-LINE -> 0 }T
T{ fp 2@ fid1 @ REPOSITION-FILE -> 0 }T
T{ rl1 -> 0 <TRUE> 0 }T
T{ rl1 -> 0 <TRUE> 0 }T
T{ rl1 -> 0 <FALSE> 0 }T
T{ fid1 @ CLOSE-FILE -> 0 }T
setpad T{ fn2 R/W BIN OPEN-FILE SWAP fid2 ! -> 0 }T
T{ 37. fid2 @ RESIZE-FILE -> 0 }T
T{ fid2 @ FILE-SIZE -> 37. 0 }T
T{ 0. fid2 @ REPOSITION-FILE -> 0 }T
T{ cbuf buf 100 fid2 @ READ-FILE -> 37 0 }T
T{ PAD 37 buf 37 COMPARE -> 0 }T
T{ PAD 38 buf 38 COMPARE -> 1 }T
T{ 500. fid2 @ RESIZE-FILE -> 0 }T
T{ fid2 @ FILE-SIZE -> 500. 0 }T
T{ 0. fid2 @ REPOSITION-FILE -> 0 }T
T{ cbuf buf 100 fid2 @ READ-FILE -> 100 0 }T
T{ PAD 37 buf 37 COMPARE -> 0 }T
T{ fid2 @ CLOSE-FILE -> 0 }T
: >end fid1 @ FILE-SIZE DROP fid1 @ REPOSITION-FILE ;
T{ fn3 DELETE-FILE DROP -> }T
T{ fn1 fn3 RENAME-FILE -> 0 }T
\ Return value is undefined
T{ fn1 FILE-STATUS SWAP DROP 0= -> <FALSE> }T
T{ fn3 FILE-STATUS SWAP DROP 0= -> <TRUE> }T
T{ fn3 R/W OPEN-FILE SWAP fid1 ! -> 0 }T
T{ >end -> 0 }T
T{ S" Final line" fid1 @ WRITE-LINE -> 0 }T
T{ fid1 @ FLUSH-FILE -> 0 }T \ Can only test FLUSH-FILE doesn't fail
T{ fid1 @ CLOSE-FILE -> 0 }T
\ Tidy the test folder
T{ fn3 DELETE-FILE DROP -> }T
required-helper1.fs and
required-helper2.fs.
Both of which hold the text:
As for the test themselves:
T{ 0
S" required-helper1.fs" REQUIRED \ Increment TOS
REQUIRE required-helper1.fs \ Ignore - already loaded
INCLUDE required-helper1.fs \ Increment TOS
-> 2 }T
T{ 0
INCLUDE required-helper2.fs \ Increment TOS
S" required-helper2.fs" REQUIRED \ Ignored - already loaded
REQUIRE required-helper2.fs \ Ignored - already loaded
S" required-helper2.fs" INCLUDED \ Increment TOS
-> 2 }T
F.14 The optional Floating-Point word set
[UNDEFINED] +Inf [IF] 1e 0e F/ FCONSTANT +Inf [THEN]
[UNDEFINED] -Inf [IF] -1e 0e F/ FCONSTANT -Inf [THEN]
The test harness default for EXACT? is TRUE.
Uncomment the following line if your system needs it to
be FALSE
\ SET-NEAR
:NONAME ( c-addr u -- )
( Display an error message followed by the
line that had the error@. )
1 #errors +! error1 ; error-xt !
[UNDEFINED] pi [IF]
0.3141592653589793238463E1 FCONSTANT pi
[THEN]
[UNDEFINED] -pi [IF]
pi FNEGATE FCONSTANT -pi
[THEN]
FALSE [IF]
0.7853981633974483096157E0 FCONSTANT pi/4
-0.7853981633974483096157E0 FCONSTANT -pi/4
0.1570796326794896619231E1 FCONSTANT pi/2
-0.1570796326794896619231E1 FCONSTANT -pi/2
0.4712388980384689857694E1 FCONSTANT 3pi/2
0.2356194490192344928847E1 FCONSTANT 3pi/4
-0.2356194490192344928847E1 FCONSTANT -3pi/4
[ELSE]
pi 4e F/ FCONSTANT pi/4
-pi 4e F/ FCONSTANT -pi/4
pi 2e F/ FCONSTANT pi/2
-pi 2e F/ FCONSTANT -pi/2
pi/2 3e F* FCONSTANT 3pi/2
pi/4 3e F* FCONSTANT 3pi/4
-pi/4 3e F* FCONSTANT -3pi/4
[THEN]
verbose @ [IF]
:NONAME ( -- fp.separate? )
DEPTH >R 1e DEPTH R> FDROP 2R> = ; EXECUTE
CR .( floating-point and data stacks )
[IF] .( *separate* ) [ELSE] .( *not separate* ) [THEN]
CR
[THEN]
TESTING normal values
\ y x rad deg
T{ 0e 1e FATAN2 -> 0e R}T \ 0
T{ 1e 1e FATAN2 -> pi/4 R}T \ 45
T{ 1e 0e FATAN2 -> pi/2 R}T \ 90
T{ -1e -1e FATAN2 -> -3pi/4 R}T \ 135
T{ 0e -1e FATAN2 -> pi R}T \ 180
T{ -1e 1e FATAN2 -> -pi/4 R}T \ 225
T{ -1e 0e FATAN2 -> -pi/2 R}T \ 270
T{ -1e 1e FATAN2 -> -pi/4 R}T \ 315
TESTING Single UNIX 3 special values spec
\ ISO C / Single UNIX Specification Version 3:
\ http://www.unix.org/single_unix_specification/
\ Select "Topic", then "Math Interfaces", then "atan2()":
\ http://www.opengroup.org/onlinepubs/009695399/
\ functions/atan2f.html
\ If y is +/-0 and x is < 0, +/-pi shall be returned.
T{ 0e -1e FATAN2 -> pi R}T
T{ -0e -1e FATAN2 -> -pi R}T
\ If y is +/-0 and x is > 0, +/-0 shall be returned.
T{ 0e 1e FATAN2 -> 0e R}T
T{ -0e 1e FATAN2 -> -0e R}T
\ If y is < 0 and x is +/-0, -pi/2 shall be returned.
T{ -1e 0e FATAN2 -> -pi/2 R}T
T{ -1e -0e FATAN2 -> -pi/2 R}T
\ If y is > 0 and x is +/-0, pi/2 shall be returned.
T{ 1e 0e FATAN2 -> pi/2 R}T
T{ 1e -0e FATAN2 -> pi/2 R}T
TESTING Single UNIX 3 special values optional spec
\ Optional ISO C / single UNIX specs:
\ If either x or y is NaN, a NaN shall be returned.
T{ NaN 1e FATAN2 -> NaN R}T
T{ 1e NaN FATAN2 -> NaN R}T
T{ NaN NaN FATAN2 -> NaN R}T
\ If y is +/-0 and x is -0, +/-pi shall be returned.
T{ 0e -0e FATAN2 -> pi R}T
T{ -0e -0e FATAN2 -> -pi R}T
\ If y is +/-0 and x is +0, +/-0 shall be returned.
T{ 0e 0e FATAN2 -> +0e R}T
T{ -0e 0e FATAN2 -> -0e R}T
\ For finite values of +/-y > 0, if x is -Inf, +/-pi shall be returned.
T{ 1e -Inf FATAN2 -> pi R}T
T{ -1e -Inf FATAN2 -> -pi R}T
\ For finite values of +/-y > 0, if x is +Inf, +/-0 shall be returned.
T{ 1e +Inf FATAN2 -> +0e R}T
T{ -1e +Inf FATAN2 -> -0e R}T
\ For finite values of x, if y is +/-Inf, +/-pi/2 shall be returned.
T{ +Inf 1e FATAN2 -> pi/2 R}T
T{ +Inf -1e FATAN2 -> pi/2 R}T
T{ +Inf 0e FATAN2 -> pi/2 R}T
T{ +Inf -0e FATAN2 -> pi/2 R}T
T{ -Inf 1e FATAN2 -> -pi/2 R}T
T{ -Inf -1e FATAN2 -> -pi/2 R}T
T{ -Inf 0e FATAN2 -> -pi/2 R}T
T{ -Inf -0e FATAN2 -> -pi/2 R}T
\ If y is +/-Inf and x is -Inf, +/-3pi/4 shall be returned.
T{ +Inf -Inf FATAN2 -> 3pi/4 R}T
T{ -Inf -Inf FATAN2 -> -3pi/4 R}T
\ If y is +/-Inf and x is +Inf, +/-pi/4 shall be returned.
T{ +Inf +Inf FATAN2 -> pi/4 R}T
T{ -Inf +Inf FATAN2 -> -pi/4 R}T
SET-EXACT
T{ -0E FTRUNC F0= -> <TRUE> }T
T{ -1E-9 FTRUNC F0= -> <TRUE> }T
T{ -0.9E FTRUNC F0= -> <TRUE> }T
T{ -1E 1E-5 F+ FTRUNC F0= -> <TRUE> }T
T{ 0E FTRUNC -> 0E R}T
T{ 1E-9 FTRUNC -> 0E R}T
T{ -1E -1E-5 F+ FTRUNC -> -1E R}T
T{ 3.14E FTRUNC -> 3E R}T
T{ 3.99E FTRUNC -> 3E R}T
T{ 4E FTRUNC -> 4E R}T
T{ -4E FTRUNC -> -4E R}T
T{ -4.1E FTRUNC -> -4E R}T
F.16 The optional Memory-Allocation word set
These test require a new variable to hold the address of the allocated memory. Two helper words are defined to populate the allocated memory and to check the memory:
: write-cell-mem ( addr n -- )
1+ 1 DO I OVER ! CELL+ LOOP DROP
;
: check-cell-mem ( addr n -- )
1+ 1 DO
I SWAP >R >R
T{ R> ( I ) -> R@ ( addr ) @ }T
R> CELL+
LOOP DROP
;
: write-char-mem ( addr n -- )
1+ 1 DO I OVER C! CHAR+ LOOP DROP
;
: check-char-mem ( addr n -- )
1+ 1 DO
I SWAP >R >R
T{ R> ( I ) -> R@ ( addr ) C@ }T
R> CHAR+
LOOP DROP
;
HERE datsp !
T{ 50 CELLS ALLOCATE SWAP addr ! -> 0 }T
T{ addr @ ALIGNED -> addr @ }T \ Test address is aligned
T{ HERE -> datsp @ }T \ Check data space pointer is unaffected
addr @ 50 write-cell-mem
addr @ 50 check-cell-mem \ Check we can access the heap
T{ addr @ FREE -> 0 }T
T{ 99 ALLOCATE SWAP addr ! -> 0 }T
T{ addr @ ALIGNED -> addr @ }T \ Test address is aligned
T{ addr @ FREE -> 0 }T
T{ HERE -> datsp @ }T \ Data space pointer unaffected by FREE
T{ -1 ALLOCATE SWAP DROP 0= -> <FALSE> }T \ Memory allocate failed
addr @ 50 write-char-mem addr @ 50 check-char-mem
\ Resize smaller does not change content.
T{ addr @ 28 CHARS RESIZE SWAP addr ! -> 0 }T
addr @ 28 check-char-mem
\ Resize larger does not change original content.
T{ addr @ 100 CHARS RESIZE SWAP addr ! -> 0 }T
addr @ 28 check-char-mem
\ Resize error does not change addr
T{ addr @ -1 RESIZE 0= -> addr @ <FALSE> }T
T{ addr @ FREE -> 0 }T
T{ HERE -> datsp @ }T \ Data space pointer is unaffected
F.18 The optional Programming-Tools word set
POSTPONE IF 1 CS-ROLL
; IMMEDIATE -> }T
T{ : pt6
>R
BEGIN
R@
?DONE
R@
R> 1- >R
REPEAT
R> DROP
; -> }T
T{ 5 pt6 -> 5 4 3 2 1 }T
: mix_up 2 CS-ROLL ; IMMEDIATE \ cs-rot
: pt7 ( f3 f2 f1 -- ? )
IF 1111 ROT ROT ( -- 1111 f3 f2 ) ( cs: -- o1 )
IF 2222 SWAP ( -- 1111 2222 f3 ) ( cs: -- o1 o2 )
IF ( cs: -- o1 o2 o3 )
3333 mix_up ( -- 1111 2222 3333 ) ( cs: -- o2 o3 o1 )
THEN ( cs: -- o2 o3 )
4444 \ Hence failure of first IF comes here and falls through
THEN ( cs: -- o2 )
5555 \ Failure of 3rd IF comes here
THEN ( cs: -- )
6666 \ Failure of 2nd IF comes here
;
T{ -1 -1 -1 pt7 -> 1111 2222 3333 4444 5555 6666 }T
T{ 0 -1 -1 pt7 -> 1111 2222 5555 6666 }T
T{ 0 0 -1 pt7 -> 1111 0 6666 }T
T{ 0 0 0 pt7 -> 0 0 4444 5555 6666 }T
: [1cs-roll] 1 CS-ROLL ; IMMEDIATE
T{ : pt8
>R
AHEAD 111
BEGIN 222
[1cs-roll]
THEN
333
R> 1- >R
R@ 0<
UNTIL
R> DROP
; -> }T
T{ 1 pt8 -> 333 222 333 }T
T{ <FALSE> [IF] 111 [ELSE] 222 [THEN] -> 222 }T
\ Check words are immediate
: tfind BL WORD FIND ;
T{ tfind [IF] NIP -> 1 }T
T{ tfind [ELSE] NIP -> 1 }T
T{ tfind [THEN] NIP -> 1 }T
T{ : pt2 [ 0 ] [IF] 1111 [ELSE] 2222 [THEN] ; pt2 -> 2222 }T
T{ : pt3 [ -1 ] [IF] 3333 [ELSE] 4444 [THEN] ; pt3 -> 3333 }T
\ Code spread over more than 1 line
T{ <TRUE> [IF] 1
2
[ELSE]
3
4
[THEN] -> 1 2 }T
T{ <FALSE> [IF]
1 2
[ELSE]
3 4
[THEN] -> 3 4 }T
\ Nested
: <T> <TRUE> ;
: <F> <FALSE> :
T{ <T> [IF] 1 <T> [IF] 2 [ELSE] 3 [THEN] [ELSE] 4 [THEN] -> 1 2 }T
T{ <F> [IF] 1 <T> [IF] 2 [ELSE] 3 [THEN] [ELSE] 4 [THEN] -> 4 }T
T{ <T> [IF] 1 <F> [IF] 2 [ELSE] 3 [THEN] [ELSE] 4 [THEN] -> 1 3 }T
T{ <F> [IF] 1 <F> [IF] 2 [ELSE] 3 [THEN] [ELSE] 4 [THEN] -> 4 }T
F.19 The optional Search-Order word set
The search order is reset to a known state before the tests can be run.
Define two word list (wid) variables used by the tests.
In order to test the search order it in necessary to remember the
existing search order before modifying it. The existing search order
is saved and the get-orderlist defined to access it.
DUP , 0 ?DO , LOOP
;
CREATE order-list
T{ GET-ORDER save-orderlist -> }T
: get-orderlist ( -- widn ... wid1 n )
order-list DUP @ CELLS ( -- ad n )
OVER + ( -- AD AD' )
?DO I @ -1 CELLS +LOOP ( -- )
;
Having obtained a copy of the current wordlist, the testing of the wordlist can begin with test F.16.6.1.1595 FORTH-WORDLIST followed by F.16.6.1.2197 SET-ORDER which also test GET-ORDER, then F.16.6.2.0715 ALSO and F.16.6.2.1965 ONLY before moving on to F.16.6.1.2195 SET-CURRENT which also test GET-CURRENT and WORDLIST. This should be followed by the test F.16.6.1.1180 DEFINITIONS which also tests PREVIOUS and the F.16.6.1.2192 SEARCH-WORDLIST and F.16.6.1.1550 FIND tests. Finally the F.16.6.2.1985 ORDER test can be performed.
T{ GET-CURRENT -> FORTH-WORDLIST }T
T{ GET-ORDER wid2 @ SWAP 1+ SET-ORDER DEFINITIONS GET-CURRENT
-> wid2 @ }T
T{ GET-ORDER -> get-orderlist wid2 @ SWAP 1+ }T
T{ PREVIOUS GET-ORDER -> get-orderlist }T
T{ DEFINITIONS GET-CURRENT -> FORTH-WORDLIST }T
: alsowid2 ALSO GET-ORDER wid2 @ ROT DROP SWAP SET-ORDER ;
alsowid2
: w1 1234 ;
DEFINITIONS
: w1 -9876 ; IMMEDIATE
ONLY FORTH
T{ w1 -> 1234 }T
DEFINITIONS
T{ w1 -> 1234 }T
alsowid2
T{ w1 -> -9876 }T
DEFINITIONS
T{ w1 -> -9876 }T
ONLY FORTH DEFINITIONS
: so5 DUP IF SWAP EXECUTE THEN ;
T{ S" w1" wid1 @ SEARCH-WORDLIST so5 -> -1 1234 }T
T{ S" w1" wid2 @ SEARCH-WORDLIST so5 -> 1 -9876 }T
: c"w1" C" w1" ;
T{ alsowid2 c"w1" FIND so5 -> 1 -9876 }T
T{ PREVIOUS c"w1" FIND so5 -> -1 1234 }T
T{ WORDLIST wid2 ! -> }T
T{ wid2 @ SET-CURRENT -> }T
T{ GET-CURRENT -> wid2 @ }T
T{ wid1 @ SET-CURRENT -> }T
T{ GET-ORDER SET-ORDER -> }T
T{ GET-ORDER -> get-orderlist }T T{ get-orderlist DROP get-orderList 2* SET-ORDER -> }T
T{ GET-ORDER -> get-orderlist DROP get-orderList 2* }T
T{ get-orderlist SET-ORDER GET-ORDER -> get-orderlist }T
: so2a GET-ORDER get-orderlist SET-ORDER ;
: so2 0 SET-ORDER so2a ;
T{ so2 -> 0 }T \ 0 SET-ORDER leaves an empty search order
: so3 -1 SET-ORDER so2a ;
: so4 ONLY so2a ;
T{ so3 -> so4 }T \ -1 SET-ORDER is the same as ONLY
T{ ONLY FORTH DEFINITIONS ORDER -> }T
CR .( Plus another unnamed wordlist at head of search order) CR
T{ alsowid2 DEFINITIONS ORDER -> }T
F.20 The optional String word set
Most of the tests in this wordlist require a known string which is defined as:T{ : s1 S" abcdefghijklmnopqrstuvwxyz" ; -> }T
The tests should be carried out in the order: F.17.6.1.0245 /STRING, F.17.6.1.2191 SEARCH, F.17.6.1.0170 -TRAILING, F.17.6.1.0935 COMPARE, F.17.6.1.0780 BLANK and F.17.6.1.2212 SLITERAL.
T{ s1 PAD SWAP CMOVE -> }T \ Copy s1 to PAD
T{ s1 PAD OVER COMPARE -> 0 }T
T{ s1 PAD 6 COMPARE -> 1 }T
T{ PAD 10 s1 COMPARE -> -1 }T
T{ s1 PAD 0 COMPARE -> 1 }T
T{ PAD 0 s1 COMPARE -> -1 }T
T{ s1 s6 COMPARE -> 1 }T
T{ s6 s1 COMPARE -> -1 }T
: "abdde" S" abdde" ;
: "abbde" S" abbde" ;
: "abcdf" S" abcdf" ;
: "abcdee" S" abcdee" ;
T{ s1 "abdde" COMPARE -> -1 }T
T{ s1 "abbde" COMPARE -> 1 }T
T{ s1 "abcdf" COMPARE -> -1 }T
T{ s1 "abcdee" COMPARE -> 1 }T
: s11 S" 0abc" ;
: s12 S" 0aBc" ;
T{ s11 s12 COMPARE -> 1 }T
T{ s12 s11 COMPARE -> -1 }T
T{ : s3 S" jklmn" ; -> }T
T{ : s4 S" z" ; -> }T
T{ : s5 S" mnoq" ; -> }T
T{ : s6 S" 12345" ; -> }T
T{ : s7 S" " ; -> }T
T{ s1 s2 SEARCH -> s1 <TRUE> }T
T{ s1 s3 SEARCH -> s1 9 /STRING <TRUE> }T
T{ s1 s4 SEARCH -> s1 25 /STRING <TRUE> }T
T{ s1 s5 SEARCH -> s1 <FALSE> }T
T{ s1 s6 SEARCH -> s1 <FALSE> }T
T{ s1 s7 SEARCH -> s1 <TRUE> }T
\ Define a few string constants
: "hi" S" hi" ;
: "wld" S" wld" ;
: "hello" S" hello" ;
: "world" S" world" ;
\ Define a few test strings
: sub1 S" Start: %hi%,%wld%! :End" ; \ Original string
: sub2 S" Start: hello,world! :End" ; \ First target string
: sub3 S" Start: world,hello! :End" ; \ Second target string
\ Define the hi and wld substitutions
T{ "hello" "hi" REPLACES -> }T \ Replace "%hi%" with "hello"
T{ "world" "wld" REPLACES -> }T \ Replace "%wld%" with "world"
\ "%hi%,%wld%" changed to "hello,world"
T{ sub1 subbuff 30 SUBSTITUTE ROT ROT sub2 COMPARE -> 2 0 }T
\ Change the hi and wld substitutions
T{ "world" "hi" REPLACES -> }T
T{ "hello" "wld" REPLACES -> }T
\ Now "%hi%,%wld%" should be changed to "world,hello"
T{ sub1 subbuff 30 SUBSTITUTE ROT ROT sub3 COMPARE -> 2 0 }T
\ Where the subsitution name is not defined
: sub4 S" aaa%bbb%ccc" ;
T{ sub4 subbuff 30 SUBSTITUTE ROT ROT sub4 COMPARE -> 0 0 }T
\ Finally the % character itself
: sub5 S" aaa%%bbb" ;
: sub6 S" aaa%bbb" ;
T{ sub5 subbuff 30 SUBSTITUTE ROT ROT sub6 COMPARE -> 0 0 }T
subbuff, sub5 and sub6 from F.17.6.2.2255 SUBSTITUTE.
T{ sub6 subbuff UNESCAPE sub5 COMPARE -> 0 }T
F.21 The optional Extended Character word set
These test assume the UTF-8 character encoding is being used.
T{ 0 XC-SIZE -> 1 }T
T{ 7f XC-SIZE -> 1 }T
T{ 80 XC-SIZE -> 2 }T
T{ 7ff XC-SIZE -> 2 }T
T{ 800 XC-SIZE -> 3 }T
T{ ffff XC-SIZE -> 3 }T
T{ 10000 XC-SIZE -> 4 }T
T{ 1fffff XC-SIZE -> 4 }T
T{ $41 XC-WIDTH -> 1 }T
T{ $2060 XC-WIDTH -> 0 }T
ContributeContributions
StephenPelc
[63] Let us adopt the Gerry Jackson test suite as part of Forth 200xProposal2018-07-10 14:38:46
MarkWills
alextangent
AntonErtl
StephenPelc
GeraldWodni
JamesNorris
[145] Please fix word spelling in F.1 second paragraph second word.Suggested reference implementation2020-08-08 10:00:59
I believe the author intended to use the word 'test' instead of the word 'teat'.
AntonErtl
Thanks for the report. Will be fixed.
MatteoVitturi
[209] Missed-order in section F.3.10 DivisionExample2021-08-21 14:29:36
In section F.3.10 Division, there is a little missed-order in the last sentence:
As the test definitions use the words which have just been tested, the tests must be performed in the order: F.6.1.0240 /MOD, F.6.1.0230 /, F.6.1.1890 MOD, F.6.1.0100 */, and F.6.1.0110 */MOD.
T*/MOD is referenced in F.6.1.0100 */ but is defined in F.6.1.0110 */MOD, it should be
As the test definitions use the words which have just been tested, the tests must be performed in the order: F.6.1.0240 /MOD, F.6.1.0230 /, F.6.1.1890 MOD, F.6.1.0110 */MOD, and F.6.1.0100 */.
Matteo
LSchmidt
[222] many tests appear to only assess interpretation semantics of test subjectsSuggested Testcase2022-02-27 18:43:57
Tests may be incomplete when only looking at the interpret time semantics. Many Forth systems don't simply compile a call to the same code portion of a tested word. Instead, they may generate code which may be different and unrelated to the executed code during interpretation.
Shouldn't those tests therefore not also test against a word which the testee has been compiled to?
ruv
I think, this Test Suite was not intended to cover 100% of possible use cases.
In any case, additional tests can be also directly suggested into the forth2012-test-suite repository.
LSchmidt
[223] chasing for dangling words referred toRequest for clarification2022-02-27 20:58:46
Looking at test cases for ALLOT, I find <TRUE> and <FALSE>, those defined elsewhere in terms of 0S and 1S. Hunting for those, I find a reference in F.3.2 Booleans, saying:
To test the booleans it is first neccessary to test F.6.1.0720 AND, and F.6.1.1720 INVERT. Before moving on to > the test F.6.1.0950 CONSTANT. The latter defines two constants (0S and 1S) which will be used in the further > test.
No, it doesn't. it tests the 0S INVERT case to match 1S, and the 1S INVERT case for 0S. Seems that tester is free to come up with his own idea of how to represent 0S and 1S.
LSchmidt
[224] many tests appear to only assess interpretation semantics of test subjectsSuggested Testcase2022-02-27 21:23:05
Tests may be incomplete when only looking at the interpret time semantics. Many Forth systems don't simply compile a call to the same code portion of a tested word. Instead, they may generate code which may be different and unrelated to the executed code during interpretation.
Shouldn't those tests therefore not also test against a word which the testee has been compiled to?
JimPeterson
[235] F.3 Seems in ErrorComment2022-04-08 17:45:25
The end of F.3 states "Note that all of the tests in this suite assume the current base is hexadecimal.", but then there are tests like:
T{ $12eF -> 4847 }T
This seems like a contradiction, unless I'm misinterpreting the end of F.3.
--Jim
ruv
Some tests in F.6.1.0140 +LOOP assume the radix is ten, and don't work in hexadecimal.
Namely:
T{ -20 31 -10 GD7 -> 31 21 11 1 -9 -19 6 }T
T{ -20 29 -10 GD7 -> 29 19 9 -1 -11 5 }T
And the tests that mention the number 256 (literally).