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>