1
\ To test the ANS Forth search-order word set and search order extensions
3
\ This program was written by Gerry Jackson in 2006, with contributions from
4
\ others where indicated, and is in the public domain - it can be distributed
5
\ and/or modified in any way but please retain this notice.
7
\ This program is distributed in the hope that it will be useful,
8
\ but WITHOUT ANY WARRANTY; without even the implied warranty of
9
\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
11
\ The tests are not claimed to be comprehensive or correct
13
\ ------------------------------------------------------------------------------
14
\ Version 0.10 3 August 2014 Name changes to remove redefinition messages
15
\ "list" changed to "wordlist" in message for ORDER tests
16
\ 0.5 1 April 2012 Tests placed in the public domain.
17
\ 0.4 6 March 2009 { and } replaced with T{ and }T18
\ 0.3 20 April 2007 ANS Forth words changed to upper case
19
\ 0.2 30 Oct 2006 updated following GForth tests to get
20
\ initial search order into a known state
21
\ 0.1 Oct 2006 First version released
23
\ ------------------------------------------------------------------------------
24
\ The tests are based on John Hayes test program for the core word set
25
\ and requires those files to have been loaded
27
\ Words tested in this file are:
28
\ FORTH-WORDLIST GET-ORDER SET-ORDER ALSO ONLY FORTH GET-CURRENT
29
\ SET-CURRENT DEFINITIONS PREVIOUS SEARCH-WORDLIST WORDLIST FIND
30
\ Words not fully tested:
31
\ ORDER only tests that it executes, display is implementation
32
\ dependent and should be visually inspected
34
\ ------------------------------------------------------------------------------
35
\ Assumptions and dependencies:
36
\ - tester.fr or ttester.fs has been loaded prior to this file
37
\ - that ONLY FORTH DEFINITIONS will work at the start of the file
38
\ to ensure the search order is in a known state
39
\ ------------------------------------------------------------------------------
43
TESTING Search-order word set
47
VARIABLE WID1 VARIABLE WID2
49
: SAVE-ORDERLIST ( widn ... wid1 n -> ) DUP , 0 ?DO , LOOP ;
51
\ ------------------------------------------------------------------------------
52
TESTING FORTH-WORDLIST GET-ORDER SET-ORDER
54
T{ FORTH-WORDLIST WID1 ! -> }T58
T{ GET-ORDER SAVE-ORDERLIST -> }T60
: GET-ORDERLIST ( -- widn ... wid1 n )
61
ORDER-LIST DUP @ CELLS ( -- ad n )
63
?DO I @ -1 CELLS +LOOP ( -- )
66
T{ GET-ORDER OVER -> GET-ORDER WID1 @ }T \ Forth wordlist at top67
T{ GET-ORDER SET-ORDER -> }T \ Effectively noop68
T{ GET-ORDER -> GET-ORDERLIST }T \ Check nothing changed69
T{ GET-ORDERLIST DROP GET-ORDERLIST 2* SET-ORDER -> }T70
T{ GET-ORDER -> GET-ORDERLIST DROP GET-ORDERLIST 2* }T71
T{ GET-ORDERLIST SET-ORDER GET-ORDER -> GET-ORDERLIST }T73
\ ------------------------------------------------------------------------------
74
TESTING ALSO ONLY FORTH
76
T{ ALSO GET-ORDER -> GET-ORDERLIST OVER SWAP 1+ }T77
T{ ONLY FORTH GET-ORDER -> GET-ORDERLIST }T \ See assumptions above79
\ ------------------------------------------------------------------------------
80
TESTING GET-CURRENT SET-CURRENT WORDLIST (simple)
82
T{ GET-CURRENT -> WID1 @ }T \ See assumptions above83
T{ WORDLIST WID2 ! -> }T84
T{ WID2 @ SET-CURRENT -> }T85
T{ GET-CURRENT -> WID2 @ }T86
T{ WID1 @ SET-CURRENT -> }T88
\ ------------------------------------------------------------------------------
89
TESTING minimum search order list contains FORTH-WORDLIST and SET-ORDER
91
: SO1 SET-ORDER ; \ In case it is unavailable in the forth wordlist
93
T{ ONLY FORTH-WORDLIST 1 SET-ORDER GET-ORDERLIST SO1 -> }T94
T{ GET-ORDER -> GET-ORDERLIST }T96
\ ------------------------------------------------------------------------------
97
TESTING GET-ORDER SET-ORDER with 0 and -1 number of wids argument
99
: SO2A GET-ORDER GET-ORDERLIST SET-ORDER ; \ To recover search order
100
: SO2 0 SET-ORDER SO2A ;
102
T{ SO2 -> 0 }T \ 0 set-order leaves an empty search order104
: SO3 -1 SET-ORDER SO2A ;
107
T{ SO3 -> SO4 }T \ -1 SET-ORDER = ONLY109
\ ------------------------------------------------------------------------------
110
TESTING DEFINITIONS PREVIOUS
112
T{ ONLY FORTH DEFINITIONS -> }T113
T{ GET-CURRENT -> FORTH-WORDLIST }T114
T{ GET-ORDER WID2 @ SWAP 1+ SET-ORDER DEFINITIONS GET-CURRENT -> WID2 @ }T115
T{ GET-ORDER -> GET-ORDERLIST WID2 @ SWAP 1+ }T116
T{ PREVIOUS GET-ORDER -> GET-ORDERLIST }T117
T{ DEFINITIONS GET-CURRENT -> FORTH-WORDLIST }T119
\ ------------------------------------------------------------------------------
120
TESTING SEARCH-WORDLIST WORDLIST FIND
122
ONLY FORTH DEFINITIONS
123
VARIABLE XT ' DUP XT !
124
VARIABLE XTI ' .( XTI ! \ Immediate word
126
T{ S" DUP" WID1 @ SEARCH-WORDLIST -> XT @ -1 }T127
T{ S" .(" WID1 @ SEARCH-WORDLIST -> XTI @ 1 }T128
T{ S" DUP" WID2 @ SEARCH-WORDLIST -> 0 }T132
: C"X" C" UNKNOWN WORD" ;
134
T{ C"DUP" FIND -> XT @ -1 }T135
T{ C".(" FIND -> XTI @ 1 }T136
T{ C"X" FIND -> C"X" 0 }T138
\ ------------------------------------------------------------------------------
139
TESTING new definitions are put into the correct wordlist
141
: ALSOWID2 ALSO GET-ORDER WID2 @ ROT DROP SWAP SET-ORDER ;
145
: W2 -9876 ; IMMEDIATE
156
ONLY FORTH DEFINITIONS
158
: SO5 DUP IF SWAP EXECUTE THEN ;
160
T{ S" W2" WID1 @ SEARCH-WORDLIST SO5 -> -1 1234 }T161
T{ S" W2" WID2 @ SEARCH-WORDLIST SO5 -> 1 -9876 }T164
T{ ALSOWID2 C"W2" FIND SO5 -> 1 -9876 }T165
T{ PREVIOUS C"W2" FIND SO5 -> -1 1234 }T167
\ ------------------------------------------------------------------------------
168
TESTING ORDER \ Should display search order and compilation wordlist
170
CR .( ONLY FORTH DEFINITIONS search order and compilation wordlist) CR
171
T{ ONLY FORTH DEFINITIONS ORDER -> }T173
CR .( Plus another unnamed wordlist at the head of the search order) CR
174
T{ ALSOWID2 DEFINITIONS ORDER -> }T176
\ ------------------------------------------------------------------------------
178
SEARCHORDER-ERRORS SET-ERROR-COUNT
180
CR .( End of Search Order word tests) CR
182
ONLY FORTH DEFINITIONS \ Leave search order in the standard state