\ To test the ANS Forth search-order word set and search order extensions



\ This program was written by Gerry Jackson in 2006, with contributions from

\ others where indicated, and is in the public domain - it can be distributed

\ and/or modified in any way but please retain this notice.



\ This program is distributed in the hope that it will be useful,

\ but WITHOUT ANY WARRANTY; without even the implied warranty of

\ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.



\ The tests are not claimed to be comprehensive or correct 



\ ------------------------------------------------------------------------------

\ Version 0.10 3 August 2014 Name changes to remove redefinition messages

\               "list" changed to "wordlist" in message for ORDER tests

\         0.5 1 April 2012  Tests placed in the public domain.

\         0.4 6 March 2009 { and } replaced with T{ and }T

\         0.3 20 April 2007 ANS Forth words changed to upper case

\         0.2 30 Oct 2006 updated following GForth tests to get

\             initial search order into a known state

\         0.1 Oct 2006 First version released



\ ------------------------------------------------------------------------------

\ The tests are based on John Hayes test program for the core word set

\ and requires those files to have been loaded



\ Words tested in this file are:

\     FORTH-WORDLIST GET-ORDER SET-ORDER ALSO ONLY FORTH GET-CURRENT

\     SET-CURRENT DEFINITIONS PREVIOUS SEARCH-WORDLIST WORDLIST FIND

\ Words not fully tested:

\     ORDER only tests that it executes, display is implementation

\           dependent and should be visually inspected



\ ------------------------------------------------------------------------------

\ Assumptions and dependencies:

\     - tester.fr or ttester.fs has been loaded prior to this file

\     - that ONLY FORTH DEFINITIONS will work at the start of the file

\       to ensure the search order is in a known state

\ ------------------------------------------------------------------------------



ONLY FORTH DEFINITIONS



TESTING Search-order word set



DECIMAL



VARIABLE WID1  VARIABLE WID2



: SAVE-ORDERLIST ( widn ... wid1 n -> ) DUP , 0 ?DO , LOOP ;



\ ------------------------------------------------------------------------------

TESTING FORTH-WORDLIST GET-ORDER SET-ORDER



T{ FORTH-WORDLIST WID1 ! -> }T



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  ( -- )

;



T{ GET-ORDER OVER -> GET-ORDER WID1 @ }T \ Forth wordlist at top

T{ GET-ORDER SET-ORDER -> }T             \ Effectively noop

T{ GET-ORDER -> GET-ORDERLIST }T         \ Check nothing changed

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



\ ------------------------------------------------------------------------------

TESTING ALSO ONLY FORTH



T{ ALSO GET-ORDER -> GET-ORDERLIST OVER SWAP 1+ }T

T{ ONLY FORTH GET-ORDER -> GET-ORDERLIST }T    \ See assumptions above



\ ------------------------------------------------------------------------------

TESTING GET-CURRENT SET-CURRENT WORDLIST (simple)



T{ GET-CURRENT -> WID1 @ }T        \ See assumptions above

T{ WORDLIST WID2 ! -> }T

T{ WID2 @ SET-CURRENT -> }T

T{ GET-CURRENT -> WID2 @ }T

T{ WID1 @ SET-CURRENT -> }T



\ ------------------------------------------------------------------------------

TESTING minimum search order list contains FORTH-WORDLIST and SET-ORDER



: SO1 SET-ORDER ;    \ In case it is unavailable in the forth wordlist



T{ ONLY FORTH-WORDLIST 1 SET-ORDER GET-ORDERLIST SO1 -> }T

T{ GET-ORDER -> GET-ORDERLIST }T



\ ------------------------------------------------------------------------------

TESTING GET-ORDER SET-ORDER with 0 and -1 number of wids argument



: SO2A GET-ORDER GET-ORDERLIST SET-ORDER ; \  To recover search 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 = ONLY



\ ------------------------------------------------------------------------------

TESTING DEFINITIONS PREVIOUS



T{ ONLY FORTH DEFINITIONS -> }T

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



\ ------------------------------------------------------------------------------

TESTING SEARCH-WORDLIST WORDLIST FIND



ONLY FORTH DEFINITIONS

VARIABLE XT  ' DUP XT !

VARIABLE XTI ' .( XTI !    \ Immediate word



T{ S" DUP" WID1 @ SEARCH-WORDLIST -> XT  @ -1 }T

T{ S" .("  WID1 @ SEARCH-WORDLIST -> XTI @  1 }T

T{ S" DUP" WID2 @ SEARCH-WORDLIST ->        0 }T



: C"DUP" C" DUP" ;

: C".("  C" .(" ;

: C"X" C" UNKNOWN WORD"  ;



T{ C"DUP" FIND -> XT  @ -1 }T

T{ C".("  FIND -> XTI @  1 }T

T{ C"X"   FIND -> C"X"   0 }T



\ ------------------------------------------------------------------------------

TESTING new definitions are put into the correct wordlist



: ALSOWID2 ALSO GET-ORDER WID2 @ ROT DROP SWAP SET-ORDER ;

ALSOWID2

: W2 1234  ;

DEFINITIONS

: W2 -9876 ; IMMEDIATE



ONLY FORTH

T{ W2 -> 1234 }T

DEFINITIONS

T{ W2 -> 1234 }T

ALSOWID2

T{ W2 -> -9876 }T

DEFINITIONS

T{ W2 -> -9876 }T



ONLY FORTH DEFINITIONS



: SO5  DUP IF SWAP EXECUTE THEN ;



T{ S" W2" WID1 @ SEARCH-WORDLIST SO5 -> -1  1234 }T

T{ S" W2" WID2 @ SEARCH-WORDLIST SO5 ->  1 -9876 }T



: C"W2" C" W2" ;

T{ ALSOWID2 C"W2" FIND SO5 ->  1 -9876 }T

T{ PREVIOUS C"W2" FIND SO5 -> -1  1234 }T



\ ------------------------------------------------------------------------------

TESTING ORDER  \ Should display search order and compilation wordlist



CR .( ONLY FORTH DEFINITIONS search order and compilation wordlist) CR

T{ ONLY FORTH DEFINITIONS ORDER -> }T



CR .( Plus another unnamed wordlist at the head of the search order) CR

T{ ALSOWID2 DEFINITIONS ORDER -> }T



\ ------------------------------------------------------------------------------



SEARCHORDER-ERRORS SET-ERROR-COUNT



CR .( End of Search Order word tests) CR



ONLY FORTH DEFINITIONS		\ Leave search order in the standard state