mirror of
https://github.com/forth-ev/VolksForth.git
synced 2024-07-26 16:28:59 +00:00
770 lines
26 KiB
Forth
770 lines
26 KiB
Forth
|
\ To test the ANS Forth Core Extension word set
|
||
|
|
|
||
|
|
\ 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.13 28 October 2015
|
||
|
|
\ Replace <FALSE> and <TRUE> with FALSE and TRUE to avoid
|
||
|
|
\ dependence on Core tests
|
||
|
|
\ Moved SAVE-INPUT and RESTORE-INPUT tests in a file to filetest.fth
|
||
|
|
\ Use of 2VARIABLE (from optional wordset) replaced with CREATE.
|
||
|
|
\ Minor lower to upper case conversions.
|
||
|
|
\ Calls to COMPARE replaced by S= (in utilities.fth) to avoid use
|
||
|
|
\ of a word from an optional word set.
|
||
|
|
\ UNUSED tests revised as UNUSED UNUSED = may return FALSE when an
|
||
|
|
\ implementation has the data stack sharing unused dataspace.
|
||
|
|
\ Double number input dependency removed from the HOLDS tests.
|
||
|
|
\ Minor case sensitivities removed in definition names.
|
||
|
|
\ 0.11 25 April 2015
|
||
|
|
\ Added tests for PARSE-NAME HOLDS BUFFER:
|
||
|
|
\ S\" tests added
|
||
|
|
\ DEFER IS ACTION-OF DEFER! DEFER@ tests added
|
||
|
|
\ Empty CASE statement test added
|
||
|
|
\ [COMPILE] tests removed because it is obsolescent in Forth 2012
|
||
|
|
\ 0.10 1 August 2014
|
||
|
|
\ Added tests contributed by James Bowman for:
|
||
|
|
\ <> U> 0<> 0> NIP TUCK ROLL PICK 2>R 2R@ 2R>
|
||
|
|
\ HEX WITHIN UNUSED AGAIN MARKER
|
||
|
|
\ Added tests for:
|
||
|
|
\ .R U.R ERASE PAD REFILL SOURCE-ID
|
||
|
|
\ Removed ABORT from NeverExecuted to enable Win32
|
||
|
|
\ to continue after failure of RESTORE-INPUT.
|
||
|
|
\ Removed max-intx which is no longer used.
|
||
|
|
\ 0.7 6 June 2012 Extra CASE test added
|
||
|
|
\ 0.6 1 April 2012 Tests placed in the public domain.
|
||
|
|
\ SAVE-INPUT & RESTORE-INPUT tests, position
|
||
|
|
\ of T{ moved so that tests work with ttester.fs
|
||
|
|
\ CONVERT test deleted - obsolete word removed from Forth 200X
|
||
|
|
\ IMMEDIATE VALUEs tested
|
||
|
|
\ RECURSE with :NONAME tested
|
||
|
|
\ PARSE and .( tested
|
||
|
|
\ Parsing behaviour of C" added
|
||
|
|
\ 0.5 14 September 2011 Removed the double [ELSE] from the
|
||
|
|
\ initial SAVE-INPUT & RESTORE-INPUT test
|
||
|
|
\ 0.4 30 November 2009 max-int replaced with max-intx to
|
||
|
|
\ avoid redefinition warnings.
|
||
|
|
\ 0.3 6 March 2009 { and } replaced with T{ and }T
|
||
|
|
\ CONVERT test now independent of cell size
|
||
|
|
\ 0.2 20 April 2007 ANS Forth words changed to upper case
|
||
|
|
\ Tests qd3 to qd6 by Reinhold Straub
|
||
|
|
\ 0.1 Oct 2006 First version released
|
||
|
|
\ -----------------------------------------------------------------------------
|
||
|
|
\ The tests are based on John Hayes test program for the core word set
|
||
|
|
|
||
|
|
\ Words tested in this file are:
|
||
|
|
\ .( .R 0<> 0> 2>R 2R> 2R@ :NONAME <> ?DO AGAIN C" CASE COMPILE, ENDCASE
|
||
|
|
\ ENDOF ERASE FALSE HEX MARKER NIP OF PAD PARSE PICK REFILL
|
||
|
|
\ RESTORE-INPUT ROLL SAVE-INPUT SOURCE-ID TO TRUE TUCK U.R U> UNUSED
|
||
|
|
\ VALUE WITHIN [COMPILE]
|
||
|
|
|
||
|
|
\ Words not tested or partially tested:
|
||
|
|
\ \ because it has been extensively used already and is, hence, unnecessary
|
||
|
|
\ REFILL and SOURCE-ID from the user input device which are not possible
|
||
|
|
\ when testing from a file such as this one
|
||
|
|
\ UNUSED (partially tested) as the value returned is system dependent
|
||
|
|
\ Obsolescent words #TIB CONVERT EXPECT QUERY SPAN TIB as they have been
|
||
|
|
\ removed from the Forth 2012 standard
|
||
|
|
|
||
|
|
\ Results from words that output to the user output device have to visually
|
||
|
|
\ checked for correctness. These are .R U.R .(
|
||
|
|
|
||
|
|
\ -----------------------------------------------------------------------------
|
||
|
|
\ Assumptions & dependencies:
|
||
|
|
\ - tester.fr (or ttester.fs), errorreport.fth and utilities.fth have been
|
||
|
|
\ included prior to this file
|
||
|
|
\ - the Core word set available
|
||
|
|
\ -----------------------------------------------------------------------------
|
||
|
|
TESTING Core Extension words
|
||
|
|
|
||
|
|
DECIMAL
|
||
|
|
|
||
|
|
TESTING TRUE FALSE
|
||
|
|
|
||
|
|
T{ TRUE -> 0 INVERT }T
|
||
|
|
T{ FALSE -> 0 }T
|
||
|
|
|
||
|
|
\ -----------------------------------------------------------------------------
|
||
|
|
TESTING <> U> (contributed by James Bowman)
|
||
|
|
|
||
|
|
T{ 0 0 <> -> FALSE }T
|
||
|
|
T{ 1 1 <> -> FALSE }T
|
||
|
|
T{ -1 -1 <> -> FALSE }T
|
||
|
|
T{ 1 0 <> -> TRUE }T
|
||
|
|
T{ -1 0 <> -> TRUE }T
|
||
|
|
T{ 0 1 <> -> TRUE }T
|
||
|
|
T{ 0 -1 <> -> TRUE }T
|
||
|
|
|
||
|
|
T{ 0 1 U> -> FALSE }T
|
||
|
|
T{ 1 2 U> -> FALSE }T
|
||
|
|
T{ 0 MID-UINT U> -> FALSE }T
|
||
|
|
T{ 0 MAX-UINT U> -> FALSE }T
|
||
|
|
T{ MID-UINT MAX-UINT U> -> FALSE }T
|
||
|
|
T{ 0 0 U> -> FALSE }T
|
||
|
|
T{ 1 1 U> -> FALSE }T
|
||
|
|
T{ 1 0 U> -> TRUE }T
|
||
|
|
T{ 2 1 U> -> TRUE }T
|
||
|
|
T{ MID-UINT 0 U> -> TRUE }T
|
||
|
|
T{ MAX-UINT 0 U> -> TRUE }T
|
||
|
|
T{ MAX-UINT MID-UINT U> -> TRUE }T
|
||
|
|
|
||
|
|
\ -----------------------------------------------------------------------------
|
||
|
|
TESTING 0<> 0> (contributed by James Bowman)
|
||
|
|
|
||
|
|
T{ 0 0<> -> FALSE }T
|
||
|
|
T{ 1 0<> -> TRUE }T
|
||
|
|
T{ 2 0<> -> TRUE }T
|
||
|
|
T{ -1 0<> -> TRUE }T
|
||
|
|
T{ MAX-UINT 0<> -> TRUE }T
|
||
|
|
T{ MIN-INT 0<> -> TRUE }T
|
||
|
|
T{ MAX-INT 0<> -> TRUE }T
|
||
|
|
|
||
|
|
T{ 0 0> -> FALSE }T
|
||
|
|
T{ -1 0> -> FALSE }T
|
||
|
|
T{ MIN-INT 0> -> FALSE }T
|
||
|
|
T{ 1 0> -> TRUE }T
|
||
|
|
T{ MAX-INT 0> -> TRUE }T
|
||
|
|
|
||
|
|
\ -----------------------------------------------------------------------------
|
||
|
|
TESTING NIP TUCK ROLL PICK (contributed by James Bowman)
|
||
|
|
|
||
|
|
T{ 1 2 NIP -> 2 }T
|
||
|
|
T{ 1 2 3 NIP -> 1 3 }T
|
||
|
|
|
||
|
|
T{ 1 2 TUCK -> 2 1 2 }T
|
||
|
|
T{ 1 2 3 TUCK -> 1 3 2 3 }T
|
||
|
|
|
||
|
|
T{ : RO5 100 200 300 400 500 ; -> }T
|
||
|
|
T{ RO5 3 ROLL -> 100 300 400 500 200 }T
|
||
|
|
T{ RO5 2 ROLL -> RO5 ROT }T
|
||
|
|
T{ RO5 1 ROLL -> RO5 SWAP }T
|
||
|
|
T{ RO5 0 ROLL -> RO5 }T
|
||
|
|
|
||
|
|
T{ RO5 2 PICK -> 100 200 300 400 500 300 }T
|
||
|
|
T{ RO5 1 PICK -> RO5 OVER }T
|
||
|
|
T{ RO5 0 PICK -> RO5 DUP }T
|
||
|
|
|
||
|
|
\ -----------------------------------------------------------------------------
|
||
|
|
TESTING 2>R 2R@ 2R> (contributed by James Bowman)
|
||
|
|
|
||
|
|
T{ : RR0 2>R 100 R> R> ; -> }T
|
||
|
|
T{ 300 400 RR0 -> 100 400 300 }T
|
||
|
|
T{ 200 300 400 RR0 -> 200 100 400 300 }T
|
||
|
|
|
||
|
|
T{ : RR1 2>R 100 2R@ R> R> ; -> }T
|
||
|
|
T{ 300 400 RR1 -> 100 300 400 400 300 }T
|
||
|
|
T{ 200 300 400 RR1 -> 200 100 300 400 400 300 }T
|
||
|
|
|
||
|
|
T{ : RR2 2>R 100 2R> ; -> }T
|
||
|
|
T{ 300 400 RR2 -> 100 300 400 }T
|
||
|
|
T{ 200 300 400 RR2 -> 200 100 300 400 }T
|
||
|
|
|
||
|
|
\ -----------------------------------------------------------------------------
|
||
|
|
TESTING HEX (contributed by James Bowman)
|
||
|
|
|
||
|
|
T{ BASE @ HEX BASE @ DECIMAL BASE @ - SWAP BASE ! -> 6 }T
|
||
|
|
|
||
|
|
\ -----------------------------------------------------------------------------
|
||
|
|
TESTING WITHIN (contributed by James Bowman)
|
||
|
|
|
||
|
|
T{ 0 0 0 WITHIN -> FALSE }T
|
||
|
|
T{ 0 0 MID-UINT WITHIN -> TRUE }T
|
||
|
|
T{ 0 0 MID-UINT+1 WITHIN -> TRUE }T
|
||
|
|
T{ 0 0 MAX-UINT WITHIN -> TRUE }T
|
||
|
|
T{ 0 MID-UINT 0 WITHIN -> FALSE }T
|
||
|
|
T{ 0 MID-UINT MID-UINT WITHIN -> FALSE }T
|
||
|
|
T{ 0 MID-UINT MID-UINT+1 WITHIN -> FALSE }T
|
||
|
|
T{ 0 MID-UINT MAX-UINT WITHIN -> FALSE }T
|
||
|
|
T{ 0 MID-UINT+1 0 WITHIN -> FALSE }T
|
||
|
|
T{ 0 MID-UINT+1 MID-UINT WITHIN -> TRUE }T
|
||
|
|
T{ 0 MID-UINT+1 MID-UINT+1 WITHIN -> FALSE }T
|
||
|
|
T{ 0 MID-UINT+1 MAX-UINT WITHIN -> FALSE }T
|
||
|
|
T{ 0 MAX-UINT 0 WITHIN -> FALSE }T
|
||
|
|
T{ 0 MAX-UINT MID-UINT WITHIN -> TRUE }T
|
||
|
|
T{ 0 MAX-UINT MID-UINT+1 WITHIN -> TRUE }T
|
||
|
|
T{ 0 MAX-UINT MAX-UINT WITHIN -> FALSE }T
|
||
|
|
T{ MID-UINT 0 0 WITHIN -> FALSE }T
|
||
|
|
T{ MID-UINT 0 MID-UINT WITHIN -> FALSE }T
|
||
|
|
T{ MID-UINT 0 MID-UINT+1 WITHIN -> TRUE }T
|
||
|
|
T{ MID-UINT 0 MAX-UINT WITHIN -> TRUE }T
|
||
|
|
T{ MID-UINT MID-UINT 0 WITHIN -> TRUE }T
|
||
|
|
T{ MID-UINT MID-UINT MID-UINT WITHIN -> FALSE }T
|
||
|
|
T{ MID-UINT MID-UINT MID-UINT+1 WITHIN -> TRUE }T
|
||
|
|
T{ MID-UINT MID-UINT MAX-UINT WITHIN -> TRUE }T
|
||
|
|
T{ MID-UINT MID-UINT+1 0 WITHIN -> FALSE }T
|
||
|
|
T{ MID-UINT MID-UINT+1 MID-UINT WITHIN -> FALSE }T
|
||
|
|
T{ MID-UINT MID-UINT+1 MID-UINT+1 WITHIN -> FALSE }T
|
||
|
|
T{ MID-UINT MID-UINT+1 MAX-UINT WITHIN -> FALSE }T
|
||
|
|
T{ MID-UINT MAX-UINT 0 WITHIN -> FALSE }T
|
||
|
|
T{ MID-UINT MAX-UINT MID-UINT WITHIN -> FALSE }T
|
||
|
|
T{ MID-UINT MAX-UINT MID-UINT+1 WITHIN -> TRUE }T
|
||
|
|
T{ MID-UINT MAX-UINT MAX-UINT WITHIN -> FALSE }T
|
||
|
|
T{ MID-UINT+1 0 0 WITHIN -> FALSE }T
|
||
|
|
T{ MID-UINT+1 0 MID-UINT WITHIN -> FALSE }T
|
||
|
|
T{ MID-UINT+1 0 MID-UINT+1 WITHIN -> FALSE }T
|
||
|
|
T{ MID-UINT+1 0 MAX-UINT WITHIN -> TRUE }T
|
||
|
|
T{ MID-UINT+1 MID-UINT 0 WITHIN -> TRUE }T
|
||
|
|
T{ MID-UINT+1 MID-UINT MID-UINT WITHIN -> FALSE }T
|
||
|
|
T{ MID-UINT+1 MID-UINT MID-UINT+1 WITHIN -> FALSE }T
|
||
|
|
T{ MID-UINT+1 MID-UINT MAX-UINT WITHIN -> TRUE }T
|
||
|
|
T{ MID-UINT+1 MID-UINT+1 0 WITHIN -> TRUE }T
|
||
|
|
T{ MID-UINT+1 MID-UINT+1 MID-UINT WITHIN -> TRUE }T
|
||
|
|
T{ MID-UINT+1 MID-UINT+1 MID-UINT+1 WITHIN -> FALSE }T
|
||
|
|
T{ MID-UINT+1 MID-UINT+1 MAX-UINT WITHIN -> TRUE }T
|
||
|
|
T{ MID-UINT+1 MAX-UINT 0 WITHIN -> FALSE }T
|
||
|
|
T{ MID-UINT+1 MAX-UINT MID-UINT WITHIN -> FALSE }T
|
||
|
|
T{ MID-UINT+1 MAX-UINT MID-UINT+1 WITHIN -> FALSE }T
|
||
|
|
T{ MID-UINT+1 MAX-UINT MAX-UINT WITHIN -> FALSE }T
|
||
|
|
T{ MAX-UINT 0 0 WITHIN -> FALSE }T
|
||
|
|
T{ MAX-UINT 0 MID-UINT WITHIN -> FALSE }T
|
||
|
|
T{ MAX-UINT 0 MID-UINT+1 WITHIN -> FALSE }T
|
||
|
|
T{ MAX-UINT 0 MAX-UINT WITHIN -> FALSE }T
|
||
|
|
T{ MAX-UINT MID-UINT 0 WITHIN -> TRUE }T
|
||
|
|
T{ MAX-UINT MID-UINT MID-UINT WITHIN -> FALSE }T
|
||
|
|
T{ MAX-UINT MID-UINT MID-UINT+1 WITHIN -> FALSE }T
|
||
|
|
T{ MAX-UINT MID-UINT MAX-UINT WITHIN -> FALSE }T
|
||
|
|
T{ MAX-UINT MID-UINT+1 0 WITHIN -> TRUE }T
|
||
|
|
T{ MAX-UINT MID-UINT+1 MID-UINT WITHIN -> TRUE }T
|
||
|
|
T{ MAX-UINT MID-UINT+1 MID-UINT+1 WITHIN -> FALSE }T
|
||
|
|
T{ MAX-UINT MID-UINT+1 MAX-UINT WITHIN -> FALSE }T
|
||
|
|
T{ MAX-UINT MAX-UINT 0 WITHIN -> TRUE }T
|
||
|
|
T{ MAX-UINT MAX-UINT MID-UINT WITHIN -> TRUE }T
|
||
|
|
T{ MAX-UINT MAX-UINT MID-UINT+1 WITHIN -> TRUE }T
|
||
|
|
T{ MAX-UINT MAX-UINT MAX-UINT WITHIN -> FALSE }T
|
||
|
|
|
||
|
|
T{ MIN-INT MIN-INT MIN-INT WITHIN -> FALSE }T
|
||
|
|
T{ MIN-INT MIN-INT 0 WITHIN -> TRUE }T
|
||
|
|
T{ MIN-INT MIN-INT 1 WITHIN -> TRUE }T
|
||
|
|
T{ MIN-INT MIN-INT MAX-INT WITHIN -> TRUE }T
|
||
|
|
T{ MIN-INT 0 MIN-INT WITHIN -> FALSE }T
|
||
|
|
T{ MIN-INT 0 0 WITHIN -> FALSE }T
|
||
|
|
T{ MIN-INT 0 1 WITHIN -> FALSE }T
|
||
|
|
T{ MIN-INT 0 MAX-INT WITHIN -> FALSE }T
|
||
|
|
T{ MIN-INT 1 MIN-INT WITHIN -> FALSE }T
|
||
|
|
T{ MIN-INT 1 0 WITHIN -> TRUE }T
|
||
|
|
T{ MIN-INT 1 1 WITHIN -> FALSE }T
|
||
|
|
T{ MIN-INT 1 MAX-INT WITHIN -> FALSE }T
|
||
|
|
T{ MIN-INT MAX-INT MIN-INT WITHIN -> FALSE }T
|
||
|
|
T{ MIN-INT MAX-INT 0 WITHIN -> TRUE }T
|
||
|
|
T{ MIN-INT MAX-INT 1 WITHIN -> TRUE }T
|
||
|
|
T{ MIN-INT MAX-INT MAX-INT WITHIN -> FALSE }T
|
||
|
|
T{ 0 MIN-INT MIN-INT WITHIN -> FALSE }T
|
||
|
|
T{ 0 MIN-INT 0 WITHIN -> FALSE }T
|
||
|
|
T{ 0 MIN-INT 1 WITHIN -> TRUE }T
|
||
|
|
T{ 0 MIN-INT MAX-INT WITHIN -> TRUE }T
|
||
|
|
T{ 0 0 MIN-INT WITHIN -> TRUE }T
|
||
|
|
T{ 0 0 0 WITHIN -> FALSE }T
|
||
|
|
T{ 0 0 1 WITHIN -> TRUE }T
|
||
|
|
T{ 0 0 MAX-INT WITHIN -> TRUE }T
|
||
|
|
T{ 0 1 MIN-INT WITHIN -> FALSE }T
|
||
|
|
T{ 0 1 0 WITHIN -> FALSE }T
|
||
|
|
T{ 0 1 1 WITHIN -> FALSE }T
|
||
|
|
T{ 0 1 MAX-INT WITHIN -> FALSE }T
|
||
|
|
T{ 0 MAX-INT MIN-INT WITHIN -> FALSE }T
|
||
|
|
T{ 0 MAX-INT 0 WITHIN -> FALSE }T
|
||
|
|
T{ 0 MAX-INT 1 WITHIN -> TRUE }T
|
||
|
|
T{ 0 MAX-INT MAX-INT WITHIN -> FALSE }T
|
||
|
|
T{ 1 MIN-INT MIN-INT WITHIN -> FALSE }T
|
||
|
|
T{ 1 MIN-INT 0 WITHIN -> FALSE }T
|
||
|
|
T{ 1 MIN-INT 1 WITHIN -> FALSE }T
|
||
|
|
T{ 1 MIN-INT MAX-INT WITHIN -> TRUE }T
|
||
|
|
T{ 1 0 MIN-INT WITHIN -> TRUE }T
|
||
|
|
T{ 1 0 0 WITHIN -> FALSE }T
|
||
|
|
T{ 1 0 1 WITHIN -> FALSE }T
|
||
|
|
T{ 1 0 MAX-INT WITHIN -> TRUE }T
|
||
|
|
T{ 1 1 MIN-INT WITHIN -> TRUE }T
|
||
|
|
T{ 1 1 0 WITHIN -> TRUE }T
|
||
|
|
T{ 1 1 1 WITHIN -> FALSE }T
|
||
|
|
T{ 1 1 MAX-INT WITHIN -> TRUE }T
|
||
|
|
T{ 1 MAX-INT MIN-INT WITHIN -> FALSE }T
|
||
|
|
T{ 1 MAX-INT 0 WITHIN -> FALSE }T
|
||
|
|
T{ 1 MAX-INT 1 WITHIN -> FALSE }T
|
||
|
|
T{ 1 MAX-INT MAX-INT WITHIN -> FALSE }T
|
||
|
|
T{ MAX-INT MIN-INT MIN-INT WITHIN -> FALSE }T
|
||
|
|
T{ MAX-INT MIN-INT 0 WITHIN -> FALSE }T
|
||
|
|
T{ MAX-INT MIN-INT 1 WITHIN -> FALSE }T
|
||
|
|
T{ MAX-INT MIN-INT MAX-INT WITHIN -> FALSE }T
|
||
|
|
T{ MAX-INT 0 MIN-INT WITHIN -> TRUE }T
|
||
|
|
T{ MAX-INT 0 0 WITHIN -> FALSE }T
|
||
|
|
T{ MAX-INT 0 1 WITHIN -> FALSE }T
|
||
|
|
T{ MAX-INT 0 MAX-INT WITHIN -> FALSE }T
|
||
|
|
T{ MAX-INT 1 MIN-INT WITHIN -> TRUE }T
|
||
|
|
T{ MAX-INT 1 0 WITHIN -> TRUE }T
|
||
|
|
T{ MAX-INT 1 1 WITHIN -> FALSE }T
|
||
|
|
T{ MAX-INT 1 MAX-INT WITHIN -> FALSE }T
|
||
|
|
T{ MAX-INT MAX-INT MIN-INT WITHIN -> TRUE }T
|
||
|
|
T{ MAX-INT MAX-INT 0 WITHIN -> TRUE }T
|
||
|
|
T{ MAX-INT MAX-INT 1 WITHIN -> TRUE }T
|
||
|
|
T{ MAX-INT MAX-INT MAX-INT WITHIN -> FALSE }T
|
||
|
|
|
||
|
|
\ -----------------------------------------------------------------------------
|
||
|
|
TESTING UNUSED (contributed by James Bowman & Peter Knaggs)
|
||
|
|
|
||
|
|
VARIABLE UNUSED0
|
||
|
|
T{ UNUSED DROP -> }T
|
||
|
|
T{ ALIGN UNUSED UNUSED0 ! 0 , UNUSED CELL+ UNUSED0 @ = -> TRUE }T
|
||
|
|
T{ UNUSED UNUSED0 ! 0 C, UNUSED CHAR+ UNUSED0 @ =
|
||
|
|
-> TRUE }T \ aligned -> unaligned
|
||
|
|
T{ UNUSED UNUSED0 ! 0 C, UNUSED CHAR+ UNUSED0 @ = -> TRUE }T \ unaligned -> ?
|
||
|
|
|
||
|
|
\ -----------------------------------------------------------------------------
|
||
|
|
TESTING AGAIN (contributed by James Bowman)
|
||
|
|
|
||
|
|
T{ : AG0 701 BEGIN DUP 7 MOD 0= IF EXIT THEN 1+ AGAIN ; -> }T
|
||
|
|
T{ AG0 -> 707 }T
|
||
|
|
|
||
|
|
\ -----------------------------------------------------------------------------
|
||
|
|
\vf TESTING MARKER (contributed by James Bowman)
|
||
|
|
|
||
|
|
\vf T{ : MA? BL WORD FIND NIP 0<> ; -> }T
|
||
|
|
\vf T{ MARKER MA0 -> }T
|
||
|
|
\vf T{ : MA1 111 ; -> }T
|
||
|
|
\vf T{ MARKER MA2 -> }T
|
||
|
|
\vf T{ : MA1 222 ; -> }T
|
||
|
|
\vf T{ MA? MA0 MA? MA1 MA? MA2 -> TRUE TRUE TRUE }T
|
||
|
|
\vf T{ MA1 MA2 MA1 -> 222 111 }T
|
||
|
|
\vf T{ MA? MA0 MA? MA1 MA? MA2 -> TRUE TRUE FALSE }T
|
||
|
|
\vf T{ MA0 -> }T
|
||
|
|
\vf T{ MA? MA0 MA? MA1 MA? MA2 -> FALSE FALSE FALSE }T
|
||
|
|
|
||
|
|
\ -----------------------------------------------------------------------------
|
||
|
|
TESTING ?DO
|
||
|
|
|
||
|
|
: QD ?DO I LOOP ;
|
||
|
|
T{ 789 789 QD -> }T
|
||
|
|
T{ -9876 -9876 QD -> }T
|
||
|
|
T{ 5 0 QD -> 0 1 2 3 4 }T
|
||
|
|
|
||
|
|
: QD1 ?DO I 10 +LOOP ;
|
||
|
|
T{ 50 1 QD1 -> 1 11 21 31 41 }T
|
||
|
|
T{ 50 0 QD1 -> 0 10 20 30 40 }T
|
||
|
|
|
||
|
|
: QD2 ?DO I 3 > IF LEAVE ELSE I THEN LOOP ;
|
||
|
|
T{ 5 -1 QD2 -> -1 0 1 2 3 }T
|
||
|
|
|
||
|
|
: QD3 ?DO I 1 +LOOP ;
|
||
|
|
T{ 4 4 QD3 -> }T
|
||
|
|
T{ 4 1 QD3 -> 1 2 3 }T
|
||
|
|
T{ 2 -1 QD3 -> -1 0 1 }T
|
||
|
|
|
||
|
|
: QD4 ?DO I -1 +LOOP ;
|
||
|
|
T{ 4 4 QD4 -> }T
|
||
|
|
T{ 1 4 QD4 -> 4 3 2 1 }T
|
||
|
|
T{ -1 2 QD4 -> 2 1 0 -1 }T
|
||
|
|
|
||
|
|
: QD5 ?DO I -10 +LOOP ;
|
||
|
|
T{ 1 50 QD5 -> 50 40 30 20 10 }T
|
||
|
|
T{ 0 50 QD5 -> 50 40 30 20 10 0 }T
|
||
|
|
T{ -25 10 QD5 -> 10 0 -10 -20 }T
|
||
|
|
|
||
|
|
VARIABLE ITERS
|
||
|
|
VARIABLE INCRMNT
|
||
|
|
|
||
|
|
: QD6 ( limit start increment -- )
|
||
|
|
INCRMNT !
|
||
|
|
0 ITERS !
|
||
|
|
?DO
|
||
|
|
1 ITERS +!
|
||
|
|
I
|
||
|
|
ITERS @ 6 = IF LEAVE THEN
|
||
|
|
INCRMNT @
|
||
|
|
+LOOP ITERS @
|
||
|
|
;
|
||
|
|
|
||
|
|
T{ 4 4 -1 QD6 -> 0 }T
|
||
|
|
T{ 1 4 -1 QD6 -> 4 3 2 1 4 }T
|
||
|
|
T{ 4 1 -1 QD6 -> 1 0 -1 -2 -3 -4 6 }T
|
||
|
|
T{ 4 1 0 QD6 -> 1 1 1 1 1 1 6 }T
|
||
|
|
T{ 0 0 0 QD6 -> 0 }T
|
||
|
|
T{ 1 4 0 QD6 -> 4 4 4 4 4 4 6 }T
|
||
|
|
T{ 1 4 1 QD6 -> 4 5 6 7 8 9 6 }T
|
||
|
|
T{ 4 1 1 QD6 -> 1 2 3 3 }T
|
||
|
|
T{ 4 4 1 QD6 -> 0 }T
|
||
|
|
T{ 2 -1 -1 QD6 -> -1 -2 -3 -4 -5 -6 6 }T
|
||
|
|
T{ -1 2 -1 QD6 -> 2 1 0 -1 4 }T
|
||
|
|
T{ 2 -1 0 QD6 -> -1 -1 -1 -1 -1 -1 6 }T
|
||
|
|
T{ -1 2 0 QD6 -> 2 2 2 2 2 2 6 }T
|
||
|
|
T{ -1 2 1 QD6 -> 2 3 4 5 6 7 6 }T
|
||
|
|
T{ 2 -1 1 QD6 -> -1 0 1 3 }T
|
||
|
|
|
||
|
|
\ -----------------------------------------------------------------------------
|
||
|
|
TESTING BUFFER:
|
||
|
|
|
||
|
|
T{ 8 BUFFER: BUF:TEST -> }T
|
||
|
|
T{ BUF:TEST DUP ALIGNED = -> TRUE }T
|
||
|
|
T{ 111 BUF:TEST ! 222 BUF:TEST CELL+ ! -> }T
|
||
|
|
T{ BUF:TEST @ BUF:TEST CELL+ @ -> 111 222 }T
|
||
|
|
|
||
|
|
\ -----------------------------------------------------------------------------
|
||
|
|
\vf TESTING VALUE TO
|
||
|
|
|
||
|
|
\vf T{ 111 VALUE VAL1 -999 VALUE VAL2 -> }T
|
||
|
|
\vf T{ VAL1 -> 111 }T
|
||
|
|
\vf T{ VAL2 -> -999 }T
|
||
|
|
\vf T{ 222 TO VAL1 -> }T
|
||
|
|
\vf T{ VAL1 -> 222 }T
|
||
|
|
\vf T{ : VD1 VAL1 ; -> }T
|
||
|
|
\vf T{ VD1 -> 222 }T
|
||
|
|
\vf T{ : VD2 TO VAL2 ; -> }T
|
||
|
|
\vf T{ VAL2 -> -999 }T
|
||
|
|
\vf T{ -333 VD2 -> }T
|
||
|
|
\vf T{ VAL2 -> -333 }T
|
||
|
|
\vf T{ VAL1 -> 222 }T
|
||
|
|
\vf T{ 123 VALUE VAL3 IMMEDIATE VAL3 -> 123 }T
|
||
|
|
\vf T{ : VD3 VAL3 LITERAL ; VD3 -> 123 }T
|
||
|
|
|
||
|
|
\ -----------------------------------------------------------------------------
|
||
|
|
\vf TESTING CASE OF ENDOF ENDCASE
|
||
|
|
|
||
|
|
\vf : CS1 CASE 1 OF 111 ENDOF
|
||
|
|
\vf 2 OF 222 ENDOF
|
||
|
|
\vf 3 OF 333 ENDOF
|
||
|
|
\vf >R 999 R>
|
||
|
|
\vf ENDCASE
|
||
|
|
\vf ;
|
||
|
|
|
||
|
|
\vf T{ 1 CS1 -> 111 }T
|
||
|
|
\vf T{ 2 CS1 -> 222 }T
|
||
|
|
\vf T{ 3 CS1 -> 333 }T
|
||
|
|
\vf T{ 4 CS1 -> 999 }T
|
||
|
|
|
||
|
|
\ Nested CASE's
|
||
|
|
|
||
|
|
\vf : CS2 >R CASE -1 OF CASE R@ 1 OF 100 ENDOF
|
||
|
|
\vf 2 OF 200 ENDOF
|
||
|
|
\vf >R -300 R>
|
||
|
|
\vf ENDCASE
|
||
|
|
\vf ENDOF
|
||
|
|
\vf -2 OF CASE R@ 1 OF -99 ENDOF
|
||
|
|
\vf >R -199 R>
|
||
|
|
\vf ENDCASE
|
||
|
|
\vf ENDOF
|
||
|
|
\vf >R 299 R>
|
||
|
|
\vf ENDCASE R> DROP
|
||
|
|
\vf ;
|
||
|
|
|
||
|
|
\vf T{ -1 1 CS2 -> 100 }T
|
||
|
|
\vf T{ -1 2 CS2 -> 200 }T
|
||
|
|
\vf T{ -1 3 CS2 -> -300 }T
|
||
|
|
\vf T{ -2 1 CS2 -> -99 }T
|
||
|
|
\vf T{ -2 2 CS2 -> -199 }T
|
||
|
|
\vf T{ 0 2 CS2 -> 299 }T
|
||
|
|
|
||
|
|
\ Boolean short circuiting using CASE
|
||
|
|
|
||
|
|
\vf : CS3 ( N1 -- N2 )
|
||
|
|
\vf CASE 1- FALSE OF 11 ENDOF
|
||
|
|
\vf 1- FALSE OF 22 ENDOF
|
||
|
|
\vf 1- FALSE OF 33 ENDOF
|
||
|
|
\vf 44 SWAP
|
||
|
|
\vf ENDCASE
|
||
|
|
\vf ;
|
||
|
|
|
||
|
|
\vf T{ 1 CS3 -> 11 }T
|
||
|
|
\vf T{ 2 CS3 -> 22 }T
|
||
|
|
\vf T{ 3 CS3 -> 33 }T
|
||
|
|
\vf T{ 9 CS3 -> 44 }T
|
||
|
|
|
||
|
|
\ Empty CASE statements with/without default
|
||
|
|
|
||
|
|
\vf T{ : CS4 CASE ENDCASE ; 1 CS4 -> }T
|
||
|
|
\vf T{ : CS5 CASE 2 SWAP ENDCASE ; 1 CS5 -> 2 }T
|
||
|
|
\vf T{ : CS6 CASE 1 OF ENDOF 2 ENDCASE ; 1 CS6 -> }T
|
||
|
|
\vf T{ : CS7 CASE 3 OF ENDOF 2 ENDCASE ; 1 CS7 -> 1 }T
|
||
|
|
|
||
|
|
\ -----------------------------------------------------------------------------
|
||
|
|
\vf TESTING :NONAME RECURSE
|
||
|
|
|
||
|
|
\vf VARIABLE NN1
|
||
|
|
\vf VARIABLE NN2
|
||
|
|
\vf :NONAME 1234 ; NN1 !
|
||
|
|
\vf :NONAME 9876 ; NN2 !
|
||
|
|
\vf T{ NN1 @ EXECUTE -> 1234 }T
|
||
|
|
\vf T{ NN2 @ EXECUTE -> 9876 }T
|
||
|
|
|
||
|
|
\vf T{ :NONAME ( n -- 0,1,..n ) DUP IF DUP >R 1- RECURSE R> THEN ;
|
||
|
|
\vf CONSTANT RN1 -> }T
|
||
|
|
\vf T{ 0 RN1 EXECUTE -> 0 }T
|
||
|
|
\vf T{ 4 RN1 EXECUTE -> 0 1 2 3 4 }T
|
||
|
|
|
||
|
|
\vf :NONAME ( n -- n1 ) \ Multiple RECURSEs in one definition
|
||
|
|
\vf 1- DUP
|
||
|
|
\vf CASE 0 OF EXIT ENDOF
|
||
|
|
\vf 1 OF 11 SWAP RECURSE ENDOF
|
||
|
|
\vf 2 OF 22 SWAP RECURSE ENDOF
|
||
|
|
\vf 3 OF 33 SWAP RECURSE ENDOF
|
||
|
|
\vf DROP ABS RECURSE EXIT
|
||
|
|
\vf ENDCASE
|
||
|
|
\vf ; CONSTANT RN2
|
||
|
|
|
||
|
|
\vf T{ 1 RN2 EXECUTE -> 0 }T
|
||
|
|
\vf T{ 2 RN2 EXECUTE -> 11 0 }T
|
||
|
|
\vf T{ 4 RN2 EXECUTE -> 33 22 11 0 }T
|
||
|
|
\vf T{ 25 RN2 EXECUTE -> 33 22 11 0 }T
|
||
|
|
|
||
|
|
\ -----------------------------------------------------------------------------
|
||
|
|
\vf TESTING C"
|
||
|
|
|
||
|
|
T{ : CQ1 C" 123" ; -> }T
|
||
|
|
\vf T{ CQ1 COUNT EVALUATE -> 123 }T
|
||
|
|
T{ : CQ2 C" " ; -> }T
|
||
|
|
\vf T{ CQ2 COUNT EVALUATE -> }T
|
||
|
|
\vf T{ : CQ3 C" 2345"COUNT EVALUATE ; CQ3 -> 2345 }T
|
||
|
|
|
||
|
|
\ -----------------------------------------------------------------------------
|
||
|
|
TESTING COMPILE,
|
||
|
|
|
||
|
|
:NONAME DUP + ; CONSTANT DUP+
|
||
|
|
T{ : Q DUP+ COMPILE, ; -> }T
|
||
|
|
T{ : AS1 [ Q ] ; -> }T
|
||
|
|
T{ 123 AS1 -> 246 }T
|
||
|
|
|
||
|
|
\ -----------------------------------------------------------------------------
|
||
|
|
\ Cannot automatically test SAVE-INPUT and RESTORE-INPUT from a console source
|
||
|
|
|
||
|
|
\vf TESTING SAVE-INPUT and RESTORE-INPUT with a string source
|
||
|
|
|
||
|
|
\vf VARIABLE SI_INC 0 SI_INC !
|
||
|
|
|
||
|
|
\vf : SI1
|
||
|
|
\vf SI_INC @ >IN +!
|
||
|
|
\vf 15 SI_INC !
|
||
|
|
\vf ;
|
||
|
|
|
||
|
|
\vf : S$ S" SAVE-INPUT SI1 RESTORE-INPUT 12345" ;
|
||
|
|
|
||
|
|
\vf T{ S$ EVALUATE SI_INC @ -> 0 2345 15 }T
|
||
|
|
|
||
|
|
\ -----------------------------------------------------------------------------
|
||
|
|
TESTING .(
|
||
|
|
|
||
|
|
CR CR .( Output from .()
|
||
|
|
T{ CR .( You should see -9876: ) -9876 . -> }T
|
||
|
|
T{ CR .( and again: ).( -9876)CR -> }T
|
||
|
|
|
||
|
|
CR CR .( On the next 2 lines you should see First then Second messages:)
|
||
|
|
T{ : DOTP CR ." Second message via ." [CHAR] " EMIT \ Check .( is immediate
|
||
|
|
[ CR ] .( First message via .( ) ; DOTP -> }T
|
||
|
|
CR CR
|
||
|
|
T{ : IMM? BL WORD FIND NIP ; IMM? .( -> 1 }T
|
||
|
|
|
||
|
|
\ -----------------------------------------------------------------------------
|
||
|
|
TESTING .R and U.R - has to handle different cell sizes
|
||
|
|
|
||
|
|
\ Create some large integers just below/above MAX and Min INTs
|
||
|
|
MAX-INT 73 79 */ CONSTANT LI1
|
||
|
|
MIN-INT 71 73 */ CONSTANT LI2
|
||
|
|
|
||
|
|
LI1 0 <# #S #> NIP CONSTANT LENLI1
|
||
|
|
|
||
|
|
: (.R&U.R) ( u1 u2 -- ) \ u1 <= string length, u2 is required indentation
|
||
|
|
TUCK + >R
|
||
|
|
LI1 OVER SPACES . CR R@ LI1 SWAP .R CR
|
||
|
|
LI2 OVER SPACES . CR R@ 1+ LI2 SWAP .R CR
|
||
|
|
LI1 OVER SPACES U. CR R@ LI1 SWAP U.R CR
|
||
|
|
LI2 SWAP SPACES U. CR R> LI2 SWAP U.R CR
|
||
|
|
;
|
||
|
|
|
||
|
|
: .R&U.R ( -- )
|
||
|
|
CR ." You should see lines duplicated:" CR
|
||
|
|
." indented by 0 spaces" CR 0 0 (.R&U.R) CR
|
||
|
|
." indented by 0 spaces" CR LENLI1 0 (.R&U.R) CR \ Just fits required width
|
||
|
|
." indented by 5 spaces" CR LENLI1 5 (.R&U.R) CR
|
||
|
|
;
|
||
|
|
|
||
|
|
CR CR .( Output from .R and U.R)
|
||
|
|
T{ .R&U.R -> }T
|
||
|
|
|
||
|
|
\ -----------------------------------------------------------------------------
|
||
|
|
TESTING PAD ERASE
|
||
|
|
\ Must handle different size characters i.e. 1 CHARS >= 1
|
||
|
|
|
||
|
|
84 CONSTANT CHARS/PAD \ Minimum size of PAD in chars
|
||
|
|
CHARS/PAD CHARS CONSTANT AUS/PAD
|
||
|
|
: CHECKPAD ( caddr u ch -- f ) \ f = TRUE if u chars = ch
|
||
|
|
SWAP 0
|
||
|
|
?DO
|
||
|
|
OVER I CHARS + C@ OVER <>
|
||
|
|
IF 2DROP UNLOOP FALSE EXIT THEN
|
||
|
|
LOOP
|
||
|
|
2DROP TRUE
|
||
|
|
;
|
||
|
|
|
||
|
|
T{ PAD DROP -> }T
|
||
|
|
T{ 0 INVERT PAD C! -> }T
|
||
|
|
T{ PAD C@ CONSTANT MAXCHAR -> }T
|
||
|
|
T{ PAD CHARS/PAD 2DUP MAXCHAR FILL MAXCHAR CHECKPAD -> TRUE }T
|
||
|
|
T{ PAD CHARS/PAD 2DUP CHARS ERASE 0 CHECKPAD -> TRUE }T
|
||
|
|
T{ PAD CHARS/PAD 2DUP MAXCHAR FILL PAD 0 ERASE MAXCHAR CHECKPAD -> TRUE }T
|
||
|
|
T{ PAD 43 CHARS + 9 CHARS ERASE -> }T
|
||
|
|
T{ PAD 43 MAXCHAR CHECKPAD -> TRUE }T
|
||
|
|
T{ PAD 43 CHARS + 9 0 CHECKPAD -> TRUE }T
|
||
|
|
T{ PAD 52 CHARS + CHARS/PAD 52 - MAXCHAR CHECKPAD -> TRUE }T
|
||
|
|
|
||
|
|
\ Check that use of WORD and pictured numeric output do not corrupt PAD
|
||
|
|
\ Minimum size of buffers for these are 33 chars and (2*n)+2 chars respectively
|
||
|
|
\ where n is number of bits per cell
|
||
|
|
|
||
|
|
PAD CHARS/PAD ERASE
|
||
|
|
2 BASE !
|
||
|
|
MAX-UINT MAX-UINT <# #S CHAR 1 DUP HOLD HOLD #> 2DROP
|
||
|
|
DECIMAL
|
||
|
|
BL WORD 12345678123456781234567812345678 DROP
|
||
|
|
T{ PAD CHARS/PAD 0 CHECKPAD -> TRUE }T
|
||
|
|
|
||
|
|
\ -----------------------------------------------------------------------------
|
||
|
|
\vf TESTING PARSE
|
||
|
|
|
||
|
|
\vf T{ CHAR | PARSE 1234| DUP ROT ROT EVALUATE -> 4 1234 }T
|
||
|
|
\vf T{ CHAR ^ PARSE 23 45 ^ DUP ROT ROT EVALUATE -> 7 23 45 }T
|
||
|
|
\vf : PA1 [CHAR] $ PARSE DUP >R PAD SWAP CHARS MOVE PAD R> ;
|
||
|
|
\vf T{ PA1 3456
|
||
|
|
\vf DUP ROT ROT EVALUATE -> 4 3456 }T
|
||
|
|
\vf T{ CHAR A PARSE A SWAP DROP -> 0 }T
|
||
|
|
\vf T{ CHAR Z PARSE
|
||
|
|
\vf SWAP DROP -> 0 }T
|
||
|
|
\vf T{ CHAR " PARSE 4567 "DUP ROT ROT EVALUATE -> 5 4567 }T
|
||
|
|
|
||
|
|
\ -----------------------------------------------------------------------------
|
||
|
|
\vf TESTING PARSE-NAME (Forth 2012)
|
||
|
|
\ Adapted from the PARSE-NAME RfD tests
|
||
|
|
\vf T{ PARSE-NAME abcd STR1 S= -> TRUE }T \ No leading spaces
|
||
|
|
\vf T{ PARSE-NAME abcde STR2 S= -> TRUE }T \ Leading spaces
|
||
|
|
|
||
|
|
\ Test empty parse area, new lines are necessary
|
||
|
|
\vf T{ PARSE-NAME
|
||
|
|
\vf NIP -> 0 }T
|
||
|
|
\ Empty parse area with spaces after PARSE-NAME
|
||
|
|
\vf T{ PARSE-NAME
|
||
|
|
\vf NIP -> 0 }T
|
||
|
|
|
||
|
|
\vf T{ : PARSE-NAME-TEST ( "name1" "name2" -- n )
|
||
|
|
\vf PARSE-NAME PARSE-NAME S= ; -> }T
|
||
|
|
\vf T{ PARSE-NAME-TEST abcd abcd -> TRUE }T
|
||
|
|
\vf T{ PARSE-NAME-TEST abcd abcd -> TRUE }T \ Leading spaces
|
||
|
|
\vf T{ PARSE-NAME-TEST abcde abcdf -> FALSE }T
|
||
|
|
\vf T{ PARSE-NAME-TEST abcdf abcde -> FALSE }T
|
||
|
|
\vf T{ PARSE-NAME-TEST abcde abcde
|
||
|
|
\vf -> TRUE }T \ Parse to end of line
|
||
|
|
\vf T{ PARSE-NAME-TEST abcde abcde
|
||
|
|
\vf -> TRUE }T \ Leading and trailing spaces
|
||
|
|
|
||
|
|
\ -----------------------------------------------------------------------------
|
||
|
|
TESTING DEFER DEFER@ DEFER! IS ACTION-OF (Forth 2012)
|
||
|
|
\ Adapted from the Forth 200X RfD tests
|
||
|
|
|
||
|
|
T{ DEFER DEFER1 -> }T
|
||
|
|
T{ : MY-DEFER DEFER ; -> }T
|
||
|
|
T{ : IS-DEFER1 IS DEFER1 ; -> }T
|
||
|
|
T{ : ACTION-DEFER1 ACTION-OF DEFER1 ; -> }T
|
||
|
|
T{ : DEF! DEFER! ; -> }T
|
||
|
|
T{ : DEF@ DEFER@ ; -> }T
|
||
|
|
|
||
|
|
T{ ' * ' DEFER1 DEFER! -> }T
|
||
|
|
T{ 2 3 DEFER1 -> 6 }T
|
||
|
|
T{ ' DEFER1 DEFER@ -> ' * }T
|
||
|
|
T{ ' DEFER1 DEF@ -> ' * }T
|
||
|
|
T{ ACTION-OF DEFER1 -> ' * }T
|
||
|
|
T{ ACTION-DEFER1 -> ' * }T
|
||
|
|
T{ ' + IS DEFER1 -> }T
|
||
|
|
T{ 1 2 DEFER1 -> 3 }T
|
||
|
|
T{ ' DEFER1 DEFER@ -> ' + }T
|
||
|
|
T{ ' DEFER1 DEF@ -> ' + }T
|
||
|
|
T{ ACTION-OF DEFER1 -> ' + }T
|
||
|
|
T{ ACTION-DEFER1 -> ' + }T
|
||
|
|
T{ ' - IS-DEFER1 -> }T
|
||
|
|
T{ 1 2 DEFER1 -> -1 }T
|
||
|
|
T{ ' DEFER1 DEFER@ -> ' - }T
|
||
|
|
T{ ' DEFER1 DEF@ -> ' - }T
|
||
|
|
T{ ACTION-OF DEFER1 -> ' - }T
|
||
|
|
T{ ACTION-DEFER1 -> ' - }T
|
||
|
|
|
||
|
|
T{ MY-DEFER DEFER2 -> }T
|
||
|
|
T{ ' DUP IS DEFER2 -> }T
|
||
|
|
T{ 1 DEFER2 -> 1 1 }T
|
||
|
|
|
||
|
|
\ -----------------------------------------------------------------------------
|
||
|
|
TESTING HOLDS (Forth 2012)
|
||
|
|
|
||
|
|
: HTEST S" Testing HOLDS" ;
|
||
|
|
: HTEST2 S" works" ;
|
||
|
|
: HTEST3 S" Testing HOLDS works 123" ;
|
||
|
|
T{ 0 0 <# HTEST HOLDS #> HTEST S= -> TRUE }T
|
||
|
|
T{ 123 0 <# #S BL HOLD HTEST2 HOLDS BL HOLD HTEST HOLDS #>
|
||
|
|
HTEST3 S= -> TRUE }T
|
||
|
|
T{ : HLD HOLDS ; -> }T
|
||
|
|
T{ 0 0 <# HTEST HLD #> HTEST S= -> TRUE }T
|
||
|
|
|
||
|
|
\ -----------------------------------------------------------------------------
|
||
|
|
\vf TESTING REFILL SOURCE-ID
|
||
|
|
\ REFILL and SOURCE-ID from the user input device can't be tested from a file,
|
||
|
|
\ can only be tested from a string via EVALUATE
|
||
|
|
|
||
|
|
\vf T{ : RF1 S" REFILL" EVALUATE ; RF1 -> FALSE }T
|
||
|
|
\vf T{ : SID1 S" SOURCE-ID" EVALUATE ; SID1 -> -1 }T
|
||
|
|
|
||
|
|
\ ------------------------------------------------------------------------------
|
||
|
|
\vf TESTING S\" (Forth 2012 compilation mode)
|
||
|
|
\ Extended the Forth 200X RfD tests
|
||
|
|
\ Note this tests the Core Ext definition of S\" which has unedfined
|
||
|
|
\ interpretation semantics. S\" in interpretation mode is tested in the tests on
|
||
|
|
\ the File-Access word set
|
||
|
|
|
||
|
|
\vf T{ : SSQ1 S\" abc" S" abc" S= ; -> }T \ No escapes
|
||
|
|
\vf T{ SSQ1 -> TRUE }T
|
||
|
|
\vf T{ : SSQ2 S\" " ; SSQ2 SWAP DROP -> 0 }T \ Empty string
|
||
|
|
|
||
|
|
\vf T{ : SSQ3 S\" \a\b\e\f\l\m\q\r\t\v\x0F0\x1Fa\xaBx\z\"\\" ; -> }T
|
||
|
|
\vf T{ SSQ3 SWAP DROP -> 20 }T \ String length
|
||
|
|
\vf T{ SSQ3 DROP C@ -> 7 }T \ \a BEL Bell
|
||
|
|
\vf T{ SSQ3 DROP 1 CHARS + C@ -> 8 }T \ \b BS Backspace
|
||
|
|
\vf T{ SSQ3 DROP 2 CHARS + C@ -> 27 }T \ \e ESC Escape
|
||
|
|
\vf T{ SSQ3 DROP 3 CHARS + C@ -> 12 }T \ \f FF Form feed
|
||
|
|
\vf T{ SSQ3 DROP 4 CHARS + C@ -> 10 }T \ \l LF Line feed
|
||
|
|
\vf T{ SSQ3 DROP 5 CHARS + C@ -> 13 }T \ \m CR of CR/LF pair
|
||
|
|
\vf T{ SSQ3 DROP 6 CHARS + C@ -> 10 }T \ LF of CR/LF pair
|
||
|
|
\vf T{ SSQ3 DROP 7 CHARS + C@ -> 34 }T \ \q " Double Quote
|
||
|
|
\vf T{ SSQ3 DROP 8 CHARS + C@ -> 13 }T \ \r CR Carriage Return
|
||
|
|
\vf T{ SSQ3 DROP 9 CHARS + C@ -> 9 }T \ \t TAB Horizontal Tab
|
||
|
|
\vf T{ SSQ3 DROP 10 CHARS + C@ -> 11 }T \ \v VT Vertical Tab
|
||
|
|
\vf T{ SSQ3 DROP 11 CHARS + C@ -> 15 }T \ \x0F Given Char
|
||
|
|
\vf T{ SSQ3 DROP 12 CHARS + C@ -> 48 }T \ 0 0 Digit follow on
|
||
|
|
\vf T{ SSQ3 DROP 13 CHARS + C@ -> 31 }T \ \x1F Given Char
|
||
|
|
\vf T{ SSQ3 DROP 14 CHARS + C@ -> 97 }T \ a a Hex follow on
|
||
|
|
\vf T{ SSQ3 DROP 15 CHARS + C@ -> 171 }T \ \xaB Insensitive Given Char
|
||
|
|
\vf T{ SSQ3 DROP 16 CHARS + C@ -> 120 }T \ x x Non hex follow on
|
||
|
|
\vf T{ SSQ3 DROP 17 CHARS + C@ -> 0 }T \ \z NUL No Character
|
||
|
|
\vf T{ SSQ3 DROP 18 CHARS + C@ -> 34 }T \ \" " Double Quote
|
||
|
|
\vf T{ SSQ3 DROP 19 CHARS + C@ -> 92 }T \ \\ \ Back Slash
|
||
|
|
|
||
|
|
\ The above does not test \n as this is a system dependent value.
|
||
|
|
\ Check it displays a new line
|
||
|
|
\vf CR .( The next test should display:)
|
||
|
|
\vf CR .( One line...)
|
||
|
|
\vf CR .( another line)
|
||
|
|
\vf T{ : SSQ4 S\" \nOne line...\nanotherLine\n" type ; SSQ4 -> }T
|
||
|
|
|
||
|
|
\ Test bare escapable characters appear as themselves
|
||
|
|
\vf T{ : SSQ5 S\" abeflmnqrtvxz" S" abeflmnqrtvxz" S= ; SSQ5 -> TRUE }T
|
||
|
|
|
||
|
|
\vf T{ : SSQ6 S\" a\""2DROP 1111 ; SSQ6 -> 1111 }T \ Parsing behaviour
|
||
|
|
|
||
|
|
\vf T{ : SSQ7 S\" 111 : SSQ8 s\\\" 222\" EVALUATE ; SSQ8 333" EVALUATE ; -> }T
|
||
|
|
\vf T{ SSQ7 -> 111 222 333 }T
|
||
|
|
\vf T{ : SSQ9 S\" 11 : SSQ10 s\\\" \\x32\\x32\" EVALUATE ; SSQ10 33" EVALUATE ; -> }T
|
||
|
|
\vf T{ SSQ9 -> 11 22 33 }T
|
||
|
|
|
||
|
|
\ -----------------------------------------------------------------------------
|
||
|
|
CORE-EXT-ERRORS SET-ERROR-COUNT
|
||
|
|
|
||
|
|
CR .( End of Core Extension word tests) CR
|
||
|
|
|
||
|
|
|