[gforth] / gforth / regexp-test.fs  

gforth: gforth/regexp-test.fs

Diff for /gforth/regexp-test.fs between version 1.15 and 1.17

version 1.15, Sun Sep 12 17:10:04 2010 UTC version 1.17, Sun Sep 12 22:04:06 2010 UTC
Line 17 
Line 17 
 \ You should have received a copy of the GNU General Public License  \ You should have received a copy of the GNU General Public License
 \ along with this program. If not, see http://www.gnu.org/licenses/.  \ along with this program. If not, see http://www.gnu.org/licenses/.
   
   : ?depth  depth IF  ." unbalanced: " .s clearstack cr  THEN ;
   
 charclass [bl-]   blanks +class '-' +char  charclass [bl-]   blanks +class '-' +char
 charclass [0-9(]  '(' +char '0' '9' ..char  charclass [0-9(]  '(' +char '0' '9' ..char
   
Line 29 
Line 31 
     IF  '(' emit \1 type ." ) " \2 type '-' emit \3 type ."  succeeded"      IF  '(' emit \1 type ." ) " \2 type '-' emit \3 type ."  succeeded"
     ELSE \0 type ."  failed " THEN ;      ELSE \0 type ."  failed " THEN ;
   
 : ?tel-s ( addr u -- ) ?tel ."  should succeed" space depth . cr ;  : ?tel-s ( addr u -- ) ?tel ."  should succeed" space cr ?depth ;
 : ?tel-f ( addr u -- ) ?tel ."  should fail" space depth . cr ;  : ?tel-f ( addr u -- ) ?tel ."  should fail" space cr ?depth ;
   
 ." --- Telephone number match ---" cr  ." --- Telephone number match ---" cr
 s" (123) 456-7890" ?tel-s  s" (123) 456-7890" ?tel-s
Line 48 
Line 50 
   
 : ?tel2 ( addr u -- ) telnum2  : ?tel2 ( addr u -- ) telnum2
     IF   '(' emit \1 type ." ) " \2 type '-' emit \3 type ."  succeeded"      IF   '(' emit \1 type ." ) " \2 type '-' emit \3 type ."  succeeded"
     ELSE \0 type ."  failed " THEN  cr ;      ELSE \0 type ."  failed " THEN  cr ?depth ;
 ." --- Telephone number search ---" cr  ." --- Telephone number search ---" cr
 s" blabla (123) 456-7890" ?tel2  s" blabla (123) 456-7890" ?tel2
 s" blabla (123) 456-7890 " ?tel2  s" blabla (123) 456-7890 " ?tel2
Line 69 
Line 71 
   
 : ?num  : ?num
     (( // \( {++ [0-9,./:] c? ++} \) ))      (( // \( {++ [0-9,./:] c? ++} \) ))
     IF  \1 type  ELSE  \0 type ."  failed"  THEN   cr ;      IF  \1 type  ELSE  \0 type ."  failed"  THEN   cr ?depth ;
   
 s" 1234" ?num  s" 1234" ?num
 s" 12,345abc" ?num  s" 12,345abc" ?num
Line 90 
Line 92 
   
 : ?foos  : ?foos
     (( \( {** =" foo" **} \) ))      (( \( {** =" foo" **} \) ))
     IF  \1 type  ELSE  \0 type ."  failed"  THEN  cr ;      IF  \1 type  ELSE  \0 type ."  failed"  THEN  cr ?depth ;
   
 : ?foobars  : ?foobars
     (( // \( {** =" foo" **} \) \( {++ =" bar" ++} \) ))      (( // \( {** =" foo" **} \) \( {++ =" bar" ++} \) ))
     IF  \1 type ',' emit \2 type  ELSE  \0 type ."  failed"  THEN  cr ;      IF  \1 type ',' emit \2 type  ELSE  \0 type ."  failed"  THEN  cr ?depth ;
   
 : ?foos1  : ?foos1
     (( // \( {+ =" foo" +} \) \( {++ =" bar" ++} \) ))      (( // \( {+ =" foo" +} \) \( {++ =" bar" ++} \) ))
     IF  \1 type ',' emit \2 type  ELSE  \0 type ."  failed"  THEN  cr ;      IF  \1 type ',' emit \2 type  ELSE  \0 type ."  failed"  THEN  cr ?depth ;
   
 s" foobar" ?foos  s" foobar" ?foos
 s" foofoofoobar" ?foos  s" foofoofoobar" ?foos
Line 132 
Line 134 
     (( // \( =" abcdefghi" \) ))      (( // \( =" abcdefghi" \) ))
     IF  \1 type  cr THEN ;      IF  \1 type  cr THEN ;
   
 here 4096 allocate throw 4096 + 8 - constant test-string  4096 allocate throw 4096 + 8 - constant test-string
  s" abcdefgh" test-string swap cmove>   s" abcdefgh" test-string swap cmove>
  .( provoking overflow [i.e. see valgrind output]) cr   .( provoking overflow [i.e. see valgrind output]) cr
  test-string . cr   test-string . cr
  test-string 8 ?long-string   test-string 8 ?long-string
 .( done) cr  .( done) cr ?depth
   
 \ simple replacement test  \ simple replacement test
   
Line 147 
Line 149 
 : test-delnum  ( addr u addr' u' -- )  : test-delnum  ( addr u addr' u' -- )
    2swap delnum 2over 2over str= 0= IF     2swap delnum 2over 2over str= 0= IF
       ." test-delnum: got '" type ." ', expected '" type ." '"        ." test-delnum: got '" type ." ', expected '" type ." '"
    ELSE  2drop 2drop ." passed" cr  THEN ;     ELSE  2drop 2drop ." test-delnum passed" cr  THEN  ?depth ;
 s" 0"  s" " test-delnum  s" 0"  s" " test-delnum
 s" 00"  s" " test-delnum  s" 00"  s" " test-delnum
 s" 0a"  s" a" test-delnum  s" 0a"  s" a" test-delnum
Line 158 
Line 160 
 s" hello # test " delcomment type cr  s" hello # test " delcomment type cr
 : delparents  ( addr u -- addr' u' )  s// ` ( {* .? *} ` ) >> s" ()" //g ;  : delparents  ( addr u -- addr' u' )  s// ` ( {* .? *} ` ) >> s" ()" //g ;
 s" delete (test) and (another test) " delparents type cr  s" delete (test) and (another test) " delparents type cr
   ?depth
   
 \ replacement tests  \ replacement tests
   
Line 172 
Line 175 
 s" bla 12:34:56 fasel 00:01:57 blubber" 2dup type hms>s  s" bla 12:34:56 fasel 00:01:57 blubber" 2dup type hms>s
 ."  -> " 2dup type  ."  -> " 2dup type
 s" bla 45296s fasel 117s blubber" str= [IF] .(  ok) [ELSE] .(  failed) [THEN] cr  s" bla 45296s fasel 117s blubber" str= [IF] .(  ok) [ELSE] .(  failed) [THEN] cr
   ?depth
   
 : hms>s,del() ( addr u -- addr' u' )  : hms>s,del() ( addr u -- addr' u' )
   s// {{ \( \d \d \) ` : \( \d \d \) ` : \( \d \d \)    s// {{ \( \d \d \) ` : \( \d \d \) ` : \( \d \d \)

Generate output suitable for use with a patch program
Legend:
Removed from v.1.15  
changed lines
  Added in v.1.17
CVS Admin

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help