\ ==[ File: FSTest.Scr (28543 bytes) ]==CUT=HERE=========================== \ Forth Strings Test/Validation File GTH 09/11/87 ( Multi-Forth Strings Test/Validation File ) ( Minimal adaptation ) ( by ) ( Marcus D. Gabriel ) ( January 1988 ) \ This file tests the "FSTRINGS.SCR" Forth string primitives. \ \ The Forth file "FSTRINGS.SCR" which contains the source \ code for the string primitives themselves must be loaded first \ prior to loading this file. \ After loading, the tests proceed automatically, with \ appropriate status messages (pass/fail) given to the user. \ If an error/fail message is given, it is recommended that \ the test sequence be aborted by the user (the choice is given), \ since the word that fails may be used later in the test sequence \ with catastrophic results or the tests may be incorrect. \ \ The primitives $KEY and $$KEY are not tested since this \ would require interactive input from the user. \ FORTH DECIMAL 3000 MINIMUM.OBJECT 1500 MINIMUM.VOCAB ANEW FSTEST \ FIND - 1983 Standard MDG Jan 1988 UNIQUE.MSG OFF : FIND ( addr1 -- token n ) \ 1983 Standard \ Locate the counted string at addr1 using the current search \ order. If not found, token equals addr1 and n equals zero. \ If found, token is executable, and n equals one for an \ immediate word while n equals minus one for a non-immediate \ word. >R -1 SEARCH.ORDER @EXECUTE \ ds=-1\search.order, rs=...\addr1 BL R@ COUNT + C! \ terminate string with a blank LOWER.CASE @ NOT IF R@ COUNT UPPER THEN \ ? convert to uppercase BEGIN DUP -1 > WHILE \ not end of search order, R@ SWAP (FIND) \ search vocab. IF \ token found R>DROP >R >R \ ds=-1\search.order', rs=...\flag\token BEGIN -1 = UNTIL \ clear stack of vocab handles R> R> IF 1 ( immediate ) ELSE -1 ( non-immediate ) THEN EXIT \ ds=token\n, rs=... THEN REPEAT DROP R> 0 ; \ not in search order UNIQUE.MSG ON \ Test Setup - Global Data GTH 09/11/87 PAGE CR ." **** BEGIN TEST - WAIT ****" CR VARIABLE START-DEPTH \ initial stack depth variable DEPTH START-DEPTH ! \ save initial stack depth VARIABLE NUM-ERRS \ number of errors encountered 0 NUM-ERRS ! \ initialize to zero \ Allot String Temporary Holding Buffer MDG Jan 1988 1024 TO MAX$ \ maximum literal string size ALLOT.BUFFER NOT IFTRUE CR ." Not enough workspace" CR ABORT IFEND \ Test Setup - Primitives Tested GTH 09/11/87 : 'COMPARE' ." COMPARE" ; : 'SAME?' ." SAME?" ; : 'CFIND' ." CFIND" ; : 'CFIND<' ." CFIND<" ; : '$LIT' ." $LIT" ; : '$,' ." $," ; : ',$' ." ,$" ; : '$ALLOT' ." $ALLOT" ; : '[$LIT]' ." [$LIT]" ; : '$IMPORT' ." $IMPORT" ; : '$EXPORT' ." $EXPORT" ; : '$LEN' ." $LEN" ; : '$.' ." $." ; : '$NULL' ." $NULL" ; : '$$+' ." $$+" ; : '$C!' ." $C!" ; : '$C@' ." $C@" ; : '$$!' ." $$!" ; : '$$@' ." $$@" ; : '$CINS' ." $CINS" ; : '$$INS' ." $$INS" ; : '$|TRIM' ." $|TRIM" ; : '$TRIM|' ." $TRIM|" ; : '$|SPACES' ." $|SPACES" ; : '$SPACES|' ." $SPACES|" ; : '$DEL' ." $DEL" ; : '$$REP' ." $$REP" ; : '$>ROT' ." $>ROT" ; : '$>ROT' ." $>>ROT" ; : '$<' ." $$>" ; : '$$>=' ." $$>=" ; : '$$<>' ." $$<>" ; : '$CFIND' ." $CFIND" ; : '$CFIND<' ." $CFIND<" ; : '$$FIND' ." $$FIND" ; : '$CMEM' ." $CMEM" ; : '$$VER' ." $$VER" ; : '$>UPPER' ." $>UPPER" ; : '$>LOWER' ." $>LOWER" ; : '$N' ." $>N" ; \ Test Setup - Test Types GTH 09/11/87 : .LT. ." less than" ; : .GT. ." greater than" ; : .EQ. ." equal to" ; : LENGTH ." length of string" ; : CONTENTS ." contents of string" ; UNIQUE.MSG OFF : STATUS ." status" ; UNIQUE.MSG ON : VALUE ." value" ; : .TRUE. ." true" ; : .FALSE. ." false" ; : ICFIND ." initial character find" ; : TCFIND ." terminal character find" ; : ICHAR ." initial character" ; : TCHAR ." terminal character" ; : NOCFIND ." character not found" ; : STRREF ." string reference" ; : EMBDEL ." embedded delimiter" ; : SZAL ." size allocation" ; : NLINT ." null initialization" ; : STACK? ." depth of string" ; \ Test Setup - Test Types GTH 09/11/87 \ Type modifiers: : 1ST ." first " ; : 2ND ." second " ; : 3RD ." third " ; : 4TH ." fourth " ; : 5TH ." fifth " ; : 6TH ." sixth " ; : 1ST.GT 1ST .GT. ; : 2ND.GT 2ND .GT. ; : 3RD.GT 3RD .GT. ; : 4TH.GT 4TH .GT. ; : 5TH.GT 5TH .GT. ; : 1ST.LT 1ST .LT. ; : 2ND.LT 2ND .LT. ; : 3RD.LT 3RD .LT. ; : 4TH.LT 4TH .LT. ; : 5TH.LT 5TH .LT. ; : 1ST.STATUS 1ST STATUS ; : 2ND.STATUS 2ND STATUS ; : 3RD.STATUS 3RD STATUS ; : 4TH.STATUS 4TH STATUS ; : 5TH.STATUS 5TH STATUS ; : 6TH.STATUS 6TH STATUS ; : 1ST.VALUE 1ST VALUE ; : 2ND.VALUE 2ND VALUE ; : 3RD.VALUE 3RD VALUE ; : 4TH.VALUE 4TH VALUE ; : 1ST.LENGTH 1ST LENGTH ; : 2ND.LENGTH 2ND LENGTH ; : 3RD.LENGTH 3RD LENGTH ; : 1ST.CONTENTS 1ST CONTENTS ; : 2ND.CONTENTS 2ND CONTENTS ; : 3RD.CONTENTS 3RD CONTENTS ; : 1ST.TRUE 1ST .TRUE. ; : 2ND.TRUE 2ND .TRUE. ; : 3RD.TRUE 3RD .TRUE. ; : 1ST.FALSE 1ST .FALSE. ; : 2ND.FALSE 2ND .FALSE. ; \ Test Setup GTH 09/11/87 : ERRS++ ( -- ) \ increments error count 1 NUM-ERRS +! ; : .ERRS ( -- ) \ informs user of number of errors encountered CR ." ----- " NUM-ERRS @ DUP IF . ." ERROR(S)" ELSE DROP ." NO ERRORS" THEN ." ENCOUNTERED DURING TESTING -----" ; : T-WAIT ( -- ) \ issues wait message ." ----- WAIT -----" ; : T-ABORT ( -- ) \ aborts the test CR ." ***** TESTING TERMINATED AS REQUESTED *****" CR ABORT ; : ->EXECUTE ( -- ) \ executes following word in input stream 32 WORD FIND IF EXECUTE ELSE COUNT CR ." **** XQT " TYPE ." ? ****" ABORT THEN ; : .SP ( -- ) \ prints string primitive message ." string primitive " ->EXECUTE ; : TESTING ( -- ) \ prints testing/wait message CR CR ." ---- Testing " .SP T-WAIT ; : P/F? ( n1 n2 -- ) \ passes if n1=n2, else fails = DUP IF ." passes " ELSE ." fails " THEN 32 WORD DROP ->EXECUTE ." test." NOT IF ERRS++ CR .ERRS T-ABORT THEN ; : CHECK ( -- ) \ performs general testing CR ." -" .SP P/F? ; : HAS ( -- ) \ passes if depth unchanged CR ." -" .SP DEPTH START-DEPTH @ P/F? ; CREATE LSWORD 3 C, 36 C, 62 C, 78 C, \ counted string "$>N" LSWORD FIND SWAP DROP 0< NOT IFTRUE CR ." **** FSTRINGS DOES NOT APPEAR TO BE LOADED ****" ABORT IFEND \ Test COMPARE ( a1 a2 n -- status ) GTH 09/11/87 TESTING 'COMPARE' CREATE A1 65 C, 66 C, 67 C, 68 C, \ memory starting addresses CREATE A2 97 C, 98 C, 99 C, 100 C, \ to be "compared" A1 A2 4 COMPARE \ should give ( -- -1 ) -1 CHECK 'COMPARE' REGARDING .LT. A2 A1 4 COMPARE \ should give ( -- +1 ) 1 CHECK 'COMPARE' REGARDING .GT. A1 A1 4 COMPARE \ should give ( -- 0 ) 0 CHECK 'COMPARE' REGARDING .EQ. HAS 'COMPARE' ALTERED STACK? \ Test SAME? ( a1 a2 n -- t | f ) GTH 09/11/87 TESTING 'SAME?' A1 A2 4 SAME? \ should give ( -- FALSE ) FALSE CHECK 'SAME?' REGARDING .LT. A2 A1 4 SAME? \ should give ( -- FALSE ) FALSE CHECK 'SAME?' REGARDING .GT. A2 A2 4 SAME? \ should give ( -- TRUE ) TRUE CHECK 'SAME?' REGARDING .EQ. HAS 'SAME?' ALTERED STACK? \ Test CFIND ( c a1 n -- a2 | 0 ) GTH 09/11/87 TESTING 'CFIND' 65 A1 4 CFIND \ should give ( -- 'a1 ) A1 CHECK 'CFIND' REGARDING ICFIND 68 A1 4 CFIND \ should give ( -- 'a1+3 ) A1 3 + CHECK 'CFIND' REGARDING TCFIND 68 A1 3 CFIND \ should give ( -- 0 ) 0 CHECK 'CFIND' REGARDING NOCFIND HAS 'CFIND' ALTERED STACK? \ Test CFIND< ( c a1 n -- a2 | 0 ) GTH 09/11/87 TESTING 'CFIND<' 68 A1 4 CFIND< \ should give ( -- 'a1+3 ) A1 3 + CHECK 'CFIND<' REGARDING ICFIND 65 A1 4 CFIND< \ should give ( -- 'a1 ) A1 CHECK 'CFIND<' REGARDING TCFIND 65 A1 1+ 3 CFIND< \ should give ( -- 0 ) 0 CHECK 'CFIND<' REGARDING NOCFIND HAS 'CFIND<' ALTERED STACK? \ Test $LIT ( -- string ) GTH 09/11/87 TESTING '$LIT' $LIT 'HELLO THERE FOLKS' \ should give ( -- '_BUFFER ) _BUFFER CHECK '$LIT' REGARDING STRREF $LIT +The plus character is: +++ \ should give ( -- '_BUFFER ) _BUFFER CHECK '$LIT' REGARDING EMBDEL $LIT 'THIS STRING HAS EXACTLY 37 CHARACTERS' @ \ should give ( -- 37 ) -of course!- 37 CHECK '$LIT' REGARDING LENGTH A1 $LIT 'ABCD' _CF+ 4 SAME? \ should give ( -- TRUE ) TRUE CHECK '$LIT' REGARDING CONTENTS HAS '$LIT' ALTERED STACK? \ Test $, ( string -- ) GTH 09/11/87 TESTING '$,' $LIT "ABCDEFGHIJKLMNOPQRSTUVWXYZ" CREATE S1 $, S1 @ \ should give ( -- 26 ) 26 CHECK '$,' REGARDING LENGTH $LIT "ABCDEFGHIJKLMNOPQRSTUVWXYZ" _CF+ S1 _CF+ 26 SAME? \ should give ( -- TRUE ) TRUE CHECK '$,' REGARDING CONTENTS HAS '$,' ALTERED STACK? \ Test ,$ ( -- ) GTH 09/11/87 TESTING ',$' CREATE S2 ,$ "abcdefghijklmnopqrstuvwxyz" S2 @ \ should give ( -- 26 ) 26 CHECK ',$' REGARDING LENGTH $LIT "abcdefghijklmnopqrstuvwxyz" _CF+ S2 _CF+ 26 SAME? \ should give ( -- TRUE ) TRUE CHECK ',$' REGARDING CONTENTS HAS ',$' ALTERED STACK? \ Test $ALLOT ( number -- ) GTH 09/11/87 TESTING '$ALLOT' CREATE S3 50 $ALLOT S3 _CF+ 50 + HERE \ addresses should be equal CHECK '$ALLOT' REGARDING SZAL S3 @ \ should give ( -- 0 ) 0 CHECK '$ALLOT' REGARDING NLINT HAS '$ALLOT' ALTERED STACK? \ Test [$LIT] ( -- string ) GTH 09/11/87 TESTING '[$LIT]' : COMP$ [$LIT] 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' ; COMP$ @ \ should give ( -- 26 ) 26 CHECK '[$LIT]' REGARDING LENGTH S1 _CF+ COMP$ _CF+ 26 SAME? \ should give ( -- TRUE ) TRUE CHECK '[$LIT]' REGARDING CONTENTS HAS '[$LIT]' ALTERED STACK? \ Test $IMPORT ( addr length string -- ) GTH 09/11/87 TESTING '$IMPORT' A1 4 S3 $IMPORT \ should leave "ABCD" in S3 S3 @ \ should give ( -- 4 ) 4 CHECK '$IMPORT' REGARDING LENGTH A1 S3 _CF+ 4 SAME? \ should give ( -- TRUE ) TRUE CHECK '$IMPORT' REGARDING CONTENTS HAS '$IMPORT' ALTERED STACK? \ Test $EXPORT ( string addr -- ) GTH 09/11/87 TESTING '$EXPORT' CREATE A3 4 ALLOT S3 A3 $EXPORT \ should leave "ABCD" in A3 A3 S3 _CF+ 4 SAME? \ should give ( -- TRUE ) TRUE CHECK '$EXPORT' REGARDING CONTENTS HAS '$EXPORT' ALTERED STACK? \ Test $LEN ( string -- length ) GTH 09/11/87 TESTING '$LEN' S3 $LEN \ should give ( -- 4 ) 4 CHECK '$LEN' REGARDING LENGTH HAS '$LEN' ALTERED STACK? \ Test $. ( string -- ) TESTING '$.' CR S1 $. \ should simply type string leaving DEPTH unchanged HAS '$.' ALTERED STACK? \ Test $NULL ( string -- ) TESTING '$NULL' S3 $NULL \ should give S3 0 length S3 $LEN 0 CHECK '$NULL' REGARDING LENGTH HAS '$NULL' ALTERED STACK? \ Test $$+ ( string1 string2 -- ) GTH 09/11/87 TESTING '$$+' S3 $NULL $LIT "13 CHARACTERS" S3 $$+ S3 $LEN 13 CHECK '$$+' REGARDING 1ST.LENGTH $LIT "13 CHARACTERS" _CF+ S3 _CF+ 13 SAME? \ should give ( -- TRUE ) TRUE CHECK '$$+' REGARDING CONTENTS S3 S3 $$+ \ should give S3 length of 26 S3 $LEN 26 CHECK '$$+' REGARDING 2ND.LENGTH HAS '$$+' ALTERED STACK? \ Test $C! ( char string index -- ) GTH 09/11/87 TESTING '$C!' S3 $NULL $LIT "EFGH" S3 $$+ 65 S3 0 $C! \ S3 should be "AFGH" $LIT "AFGH" _CF+ S3 _CF+ 4 SAME? \ should give ( -- TRUE ) TRUE CHECK '$C!' REGARDING 1ST.CONTENTS 90 S3 DUP $LEN 1- $C! \ S3 should be "AFGZ" $LIT "AFGZ" _CF+ S3 _CF+ 4 SAME? \ should give ( -- TRUE ) TRUE CHECK '$C!' REGARDING 2ND.CONTENTS S3 $LEN \ should give ( -- 4 ) 4 CHECK '$C!' REGARDING LENGTH HAS '$C!' ALTERED STACK? \ Test $C@ ( string index -- char ) GTH 09/11/87 TESTING '$C@' S3 $NULL $LIT "AFGZ" S3 $$+ S3 0 $C@ \ should give ( -- 65 ) 65 CHECK '$C@' REGARDING ICHAR S3 DUP $LEN 1- $C@ \ should give ( -- 90 ) 90 CHECK '$C@' REGARDING TCHAR HAS '$C@' ALTERED STACK? \ Test $$! ( string1 string2 -- ) GTH 09/11/87 TESTING '$$!' S1 S3 $$! \ S3 should be identical to S1 S1 $LEN S3 $LEN CHECK '$$!' REGARDING LENGTH S1 _CF+ S3 _CF+ S1 $LEN SAME? \ should give ( -- TRUE ) TRUE CHECK '$$!' REGARDING CONTENTS HAS '$$!' ALTERED STACK? \ Test $$@ ( string1 string2 index length --) GTH 09/11/87 TESTING '$$@' S1 S3 0 S1 $LEN $$@ \ S3 should be identical to S1 S1 $LEN S3 $LEN CHECK '$$@' REGARDING 1ST.LENGTH S1 _CF+ S3 _CF+ S1 $LEN SAME? \ should give ( -- TRUE ) TRUE CHECK '$$@' REGARDING 1ST.CONTENTS S1 S3 0 4 $$@ \ S3 should be "ABCD" S3 $LEN 4 CHECK '$$@' REGARDING 2ND.LENGTH S1 _CF+ S3 _CF+ 4 SAME? \ should give ( -- TRUE ) TRUE CHECK '$$@' REGARDING 2ND.CONTENTS S1 S3 22 4 $$@ \ S3 should be "WXYZ" S3 $LEN 4 CHECK '$$@' REGARDING 3RD.LENGTH S1 _CF+ 22 + S3 _CF+ 4 SAME? \ should give ( -- TRUE ) TRUE CHECK '$$@' REGARDING 3RD.CONTENTS HAS '$$@' ALTERED STACK? \ Test $CINS ( char string index -- ) GTH 09/11/87 TESTING '$CINS' $LIT "WXYZ" S3 $$! 90 S3 0 $CINS \ S3 should be "ZWXYZ" S3 $LEN 5 CHECK '$CINS' REGARDING 1ST.LENGTH $LIT "ZWXYZ" _CF+ S3 _CF+ 5 SAME? \ should give ( -- TRUE ) TRUE CHECK '$CINS' REGARDING 1ST.CONTENTS 65 S3 DUP $LEN $CINS \ S3 should be "ZWXYZA" S3 $LEN 6 CHECK '$CINS' REGARDING 2ND.LENGTH $LIT "ZWXYZA" _CF+ S3 _CF+ 6 SAME? \ should give ( -- TRUE ) TRUE CHECK '$CINS' REGARDING 2ND.CONTENTS HAS '$CINS' ALTERED STACK? \ Test $$INS ( string1 string2 index -- ) GTH 09/11/87 TESTING '$$INS' $LIT "****" S3 $$! $LIT "ABCD" S3 0 $$INS \ S3 should be "ABCD****" S3 $LEN 8 CHECK '$$INS' REGARDING 1ST.LENGTH $LIT "ABCD****" _CF+ S3 _CF+ 8 SAME? \ should give ( -- TRUE ) TRUE CHECK '$$INS' REGARDING 1ST.CONTENTS $LIT "WXYZ" S3 DUP $LEN $$INS \ S3 should be "ABCD****WXYZ" S3 $LEN 12 CHECK '$$INS' REGARDING 2ND.LENGTH $LIT "ABCD****WXYZ" _CF+ S3 _CF+ 12 SAME? \ shd give ( -- TRUE) TRUE CHECK '$$INS' REGARDING 2ND.CONTENTS HAS '$$INS' ALTERED STACK? \ Test $|TRIM ( string number -- ) GTH 09/11/87 TESTING '$|TRIM' $LIT "1234567890" S3 $$! S3 3 $|TRIM \ S3 should be "4567890" S3 $LEN 7 CHECK '$|TRIM' REGARDING 1ST.LENGTH $LIT "4567890" _CF+ S3 _CF+ 7 SAME? \ should give ( -- TRUE ) TRUE CHECK '$|TRIM' REGARDING CONTENTS S3 7 $|TRIM \ S3 should be NULL S3 $LEN 0 CHECK '$|TRIM' REGARDING 2ND.LENGTH HAS '$|TRIM' ALTERED STACK? \ Test $TRIM| ( string number -- ) GTH 09/11/87 TESTING '$TRIM|' $LIT "1234567890" S3 $$! S3 3 $TRIM| \ S3 should be "1234567" S3 $LEN 7 CHECK '$TRIM|' REGARDING 1ST.LENGTH $LIT "1234567" _CF+ S3 _CF+ 7 SAME? \ should give ( -- TRUE ) TRUE CHECK '$TRIM|' REGARDING CONTENTS S3 7 $TRIM| \ S3 should be NULL S3 $LEN 0 CHECK '$TRIM|' REGARDING 2ND.LENGTH HAS '$TRIM|' ALTERED STACK? \ Test $|SPACES ( string -- ) GTH 09/11/87 TESTING '$|SPACES' $LIT " 1 2 " S3 $$! S3 $|SPACES \ S3 should be "1 2 " S3 $LEN 7 CHECK '$|SPACES' REGARDING 1ST.LENGTH $LIT "1 2 " _CF+ S3 _CF+ 7 SAME? \ should give ( -- TRUE ) TRUE CHECK '$|SPACES' REGARDING 1ST.CONTENTS S3 $|SPACES \ S3 should be "1 2 " S3 $LEN 7 CHECK '$|SPACES' REGARDING 2ND.LENGTH $LIT "1 2 " _CF+ S3 _CF+ 7 SAME? \ should give ( -- TRUE ) TRUE CHECK '$|SPACES' REGARDING 2ND.CONTENTS HAS '$|SPACES' ALTERED STACK? \ Test $SPACES| ( string -- ) GTH 09/11/87 TESTING '$SPACES|' $LIT " 1 2 " S3 $$! S3 $SPACES| \ S3 should be " 1 2" S3 $LEN 7 CHECK '$SPACES|' REGARDING 1ST.LENGTH $LIT " 1 2" _CF+ S3 _CF+ 7 SAME? \ should give ( -- TRUE ) TRUE CHECK '$SPACES|' REGARDING 1ST.CONTENTS S3 $SPACES| \ S3 should be " 1 2" S3 $LEN 7 CHECK '$SPACES|' REGARDING 2ND.LENGTH $LIT " 1 2" _CF+ S3 _CF+ 7 SAME? \ should give ( -- TRUE ) TRUE CHECK '$SPACES|' REGARDING 2ND.CONTENTS HAS '$SPACES|' ALTERED STACK? \ Test $DEL ( string index number -- ) GTH 09/11/87 TESTING '$DEL' $LIT "1234567890" S3 $$! S3 0 3 $DEL \ S3 should be "4567890" S3 $LEN 7 CHECK '$DEL' REGARDING 1ST.LENGTH $LIT "4567890" _CF+ S3 _CF+ 7 SAME? \ should give ( -- TRUE ) TRUE CHECK '$DEL' REGARDING 1ST.CONTENTS S3 DUP $LEN 3 - 3 $DEL \ S3 should be "4567" S3 $LEN 4 CHECK '$DEL' REGARDING 2ND.LENGTH $LIT "4567" _CF+ S3 _CF+ 4 SAME? \ should give ( -- TRUE ) TRUE CHECK '$DEL' REGARDING 2ND.CONTENTS S3 0 OVER $LEN $DEL \ S3 should be NULL S3 $LEN 0 CHECK '$DEL' REGARDING 3RD.LENGTH HAS '$DEL' ALTERED STACK? \ Test $$REP ( string1 string2 index -- ) GTH 09/11/87 TESTING '$$REP' CREATE S4 ,$ "123" $LIT "ABCDEFGHI" S3 $$! S4 S3 0 $$REP \ S3 should be "123DEFGHI" S3 $LEN 9 CHECK '$$REP' REGARDING 1ST.LENGTH $LIT "123DEFGHI" _CF+ S3 _CF+ 9 SAME? \ should give ( -- TRUE ) TRUE CHECK '$$REP' REGARDING 1ST.CONTENTS S4 S3 DUP $LEN 3 - $$REP \ S3 should be "123DEF123" S3 $LEN 9 CHECK '$$REP' REGARDING 2ND.LENGTH $LIT "123DEF123" _CF+ S3 _CF+ 9 SAME? \ should give ( -- TRUE ) TRUE CHECK '$$REP' REGARDING 2ND.CONTENTS S4 S3 3 $$REP \ S3 should be "123123123" S3 $LEN 9 CHECK '$$REP' REGARDING 3RD.LENGTH $LIT "123123123" _CF+ S3 _CF+ 9 SAME? \ should give ( -- TRUE ) TRUE CHECK '$$REP' REGARDING 3RD.CONTENTS HAS '$$REP' ALTERED STACK? \ Test $ROT ( string -- ) GTH 09/11/87 TESTING '$>ROT' $LIT "123456789" S3 $$! S3 $>ROT \ S3 should be "912345678" $LIT "912345678" _CF+ S3 _CF+ 9 SAME? \ should give ( -- TRUE ) TRUE CHECK '$>ROT' REGARDING 1ST.CONTENTS : >> 0 DO DUP $>ROT LOOP ; S3 8 >> DROP \ S3 should be "123456789" $LIT "123456789" _CF+ S3 _CF+ 9 SAME? \ should give ( -- TRUE ) TRUE CHECK '$>ROT' REGARDING 2ND.CONTENTS S3 $LEN 9 CHECK '$>ROT' REGARDING LENGTH HAS '$>ROT' ALTERED STACK? \ Test $<>ROT ( string number -- ) GTH 09/11/87 TESTING '$>>ROT' $LIT "123456789" S3 $$! S3 1 $>>ROT \ S3 should be "912345678" $LIT "912345678" _CF+ S3 _CF+ 9 SAME? \ should give ( -- TRUE ) TRUE CHECK '$>>ROT' REGARDING 1ST.CONTENTS S3 8 $>>ROT \ S3 should be "123456789" $LIT "123456789" _CF+ S3 _CF+ 9 SAME? \ should give ( -- TRUE ) TRUE CHECK '$>>ROT' REGARDING 2ND.CONTENTS S3 84 $>>ROT \ S3 should be "456789123" $LIT "789123456" _CF+ S3 _CF+ 9 SAME? \ should give ( -- TRUE ) TRUE CHECK '$>>ROT' REGARDING 3RD.CONTENTS S3 $LEN 9 CHECK '$>>ROT' REGARDING LENGTH HAS '$>>ROT' ALTERED STACK? \ Test $$COMPARE ( string1 string2 -- status ) GTH 09/11/87 TESTING '$$COMPARE' \ NOTE: S1 is "ABCDEFGHIJKLMNOPQRSTUVWXYZ" \ and S2 is "abcdefghijklmnopqrstuvwxyz" S1 S2 $$COMPARE \ should give ( -- -1 ) -1 CHECK '$$COMPARE' REGARDING 1ST.LT S2 S1 $$COMPARE \ should give ( -- +1 ) 1 CHECK '$$COMPARE' REGARDING 1ST.GT $LIT "ZBCDEFGHIJKLMNOPQRSTUVWXYZ" S3 $$! S1 S3 $$COMPARE \ should give ( -- -1 ) -1 CHECK '$$COMPARE' REGARDING 2ND.LT S3 S1 $$COMPARE \ should give ( -- +1 ) 1 CHECK '$$COMPARE' REGARDING 2ND.GT \ Test $$COMPARE ( string1 string2 -- status ) GTH 09/11/87 $LIT "ABCDEFGHIJKLMNOPQRSTUVWXYA" S3 $$! S3 S1 $$COMPARE \ should give ( -- -1 ) -1 CHECK '$$COMPARE' REGARDING 3RD.LT S1 S3 $$COMPARE \ should give ( -- +1 ) 1 CHECK '$$COMPARE' REGARDING 3RD.GT $LIT "ABCDEFGHIJKLMNOPQRSTUVWXY" S3 $$! S3 S1 $$COMPARE \ should give ( -- -1 ) -1 CHECK '$$COMPARE' REGARDING 4TH.LT S1 S3 $$COMPARE \ should give ( -- +1 ) 1 CHECK '$$COMPARE' REGARDING 4TH.GT \ Test $$COMPARE ( string1 string2 -- status ) GTH 09/11/87 $LIT "BCDEFGHIJKLMNOPQRSTUVWXYZ" S3 $$! S1 S3 $$COMPARE \ should give ( -- -1 ) -1 CHECK '$$COMPARE' REGARDING 5TH.LT S3 S1 $$COMPARE \ should give ( -- +1 ) 1 CHECK '$$COMPARE' REGARDING 5TH.GT S1 S1 $$COMPARE \ should give ( -- 0 ) 0 CHECK '$$COMPARE' REGARDING .EQ. HAS '$$COMPARE' ALTERED STACK? \ Test $$= ( string1 string2 -- t | f ) GTH 09/11/87 TESTING '$$=' S1 S2 $$= \ should give ( -- FALSE ) FALSE CHECK '$$=' REGARDING 1ST.FALSE S2 S1 $$= \ should give ( -- FALSE ) FALSE CHECK '$$=' REGARDING 2ND.FALSE S1 S1 $$= \ should give ( -- TRUE ) TRUE CHECK '$$=' REGARDING .TRUE. HAS '$$=' ALTERED STACK? \ Test $$<> ( string1 string2 -- t | f ) GTH 09/11/87 TESTING '$$<>' S1 S2 $$<> \ should give ( -- TRUE ) TRUE CHECK '$$<>' REGARDING 1ST.TRUE S2 S1 $$<> \ should give ( -- TRUE ) TRUE CHECK '$$<>' REGARDING 2ND.TRUE S1 S1 $$<> \ should give ( -- FALSE ) FALSE CHECK '$$<>' REGARDING .FALSE. HAS '$$<>' ALTERED STACK? \ Test $$< ( string1 string2 -- t | f ) GTH 09/11/87 TESTING '$$<' S1 S2 $$< \ should give ( -- TRUE ) TRUE CHECK '$$<' REGARDING .TRUE. S2 S1 $$< \ should give ( -- FALSE ) FALSE CHECK '$$<' REGARDING 1ST.FALSE S1 S1 $$< \ should give ( -- FALSE ) FALSE CHECK '$$<' REGARDING 2ND.FALSE HAS '$$<' ALTERED STACK? \ Test $$> ( string1 string2 -- t | f ) GTH 09/11/87 TESTING '$$>' S1 S2 $$> \ should give ( -- FALSE ) FALSE CHECK '$$>' REGARDING 1ST.FALSE S2 S1 $$> \ should give ( -- TRUE ) TRUE CHECK '$$>' REGARDING .TRUE. S1 S1 $$> \ should give ( -- FALSE ) FALSE CHECK '$$>' REGARDING 2ND.FALSE HAS '$$>' ALTERED STACK? \ Test $$<= ( string1 string2 -- t | f ) GTH 09/11/87 TESTING '$$<=' S1 S2 $$<= \ should give ( -- TRUE ) TRUE CHECK '$$<=' REGARDING 1ST.TRUE S2 S1 $$<= \ should give ( -- FALSE ) FALSE CHECK '$$<=' REGARDING .FALSE. S1 S1 $$<= \ should give ( -- TRUE ) TRUE CHECK '$$<=' REGARDING 2ND.TRUE HAS '$$<=' ALTERED STACK? \ Test $$>= ( string1 string2 -- t | f) GTH 09/11/87 TESTING '$$>=' S1 S2 $$>= \ should give ( -- FALSE ) FALSE CHECK '$$>=' REGARDING .FALSE. S2 S1 $$>= \ should give ( -- TRUE ) TRUE CHECK '$$>=' REGARDING 1ST.TRUE S1 S1 $$>= \ should give ( -- TRUE ) TRUE CHECK '$$>=' REGARDING 2ND.TRUE HAS '$$>=' ALTERED STACK? \ Test $CFIND ( char string -- index | -1 ) GTH 09/11/87 TESTING '$CFIND' 65 S1 $CFIND \ should give ( -- 0 ) 0 CHECK '$CFIND' REGARDING 1ST.STATUS 90 S1 $CFIND \ should give ( -- 25 ) 25 CHECK '$CFIND' REGARDING 2ND.STATUS 64 S1 $CFIND \ should give ( -- -1 ) -1 CHECK '$CFIND' REGARDING 3RD.STATUS 91 S1 $CFIND \ should give ( -- -1 ) -1 CHECK '$CFIND' REGARDING 4TH.STATUS 77 S1 $CFIND \ should give ( -- 12 ) 12 CHECK '$CFIND' REGARDING 5TH.STATUS S3 $NULL 77 S3 $CFIND \ should give ( -- -1 ) -1 CHECK '$CFIND' REGARDING 6TH.STATUS HAS '$CFIND' ALTERED STACK? \ Test $CFIND< ( char string -- index | -1 ) GTH 09/11/87 TESTING '$CFIND<' 65 S1 $CFIND< \ should give ( -- 0 ) 0 CHECK '$CFIND<' REGARDING 1ST.STATUS 90 S1 $CFIND< \ should give ( -- 25 ) 25 CHECK '$CFIND<' REGARDING 2ND.STATUS 64 S1 $CFIND< \ should give ( -- -1 ) -1 CHECK '$CFIND<' REGARDING 3RD.STATUS 91 S1 $CFIND< \ should give ( -- -1 ) -1 CHECK '$CFIND<' REGARDING 4TH.STATUS 77 S1 $CFIND< \ should give ( -- 12 ) 12 CHECK '$CFIND<' REGARDING 5TH.STATUS S3 $NULL 77 S3 $CFIND< \ should give ( -- -1 ) -1 CHECK '$CFIND<' REGARDING 6TH.STATUS HAS '$CFIND<' ALTERED STACK? \ Test $$FIND GTH 09/11/87 \ ( string1 string2 index length -- index | -1 ) TESTING '$$FIND' \ NOTE: S1 is "ABCDEFGHIJKLMNOPQRSTUVWXYZ" \ and S2 is "abcdefghijklmnopqrstuvwxyz" $LIT "ABCDEFGH" S1 0 8 $$FIND \ should give ( -- 0 ) 0 CHECK '$$FIND' REGARDING 1ST.STATUS $LIT "STUVWXYZ" S1 0 8 $$FIND \ should give ( -- 18 ) 18 CHECK '$$FIND' REGARDING 2ND.STATUS $LIT "JKLMNOPQ" S1 0 8 $$FIND \ should give ( -- 9 ) 9 CHECK '$$FIND' REGARDING 3RD.STATUS \ Test $$FIND GTH 09/11/87 \ ( string1 string2 index length -- index | -1 ) $LIT "ABCXYZ12" S1 0 3 $$FIND \ should give ( -- 0 ) 0 CHECK '$$FIND' REGARDING 4TH.STATUS $LIT "ABCXYZ12" S1 3 3 $$FIND \ should give ( -- 23 ) 23 CHECK '$$FIND' REGARDING 5TH.STATUS $LIT "ABCXYZ12" S1 6 2 $$FIND \ should give ( -- -1 ) -1 CHECK '$$FIND' REGARDING 6TH.STATUS HAS '$$FIND' ALTERED STACK? \ Test $CMEM ( char string -- t | f ) GTH 09/11/87 TESTING '$CMEM' \ NOTE: S1 is "ABCDEFGHIJKLMNOPQRSTUVWXYZ" 65 S1 $CMEM \ should give ( -- TRUE ) TRUE CHECK '$CMEM' REGARDING 1ST.TRUE 77 S1 $CMEM \ should give ( -- TRUE ) TRUE CHECK '$CMEM' REGARDING 2ND.TRUE 90 S1 $CMEM \ should give ( -- TRUE ) TRUE CHECK '$CMEM' REGARDING 3RD.TRUE 64 S1 $CMEM \ should give ( -- FALSE ) FALSE CHECK '$CMEM' REGARDING 1ST.FALSE 91 S1 $CMEM \ should give ( -- FALSE ) FALSE CHECK '$CMEM' REGARDING 2ND.FALSE HAS '$CMEM' ALTERED STACK? \ Test $$VER ( string1 string2 -- index | -1 ) GTH 09/11/87 TESTING '$$VER' \ NOTE: S1 is "ABCDEFGHIJKLMNOPQRSTUVWXYZ" $LIT "A" S1 $$VER \ should give ( -- 1 ) 1 CHECK '$$VER' REGARDING 1ST.STATUS $LIT "ABCDEFGHIJKLMNOPQRSTUVWXY" S1 $$VER \ shd give ( -- 25 ) 25 CHECK '$$VER' REGARDING 2ND.STATUS S1 $LIT "AZ@[" $$VER \ should give ( -- 2 ) 2 CHECK '$$VER' REGARDING 3RD.STATUS $LIT "@ABCDEFGHIJKLMNOPQRSTUVWXYZ[" S1 $$VER \ ( -- TRUE ) TRUE CHECK '$$VER' REGARDING .TRUE. HAS '$$VER' ALTERED STACK? \ Test $>UPPER ( string -- ) GTH 09/11/87 TESTING '$>UPPER' $LIT "@[`{" S3 $$! \ S3 contains border chars for A..Z & a..z S2 S3 $$+ S3 $>UPPER \ test below should give ( -- TRUE ) $LIT "@[`{ABCDEFGHIJKLMNOPQRSTUVWXYZ" _CF+ S3 _CF+ 30 SAME? TRUE CHECK '$>UPPER' REGARDING CONTENTS S3 $LEN 30 CHECK '$>UPPER' REGARDING LENGTH HAS '$>UPPER' ALTERED STACK? \ Test $>LOWER ( string -- ) GTH 09/11/87 TESTING '$>LOWER' $LIT "@[`{" S3 $$! \ S3 contains border chars for A..Z & a..z S1 S3 $$+ S3 $>LOWER \ test below should give ( -- TRUE ) $LIT "@[`{abcdefghijklmnopqrstuvwxyz" _CF+ S3 _CF+ 30 SAME? TRUE CHECK '$>LOWER' REGARDING CONTENTS S3 $LEN 30 CHECK '$>LOWER' REGARDING LENGTH HAS '$>LOWER' ALTERED STACK? \ Test $N ( -- number | -1 ) GTH 09/11/87 TESTING '$>N' 16 BASE ! $LIT "/0FG" S3 $$! S3 0 $CONVERT $>N \ should give ( -- -1 ) -1 CHECK '$>N' REGARDING 1ST.VALUE $>N \ should give ( -- 0 ) 0 CHECK '$>N' REGARDING 2ND.VALUE $>N \ should give ( -- 0F ) 0F CHECK '$>N' REGARDING 3RD.VALUE $>N \ should give ( -- -1 ) -1 CHECK '$>N' REGARDING 4TH.VALUE 0A BASE ! HAS '$>N' ALTERED STACK? \ Deallot String Temporary Holding Buffer MDG Jan 1988 DEALLOT.BUFFER \ Testing Complete GTH 09/11/87 CR CR ." **** TESTING COMPLETE ****" .ERRS CR