git.gag.com Git - debian/pforth/blob - fth/t_strings.fth

   1 \ @(#) t_strings.fth 97/12/10 1.1
   2 \ Test ANS Forth String Word Set
   3 \
   4 \ Copyright 1994 3DO, Phil Burk
   5
   6 include? }T{  t_tools.fth
   7
   8 marker task-t_string.fth
   9
  10 decimal
  11
  12 test{
  13
  14 echo off
  15
  16 \ ==========================================================
  17 \ test is.ok?
  18 T{ 1 2 3 }T{ 1 2 3 }T
  19
  20 : STR1  S" Hello    " ;
  21 : STR2  S" Hello World" ;
  22 : STR3  S" " ;
  23
  24 \  ----------------------------------------------------- -TRAILING
  25 T{ STR1 -TRAILING }T{ STR1 DROP 5 }T
  26 T{ STR2 -TRAILING }T{ STR2 }T
  27 T{ STR3 -TRAILING }T{ STR3 }T
  28
  29 \  ----------------------------------------------------- /STRING
  30 T{ STR2  6  /STRING  }T{ STR2 DROP 6 CHARS +   STR2 NIP 6 -  }T
  31
  32
  33 \  ----------------------------------------------------- BLANK
  34 : T.COMMA.SEQ  ( n -- , lay down N sequential bytes )
  35     0 ?DO I C, LOOP
  36 ;
  37 CREATE T-BLANK-DATA   64 T.COMMA.SEQ
  38 T{ T-BLANK-DATA 8 + C@ }T{ 8 }T
  39 T-BLANK-DATA 7 + 3 BLANK
  40 T{ T-BLANK-DATA 6 + C@ }T{ 6 }T
  41 T{ T-BLANK-DATA 7 + C@ }T{ BL }T
  42 T{ T-BLANK-DATA 8 + C@ }T{ BL }T
  43 T{ T-BLANK-DATA 9 + C@ }T{ BL }T
  44 T{ T-BLANK-DATA 10 + C@ }T{ 10 }T
  45 FORGET T.COMMA.SEQ
  46
  47 \  ----------------------------------------------------- CMOVE
  48 : T.COMMA.SEQ  ( n -- , lay down N sequential bytes )
  49     0 ?DO I C, LOOP
  50 ;
  51 CREATE T-BLANK-DATA   64 T.COMMA.SEQ
  52 T-BLANK-DATA 7 + T-BLANK-DATA 6 + 3 CMOVE
  53 T{ T-BLANK-DATA 5 + C@ }T{ 5 }T
  54 T{ T-BLANK-DATA 6 + C@ }T{ 7 }T
  55 T{ T-BLANK-DATA 7 + C@ }T{ 8 }T
  56 T{ T-BLANK-DATA 8 + C@ }T{ 9 }T
  57 T{ T-BLANK-DATA 9 + C@ }T{ 9 }T
  58 FORGET T.COMMA.SEQ
  59
  60 \  ----------------------------------------------------- CMOVE>
  61 : T.COMMA.SEQ  ( n -- , lay down N sequential bytes )
  62     0 ?DO I C, LOOP
  63 ;
  64 CREATE T-BLANK-DATA   64 T.COMMA.SEQ
  65 T{ T-BLANK-DATA 6 + T-BLANK-DATA 7 + 3 CMOVE>
  66 T{ T-BLANK-DATA 5 + C@ }T{ 5 }T
  67 T{ T-BLANK-DATA 6 + C@ }T{ 6 }T
  68 T{ T-BLANK-DATA 7 + C@ }T{ 6 }T
  69 T{ T-BLANK-DATA 8 + C@ }T{ 7 }T
  70 T{ T-BLANK-DATA 9 + C@ }T{ 8 }T
  71 T{ T-BLANK-DATA 10 + C@ }T{ 10 }T
  72 FORGET T.COMMA.SEQ
  73
  74 \  ----------------------------------------------------- COMPARE
  75 T{ : T.COMPARE.1 S" abcd" S" abcd"    compare ; t.compare.1 }T{   0 }T
  76 T{ : T.COMPARE.2 S" abcd" S" abcde"   compare ; t.compare.2 }T{  -1 }T
  77 T{ : T.COMPARE.3 S" abcdef" S" abcde" compare ; t.compare.3 }T{   1 }T
  78 T{ : T.COMPARE.4 S" abGd" S" abcde"   compare ; t.compare.4 }T{  -1 }T
  79 T{ : T.COMPARE.5 S" abcd" S" aXcde"   compare ; t.compare.5 }T{   1 }T
  80 T{ : T.COMPARE.6 S" abGd" S" abcd"    compare ; t.compare.6 }T{  -1 }T
  81 T{ : T.COMPARE.7 S" World" S" World"  compare ; t.compare.7 }T{   0 }T
  82 FORGET T.COMPARE.1
  83
  84 \  ----------------------------------------------------- SEARCH
  85 : STR-SEARCH S" ABCDefghIJKL" ;
  86 T{ : T.SEARCH.1 STR-SEARCH S" ABCD" SEARCH ; T.SEARCH.1 }T{ STR-SEARCH TRUE }T
  87 T{ : T.SEARCH.2 STR-SEARCH S" efg"  SEARCH ; T.SEARCH.2 }T{
  88      STR-SEARCH 4 - SWAP 4 CHARS + SWAP TRUE }T
  89 T{ : T.SEARCH.3 STR-SEARCH S" IJKL" SEARCH ; T.SEARCH.3 }T{
  90      STR-SEARCH DROP 8 CHARS + 4 TRUE }T
  91 T{ : T.SEARCH.4 STR-SEARCH STR-SEARCH SEARCH ; T.SEARCH.4 }T{
  92      STR-SEARCH  TRUE }T
  93
  94 T{ : T.SEARCH.5 STR-SEARCH S" CDex" SEARCH ; T.SEARCH.5 }T{
  95      STR-SEARCH  FALSE }T
  96 T{ : T.SEARCH.6 STR-SEARCH S" KLM" SEARCH ; T.SEARCH.6 }T{
  97      STR-SEARCH  FALSE }T
  98 FORGET STR-SEARCH
  99
 100 \  ----------------------------------------------------- SLITERAL
 101 CREATE FAKE-STRING  CHAR H C,   CHAR e C,  CHAR l C, CHAR l C, CHAR o C,
 102 ALIGN
 103 T{ : T.SLITERAL.1  [ FAKE-STRING 5 ] SLITERAL ; T.SLITERAL.1   FAKE-STRING 5 COMPARE
 104      }T{ 0 }T
 105
 106 \  ----------------------------------------------------- S\"
 107 HEX
 108 T{ : GC5 S\" \a\b\e\f\l\m\q\r\t\v\x0F0\x1Fa\xaBx\z\"\\" ; }T{ }T
 109 T{ GC5 SWAP DROP          }T{ 14 }T \ String length
 110 T{ GC5 DROP            C@ }T{ 07 }T \ \a   BEL  Bell
 111 T{ GC5 DROP  1 CHARS + C@ }T{ 08 }T \ \b   BS   Backspace
 112 T{ GC5 DROP  2 CHARS + C@ }T{ 1B }T \ \e   ESC  Escape
 113 T{ GC5 DROP  3 CHARS + C@ }T{ 0C }T \ \f   FF   Form feed
 114 T{ GC5 DROP  4 CHARS + C@ }T{ 0A }T \ \l   LF   Line feed
 115 T{ GC5 DROP  5 CHARS + C@ }T{ 0D }T \ \m        CR of CR/LF pair
 116 T{ GC5 DROP  6 CHARS + C@ }T{ 0A }T \           LF of CR/LF pair
 117 T{ GC5 DROP  7 CHARS + C@ }T{ 22 }T \ \q   "    Double Quote
 118 T{ GC5 DROP  8 CHARS + C@ }T{ 0D }T \ \r   CR   Carriage Return
 119 T{ GC5 DROP  9 CHARS + C@ }T{ 09 }T \ \t   TAB  Horizontal Tab
 120 T{ GC5 DROP  A CHARS + C@ }T{ 0B }T \ \v   VT   Vertical Tab
 121 T{ GC5 DROP  B CHARS + C@ }T{ 0F }T \ \x0F      Given Char
 122 T{ GC5 DROP  C CHARS + C@ }T{ 30 }T \ 0    0    Digit follow on
 123 T{ GC5 DROP  D CHARS + C@ }T{ 1F }T \ \x1F      Given Char
 124 T{ GC5 DROP  E CHARS + C@ }T{ 61 }T \ a    a    Hex follow on
 125 T{ GC5 DROP  F CHARS + C@ }T{ AB }T \ \xaB      Insensitive Given Char
 126 T{ GC5 DROP 10 CHARS + C@ }T{ 78 }T \ x    x    Non hex follow on
 127 T{ GC5 DROP 11 CHARS + C@ }T{ 00 }T \ \z   NUL  No Character
 128 T{ GC5 DROP 12 CHARS + C@ }T{ 22 }T \ \"   "    Double Quote
 129 T{ GC5 DROP 13 CHARS + C@ }T{ 5C }T \ \\   \    Back Slash
 130 DECIMAL
 131
 132 }test