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

1.1       pazsan      1: \ regexp test
                      2: 
1.2     ! anton       3: \ Copyright (C) 2005 Free Software Foundation, Inc.
        !             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
        !             9: \ as published by the Free Software Foundation; either version 2
        !            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
        !            18: \ along with this program; if not, write to the Free Software
        !            19: \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
        !            20: 
1.1       pazsan     21: charclass [bl-]   blanks +class '- +char
                     22: charclass [0-9(]  '( +char '0 '9 ..char
                     23: 
                     24: : telnum ( addr u -- flag )
                     25:     (( {{ ` (  \( \d \d \d \) ` ) || \( \d \d \d \) }}  blanks c?
                     26:     \( \d \d \d \) [bl-] c?
                     27:     \( \d \d \d \d \) {{ \$ || -\d }} )) ;
                     28: 
                     29: : ?tel ( addr u -- ) telnum
                     30:     IF  '( emit \1 type ." ) " \2 type '- emit \3 type ."  succeeded"
                     31:     ELSE \0 type ."  failed " THEN ;
                     32: 
                     33: : ?tel-s ( addr u -- ) ?tel ."  should succeed" space depth . cr ;
                     34: : ?tel-f ( addr u -- ) ?tel ."  should fail" space depth . cr ;
                     35: 
                     36: ." --- Telephone number match ---" cr
                     37: s" (123) 456-7890" ?tel-s
                     38: s" (123) 456-7890 " ?tel-s
                     39: s" (123)-456 7890" ?tel-f
                     40: s" (123) 456 789" ?tel-f
                     41: s" 123 456-7890" ?tel-s
                     42: s" 123 456-78909" ?tel-f
                     43: 
                     44: : telnum2 ( addr u -- flag )
                     45:     (( // {{ [0-9(] -c? || \^ }}
                     46:     {{ ` (  \( \d \d \d \) ` ) || \( \d \d \d \) }}  blanks c?
                     47:     \( \d \d \d \) [bl-] c?
                     48:     \( \d \d \d \d \) {{ \$ || -\d }} )) ;
                     49: 
                     50: : ?tel2 ( addr u -- ) telnum2
                     51:     IF   '( emit \1 type ." ) " \2 type '- emit \3 type ."  succeeded"
                     52:     ELSE \0 type ."  failed " THEN  cr ;
                     53: ." --- Telephone number search ---" cr
                     54: s" blabla (123) 456-7890" ?tel2
                     55: s" blabla (123) 456-7890 " ?tel2
                     56: s" blabla (123)-456 7890" ?tel2
                     57: s" blabla (123) 456 789" ?tel2
                     58: s" blabla 123 456-7890" ?tel2
                     59: s" blabla 123 456-78909" ?tel2
                     60: s" (123) 456-7890" ?tel2
                     61: s"  (123) 456-7890 " ?tel2
                     62: s" a (123)-456 7890" ?tel2
                     63: s" la (123) 456 789" ?tel2
                     64: s" bla 123 456-7890" ?tel2
                     65: s" abla 123 456-78909" ?tel2
                     66: 
                     67: ." --- Number extraction test ---" cr
                     68: 
                     69: charclass [0-9,./:]  '0 '9 ..char ', +char '. +char '/ +char ': +char
                     70: 
                     71: : ?num
                     72:     (( // \( {++ [0-9,./:] c? ++} \) ))
                     73:     IF  \1 type  ELSE  \0 type ."  failed"  THEN   cr ;
                     74: 
                     75: s" 1234" ?num
                     76: s" 12,345abc" ?num
                     77: s" foobar12/345:678.9abc" ?num
                     78: s" blafasel" ?num
                     79: 
                     80: ." --- String test --- " cr
                     81: 
                     82: : ?string
                     83:     (( // \( {{ =" foo" || =" bar" || =" test" }} \) ))
                     84:     IF  \1 type  cr THEN ;
                     85: s" dies ist ein test" ?string
                     86: s" foobar" ?string
                     87: s" baz bar foo" ?string
                     88: s" Hier kommt nichts vor" ?string
                     89: 
                     90: ." --- longer matches test --- " cr
                     91: 
                     92: : ?foos
                     93:     (( \( {** =" foo" **} \) ))
                     94:     IF  \1 type  ELSE  \0 type ."  failed"  THEN  cr ;
                     95: 
                     96: : ?foobars
                     97:     (( // \( {** =" foo" **} \) \( {++ =" bar" ++} \) ))
                     98:     IF  \1 type ', emit \2 type  ELSE  \0 type ."  failed"  THEN  cr ;
                     99: 
                    100: : ?foos1
                    101:     (( // \( {+ =" foo" +} \) \( {++ =" bar" ++} \) ))
                    102:     IF  \1 type ', emit \2 type  ELSE  \0 type ."  failed"  THEN  cr ;
                    103: 
                    104: s" foobar" ?foos
                    105: s" foofoofoobar" ?foos
                    106: s" fofoofoofofooofoobarbar" ?foos
                    107: s" bla baz bar" ?foos
                    108: s" foofoofoo" ?foos
                    109: 
                    110: s" foobar" ?foobars
                    111: s" foofoofoobar" ?foobars
                    112: s" fofoofoofofooofoobarbar" ?foobars
                    113: s" bla baz bar" ?foobars
                    114: s" foofoofoo" ?foobars
                    115: 
                    116: s" foobar" ?foos1
                    117: s" foofoofoobar" ?foos1
                    118: s" fofoofoofofooofoobarbar" ?foos1
                    119: s" bla baz bar" ?foos1
                    120: s" foofoofoo" ?foos1
                    121: 
                    122: script? [IF] bye [THEN]

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