From d80736ab6e8e3cad2f1a30c6eaba2d6883dbe967 Mon Sep 17 00:00:00 2001 From: Dimitri Sokolyuk Date: Sat, 26 Aug 2017 20:31:40 +0200 Subject: Remove AmForth --- .../lib/forth2012/tester/searchordertest.fth | 178 --------------------- 1 file changed, 178 deletions(-) delete mode 100644 amforth-6.5/common/lib/forth2012/tester/searchordertest.fth (limited to 'amforth-6.5/common/lib/forth2012/tester/searchordertest.fth') diff --git a/amforth-6.5/common/lib/forth2012/tester/searchordertest.fth b/amforth-6.5/common/lib/forth2012/tester/searchordertest.fth deleted file mode 100644 index 79f9de9..0000000 --- a/amforth-6.5/common/lib/forth2012/tester/searchordertest.fth +++ /dev/null @@ -1,178 +0,0 @@ -\ 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 -- cgit v1.2.3