\ Tests for ANS Forth SEARCH-ORDER EXTENSION words - Version 1.0
\
\ by J.D.Medhurst a.k.a 'Tixy' 2002
\
\ This file is based on John Hayes' TESTER.FR and CORE.FR which
\ have the following copyright notice:
\
\ (C) 1995 JOHNS HOPKINS UNIVERSITY / APPLIED PHYSICS LABORATORY
\ MAY BE DISTRIBUTED FREELY AS LONG AS THIS COPYRIGHT NOTICE REMAINS.
\
\
\ Assumptions:
\ * TESTER.FR must be loaded before this file.
\ * Presence of CORE words and SEARCH-ORDER words.
\

TESTING SEARCH-ORDER-EXT WORDS
DECIMAL

\ Some utility words used for testing

: GCREATE-ORDER   ( "<spaces>name" -- )
	CREATE
	GET-ORDER
	DUP ,
	BEGIN
		DUP
	WHILE
		SWAP , 1-
	REPEAT
	DROP
;

: GNDROP   ( xn ... x1 n -- )
	BEGIN
		DUP
	WHILE
		SWAP DROP 1-
	REPEAT
	DROP
;

: GORDER=   ( widn ... wid1 n a-addr -- )
	OVER 1+ SWAP
	BEGIN
		OVER
	WHILE
		ROT OVER @ =
	WHILE
		CELL+ SWAP 1- SWAP
	REPEAT
		SWAP GNDROP 0
		EXIT
	THEN
	DROP DROP -1
;

: G1ST-WORDLIST   ( -- wid )
	GET-ORDER OVER >R GNDROP R>
;

: GRESTORE-ORDER   ( a-addr -- )
	DUP >R
	DUP @ CELLS +
	BEGIN
		DUP @ SWAP
		DUP R@ <>
	WHILE
		1 CELLS -
	REPEAT
	R> DROP DROP
	SET-ORDER
;

{ -> }   \ Start with clean slate

\ ------------------------------------------------------------------------
TESTING ALSO PREVIOUS

{ GCREATE-ORDER BUF -> }
{ GET-ORDER BUF GORDER= -> -1 }
{ ALSO -> }
{ GET-ORDER NIP 1- BUF GORDER= -> -1 }
{ G1ST-WORDLIST BUF CELL+ @ - -> 0 }
{ PREVIOUS -> }
{ GET-ORDER BUF GORDER= -> -1 }

\ ------------------------------------------------------------------------
TESTING FORTH ONLY ORDER

WORDLIST CONSTANT TEST-WORDLIST

{ GET-ORDER TEST-WORDLIST SWAP 1+ SET-ORDER -> }
{ G1ST-WORDLIST -> TEST-WORDLIST }

: GORDER1
	." YOU SHOULD SEE THE DICTIONARY SEARCH ORDER WITH A TEST WORDLIST AS" CR
	." THE 1ST IN THE SEARCH ORDER AND THE COMPILATION WORDLIST SET TO 'FORTH'" CR
	ORDER CR
;
{ GORDER1 -> }

{ FORTH -> }
{ G1ST-WORDLIST -> FORTH-WORDLIST }
{ GET-ORDER NIP 1- BUF GORDER= -> -1 }

: GONLY
	\ Set minimum search order
	ONLY
	\ Try and find two words
	BL WORD FIND 0= 0= NIP
	BL WORD FIND 0= 0= NIP
	." YOU SHOULD SEE THE MINIMUM SEARCH ORDER" CR
	ORDER CR
	\ Restore search order to that stored in BUF
	BUF
	DUP >R
	DUP @ CELLS +
	BEGIN
		DUP @ SWAP
		DUP R@ <>
	WHILE
		1 CELLS -
	REPEAT
	R> DROP DROP
	SET-ORDER
;
{ GONLY FORTH-WORDLIST SET-ORDER -> -1 -1 }