Annotation of gforth/regexp-test.fs, revision 1.11

1.1       pazsan      1: \ regexp test
                      2: 
1.6       anton       3: \ Copyright (C) 2005,2007,2009 Free Software Foundation, Inc.
1.2       anton       4: 
                      5: \ This file is part of Gforth.
                      6: 
                      7: \ Gforth is free software; you can redistribute it and/or
                      8: \ modify it under the terms of the GNU General Public License
1.3       anton       9: \ as published by the Free Software Foundation, either version 3
1.2       anton      10: \ of the License, or (at your option) any later version.
                     11: 
                     12: \ This program is distributed in the hope that it will be useful,
                     13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
                     14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     15: \ GNU General Public License for more details.
                     16: 
                     17: \ You should have received a copy of the GNU General Public License
1.3       anton      18: \ along with this program. If not, see http://www.gnu.org/licenses/.
1.2       anton      19: 
1.5       pazsan     20: charclass [bl-]   blanks +class '-' +char
                     21: charclass [0-9(]  '(' +char '0' '9' ..char
1.1       pazsan     22: 
                     23: : telnum ( addr u -- flag )
                     24:     (( {{ ` (  \( \d \d \d \) ` ) || \( \d \d \d \) }}  blanks c?
                     25:     \( \d \d \d \) [bl-] c?
                     26:     \( \d \d \d \d \) {{ \$ || -\d }} )) ;
                     27: 
                     28: : ?tel ( addr u -- ) telnum
1.5       pazsan     29:     IF  '(' emit \1 type ." ) " \2 type '-' emit \3 type ."  succeeded"
1.1       pazsan     30:     ELSE \0 type ."  failed " THEN ;
                     31: 
                     32: : ?tel-s ( addr u -- ) ?tel ."  should succeed" space depth . cr ;
                     33: : ?tel-f ( addr u -- ) ?tel ."  should fail" space depth . cr ;
                     34: 
                     35: ." --- Telephone number match ---" cr
                     36: s" (123) 456-7890" ?tel-s
                     37: s" (123) 456-7890 " ?tel-s
                     38: s" (123)-456 7890" ?tel-f
                     39: s" (123) 456 789" ?tel-f
                     40: s" 123 456-7890" ?tel-s
                     41: s" 123 456-78909" ?tel-f
                     42: 
                     43: : telnum2 ( addr u -- flag )
                     44:     (( // {{ [0-9(] -c? || \^ }}
                     45:     {{ ` (  \( \d \d \d \) ` ) || \( \d \d \d \) }}  blanks c?
                     46:     \( \d \d \d \) [bl-] c?
                     47:     \( \d \d \d \d \) {{ \$ || -\d }} )) ;
                     48: 
                     49: : ?tel2 ( addr u -- ) telnum2
1.5       pazsan     50:     IF   '(' emit \1 type ." ) " \2 type '-' emit \3 type ."  succeeded"
1.1       pazsan     51:     ELSE \0 type ."  failed " THEN  cr ;
                     52: ." --- Telephone number search ---" cr
                     53: s" blabla (123) 456-7890" ?tel2
                     54: s" blabla (123) 456-7890 " ?tel2
                     55: s" blabla (123)-456 7890" ?tel2
                     56: s" blabla (123) 456 789" ?tel2
                     57: s" blabla 123 456-7890" ?tel2
                     58: s" blabla 123 456-78909" ?tel2
                     59: s" (123) 456-7890" ?tel2
                     60: s"  (123) 456-7890 " ?tel2
                     61: s" a (123)-456 7890" ?tel2
                     62: s" la (123) 456 789" ?tel2
                     63: s" bla 123 456-7890" ?tel2
                     64: s" abla 123 456-78909" ?tel2
                     65: 
                     66: ." --- Number extraction test ---" cr
                     67: 
1.5       pazsan     68: charclass [0-9,./:]  '0' '9' ..char ',' +char '.' +char '/' +char ':' +char
1.1       pazsan     69: 
                     70: : ?num
                     71:     (( // \( {++ [0-9,./:] c? ++} \) ))
                     72:     IF  \1 type  ELSE  \0 type ."  failed"  THEN   cr ;
                     73: 
                     74: s" 1234" ?num
                     75: s" 12,345abc" ?num
                     76: s" foobar12/345:678.9abc" ?num
                     77: s" blafasel" ?num
                     78: 
                     79: ." --- String test --- " cr
                     80: 
                     81: : ?string
                     82:     (( // \( {{ =" foo" || =" bar" || =" test" }} \) ))
                     83:     IF  \1 type  cr THEN ;
                     84: s" dies ist ein test" ?string
                     85: s" foobar" ?string
                     86: s" baz bar foo" ?string
                     87: s" Hier kommt nichts vor" ?string
                     88: 
                     89: ." --- longer matches test --- " cr
                     90: 
                     91: : ?foos
                     92:     (( \( {** =" foo" **} \) ))
                     93:     IF  \1 type  ELSE  \0 type ."  failed"  THEN  cr ;
                     94: 
                     95: : ?foobars
                     96:     (( // \( {** =" foo" **} \) \( {++ =" bar" ++} \) ))
1.5       pazsan     97:     IF  \1 type ',' emit \2 type  ELSE  \0 type ."  failed"  THEN  cr ;
1.1       pazsan     98: 
                     99: : ?foos1
                    100:     (( // \( {+ =" foo" +} \) \( {++ =" bar" ++} \) ))
1.5       pazsan    101:     IF  \1 type ',' emit \2 type  ELSE  \0 type ."  failed"  THEN  cr ;
1.1       pazsan    102: 
                    103: s" foobar" ?foos
                    104: s" foofoofoobar" ?foos
                    105: s" fofoofoofofooofoobarbar" ?foos
                    106: s" bla baz bar" ?foos
                    107: s" foofoofoo" ?foos
                    108: 
                    109: s" foobar" ?foobars
                    110: s" foofoofoobar" ?foobars
                    111: s" fofoofoofofooofoobarbar" ?foobars
                    112: s" bla baz bar" ?foobars
                    113: s" foofoofoo" ?foobars
                    114: 
                    115: s" foobar" ?foos1
                    116: s" foofoofoobar" ?foos1
                    117: s" fofoofoofofooofoobarbar" ?foos1
                    118: s" bla baz bar" ?foos1
                    119: s" foofoofoo" ?foos1
                    120: 
1.11    ! dvdkhlng  121: \ buffer overrun test (bug in =")
        !           122: 
        !           123:  : ?long-string
        !           124:     (( // \( =" abcdefghi" \) ))
        !           125:     IF  \1 type  cr THEN ;
        !           126: 
        !           127: here 4096 allocate throw 4096 + 8 - constant test-string
        !           128:  s" abcdefgh" test-string swap cmove>
        !           129:  .( provoking overflow [i.e. see valgrind output]) cr
        !           130:  test-string . cr
        !           131:  test-string 8 ?long-string
        !           132: .( done) cr
        !           133: 
1.8       dvdkhlng  134: \ simple replacement test
                    135:  
1.11    ! dvdkhlng  136: ." --- simple replacement test ---" cr
1.9       pazsan    137: 
1.8       dvdkhlng  138: : delnum  ( addr u -- addr' u' )   s// \d s" " //g ;
                    139: : test-delnum  ( addr u addr' u' -- )
                    140:    2swap delnum 2over 2over str= 0= IF
                    141:       ." test-delnum: got '" type ." ', expected '" type ." '"
1.10      pazsan    142:    ELSE  2drop 2drop  THEN ;
1.8       dvdkhlng  143: s" 0"  s" " test-delnum
                    144: s" 00"  s" " test-delnum
                    145: s" 0a"  s" a" test-delnum
                    146: s" a0"  s" a" test-delnum
                    147: s" aa"  s" aa" test-delnum
                    148: 
1.11    ! dvdkhlng  149: : delcomment  ( addr u -- addr' u' )  s// ` # {** .? **}  s" " //g ;
        !           150: s" hello # test " delcomment type cr
        !           151: 
1.7       pazsan    152: \ replacement tests
                    153: 
1.9       pazsan    154: ." --- replacement tests ---" cr
                    155: 
1.7       pazsan    156: : hms>s ( addr u -- addr' u' )
                    157:   s// \( \d \d \) ` : \( \d \d \) ` : \( \d \d \)
                    158:   \1 s>number drop 60 *
                    159:   \2 s>number drop + 60 *
                    160:   \3 s>number drop + 0 <# 's' hold #s #> //g ;
                    161: 
1.9       pazsan    162: s" bla 12:34:56 fasel 00:01:57 blubber" 2dup type hms>s
                    163: ."  replaced by " 2dup type
                    164: s" bla 45296s fasel 117s blubber" str= [IF] .(  ok) [ELSE] .(  failed) [THEN] cr
1.7       pazsan    165: 
1.1       pazsan    166: script? [IF] bye [THEN]

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