Diff for /gforth/regexp-test.fs between versions 1.16 and 1.23

version 1.16, 2010/09/12 21:46:30 version 1.23, 2010/12/31 18:09:02
Line 1 Line 1
 \ regexp test  \ regexp test
   
 \ Copyright (C) 2005,2007,2009 Free Software Foundation, Inc.  \ Copyright (C) 2005,2007,2009,2010 Free Software Foundation, Inc.
   
 \ This file is part of Gforth.  \ This file is part of Gforth.
   
Line 114  s" fofoofoofofooofoobarbar" ?foobars Line 114  s" fofoofoofofooofoobarbar" ?foobars
 s" bla baz bar" ?foobars  s" bla baz bar" ?foobars
 s" foofoofoo" ?foobars  s" foofoofoo" ?foobars
   
 \ s" foobar" ?foos1  s" foobar" ?foos1
 \ s" foofoofoobar" ?foos1  s" foofoofoobar" ?foos1
 \ s" fofoofoofofooofoobarbar" ?foos1  s" fofoofoofofooofoobarbar" ?foos1
 \ s" bla baz bar" ?foos1  s" bla baz bar" ?foos1
 \ s" foofoofoo" ?foos1  s" foofoofoo" ?foos1
   
 \ backtracking on decissions  \ backtracking on decissions
   
Line 134  s" aab" ?aab 0= [IF] .( aab failed!) cr Line 134  s" aab" ?aab 0= [IF] .( aab failed!) cr
     (( // \( =" 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 149  here 4096 allocate throw 4096 + 8 - cons Line 149  here 4096 allocate throw 4096 + 8 - cons
 : 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 160  s" aa"  s" aa" test-delnum Line 160  s" aa"  s" aa" test-delnum
 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 174  s" delete (test) and (another test) " de Line 175  s" delete (test) and (another test) " de
 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 \)
          >> \1 s>number drop 60 *           >> \1 s>number drop 60 *
             \2 s>number drop + 60 *              \2 s>number drop + 60 *
             \3 s>number drop + 0 <# 's' hold #s #> <<              \3 s>number drop + 0 <# 's' hold #s #> <<
          || ` ( // ` ) >> <<" "  
       }} LEAVE //s ;        }} LEAVE //s ;
   
 \ doesn't work yet  s" (bla) 12:34:56 (fasel) 00:01:57 (blubber)" 2dup type hms>s,del() ."  -> " type cr
 \ s" (bla) 12:34:56 (fasel) 00:01:57 (blubber)" 2dup type hms>s,del() space type cr  
   \ more tests from David K├╝hling
   
   require test/ttester.fs
   
   : underflow1  ( c-addr u -- flag )
      (( {{
            {{ ` - || }} \d
            || \d
         }} )) ;
   T{ s" -1dummy" underflow1 -> true }T
   
   : underflow2  ( -- )
      (( \( {{ \s {** \s **} 
            || =" /*" // =" */"
            || =" //" {** \d **} }} \) )) ;
   T{ s" /*10203030203030404*/   " underflow2 -> true }T
   T{ pad 0 underflow2 -> false }T
   
   charclass [*] '* +char
   charclass [*/] '* +char '/ +char
   
   : underflow3  ( -- )
      ((
         =" /*"
         \( {** {{ [*] -c? || ` * [*/] -c? }} **} \)
         {++ ` * ++} ` /
      )) ;
   
   \ this still seems to be too complicated
   T{ s" /*10203030203030404*/   " underflow3 .s -> true }T
   \1 type cr
   
   : underflow4  ( -- )
      (( \( {{ {** \d **} || {** \d **} }} \d \) )) ;
   
   T{ s" 0  " underflow4 -> true }T
   
 script? [IF] bye [THEN]  script? [IF] bye [THEN]

Removed from v.1.16  
changed lines
  Added in v.1.23


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>