aboutsummaryrefslogtreecommitdiff
path: root/amforth-6.5/common/lib/forth2012/tester/searchordertest.fth
diff options
context:
space:
mode:
Diffstat (limited to 'amforth-6.5/common/lib/forth2012/tester/searchordertest.fth')
-rw-r--r--amforth-6.5/common/lib/forth2012/tester/searchordertest.fth178
1 files changed, 178 insertions, 0 deletions
diff --git a/amforth-6.5/common/lib/forth2012/tester/searchordertest.fth b/amforth-6.5/common/lib/forth2012/tester/searchordertest.fth
new file mode 100644
index 0000000..79f9de9
--- /dev/null
+++ b/amforth-6.5/common/lib/forth2012/tester/searchordertest.fth
@@ -0,0 +1,178 @@
+\ 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.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
+: 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
+
+\ ------------------------------------------------------------------------------
+TESTING ORDER \ Should display search order and compilation wordlist
+
+CR .( ONLY FORTH DEFINITIONS search order and compilation list) 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
+
+\ ------------------------------------------------------------------------------
+
+CR .( End of Search Order word tests) CR
+
+ONLY FORTH DEFINITIONS \ Leave search order in the standard state