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

   1 \ @(#) t_strings.fth 97/12/10 1.1\r
   2 \ Test ANS Forth String Word Set\r
   3 \\r
   4 \ Copyright 1994 3DO, Phil Burk\r
   5 \r
   6 include? }T{  t_tools.fth\r
   7 \r
   8 marker task-t_string.fth\r
   9 \r
  10 decimal\r
  11 \r
  12 test{\r
  13 \r
  14 echo off\r
  15 \r
  16 \ ==========================================================\r
  17 \ test is.ok?\r
  18 T{ 1 2 3 }T{ 1 2 3 }T\r
  19 \r
  20 : STR1  S" Hello    " ;\r
  21 : STR2  S" Hello World" ;\r
  22 : STR3  S" " ;\r
  23 \r
  24 \  ----------------------------------------------------- -TRAILING\r
  25 T{ STR1 -TRAILING }T{ STR1 DROP 5 }T\r
  26 T{ STR2 -TRAILING }T{ STR2 }T\r
  27 T{ STR3 -TRAILING }T{ STR3 }T\r
  28 \r
  29 \  ----------------------------------------------------- /STRING\r
  30 T{ STR2  6  /STRING  }T{ STR2 DROP 6 CHARS +   STR2 NIP 6 -  }T\r
  31 \r
  32 \r
  33 \  ----------------------------------------------------- BLANK\r
  34 : T.COMMA.SEQ  ( n -- , lay down N sequential bytes )\r
  35         0 ?DO I C, LOOP\r
  36 ;\r
  37 CREATE T-BLANK-DATA   64 T.COMMA.SEQ\r
  38 T{ T-BLANK-DATA 8 + C@ }T{ 8 }T\r
  39 T-BLANK-DATA 7 + 3 BLANK\r
  40 T{ T-BLANK-DATA 6 + C@ }T{ 6 }T\r
  41 T{ T-BLANK-DATA 7 + C@ }T{ BL }T\r
  42 T{ T-BLANK-DATA 8 + C@ }T{ BL }T\r
  43 T{ T-BLANK-DATA 9 + C@ }T{ BL }T\r
  44 T{ T-BLANK-DATA 10 + C@ }T{ 10 }T\r
  45 FORGET T.COMMA.SEQ\r
  46 \r
  47 \  ----------------------------------------------------- CMOVE\r
  48 : T.COMMA.SEQ  ( n -- , lay down N sequential bytes )\r
  49         0 ?DO I C, LOOP\r
  50 ;\r
  51 CREATE T-BLANK-DATA   64 T.COMMA.SEQ\r
  52 T-BLANK-DATA 7 + T-BLANK-DATA 6 + 3 CMOVE\r
  53 T{ T-BLANK-DATA 5 + C@ }T{ 5 }T\r
  54 T{ T-BLANK-DATA 6 + C@ }T{ 7 }T\r
  55 T{ T-BLANK-DATA 7 + C@ }T{ 8 }T\r
  56 T{ T-BLANK-DATA 8 + C@ }T{ 9 }T\r
  57 T{ T-BLANK-DATA 9 + C@ }T{ 9 }T\r
  58 FORGET T.COMMA.SEQ\r
  59 \r
  60 \  ----------------------------------------------------- CMOVE>\r
  61 : T.COMMA.SEQ  ( n -- , lay down N sequential bytes )\r
  62         0 ?DO I C, LOOP\r
  63 ;\r
  64 CREATE T-BLANK-DATA   64 T.COMMA.SEQ\r
  65 T{ T-BLANK-DATA 6 + T-BLANK-DATA 7 + 3 CMOVE>\r
  66 T{ T-BLANK-DATA 5 + C@ }T{ 5 }T\r
  67 T{ T-BLANK-DATA 6 + C@ }T{ 6 }T\r
  68 T{ T-BLANK-DATA 7 + C@ }T{ 6 }T\r
  69 T{ T-BLANK-DATA 8 + C@ }T{ 7 }T\r
  70 T{ T-BLANK-DATA 9 + C@ }T{ 8 }T\r
  71 T{ T-BLANK-DATA 10 + C@ }T{ 10 }T\r
  72 FORGET T.COMMA.SEQ\r
  73 \r
  74 \  ----------------------------------------------------- COMPARE\r
  75 T{ : T.COMPARE.1 S" abcd" S" abcd"    compare ; t.compare.1 }T{   0 }T\r
  76 T{ : T.COMPARE.2 S" abcd" S" abcde"   compare ; t.compare.2 }T{  -1 }T\r
  77 T{ : T.COMPARE.3 S" abcdef" S" abcde" compare ; t.compare.3 }T{   1 }T\r
  78 T{ : T.COMPARE.4 S" abGd" S" abcde"   compare ; t.compare.4 }T{  -1 }T\r
  79 T{ : T.COMPARE.5 S" abcd" S" aXcde"   compare ; t.compare.5 }T{   1 }T\r
  80 T{ : T.COMPARE.6 S" abGd" S" abcd"    compare ; t.compare.6 }T{  -1 }T\r
  81 T{ : T.COMPARE.7 S" World" S" World"  compare ; t.compare.7 }T{   0 }T\r
  82 FORGET T.COMPARE.1\r
  83 \r
  84 \  ----------------------------------------------------- SEARCH\r
  85 : STR-SEARCH S" ABCDefghIJKL" ;\r
  86 T{ : T.SEARCH.1 STR-SEARCH S" ABCD" SEARCH ; T.SEARCH.1 }T{ STR-SEARCH TRUE }T\r
  87 T{ : T.SEARCH.2 STR-SEARCH S" efg"  SEARCH ; T.SEARCH.2 }T{\r
  88          STR-SEARCH 4 - SWAP 4 CHARS + SWAP TRUE }T\r
  89 T{ : T.SEARCH.3 STR-SEARCH S" IJKL" SEARCH ; T.SEARCH.3 }T{\r
  90          STR-SEARCH DROP 8 CHARS + 4 TRUE }T\r
  91 T{ : T.SEARCH.4 STR-SEARCH STR-SEARCH SEARCH ; T.SEARCH.4 }T{\r
  92          STR-SEARCH  TRUE }T\r
  93 \r
  94 T{ : T.SEARCH.5 STR-SEARCH S" CDex" SEARCH ; T.SEARCH.5 }T{\r
  95          STR-SEARCH  FALSE }T\r
  96 T{ : T.SEARCH.6 STR-SEARCH S" KLM" SEARCH ; T.SEARCH.6 }T{\r
  97          STR-SEARCH  FALSE }T\r
  98 FORGET STR-SEARCH\r
  99 \r
 100 \  ----------------------------------------------------- SLITERAL\r
 101 CREATE FAKE-STRING  CHAR H C,   CHAR e C,  CHAR l C, CHAR l C, CHAR o C, \r
 102 ALIGN\r
 103 T{ : T.SLITERAL.1  [ FAKE-STRING 5 ] SLITERAL ; T.SLITERAL.1   FAKE-STRING 5 COMPARE\r
 104          }T{ 0 }T\r
 105         \r
 106 }test\r