[gforth] / gforth / regexp-test.fs  

gforth: gforth/regexp-test.fs


1 : pazsan 1.1 \ regexp test
2 :    
3 : anton 1.4 \ Copyright (C) 2005,2007 Free Software Foundation, Inc.
4 : anton 1.2
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 : anton 1.3 \ as published by the Free Software Foundation, either version 3
10 : anton 1.2 \ 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 : anton 1.3 \ along with this program. If not, see http://www.gnu.org/licenses/.
19 : anton 1.2
20 : pazsan 1.1 charclass [bl-] blanks +class '- +char
21 :     charclass [0-9(] '( +char '0 '9 ..char
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
29 :     IF '( emit \1 type ." ) " \2 type '- emit \3 type ." succeeded"
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
50 :     IF '( emit \1 type ." ) " \2 type '- emit \3 type ." succeeded"
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 :    
68 :     charclass [0-9,./:] '0 '9 ..char ', +char '. +char '/ +char ': +char
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" ++} \) ))
97 :     IF \1 type ', emit \2 type ELSE \0 type ." failed" THEN cr ;
98 :    
99 :     : ?foos1
100 :     (( // \( {+ =" foo" +} \) \( {++ =" bar" ++} \) ))
101 :     IF \1 type ', emit \2 type ELSE \0 type ." failed" THEN cr ;
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 :    
121 :     script? [IF] bye [THEN]

CVS Admin

Powered by ViewCVS 1.0-dev
(Powered by ViewCVS)

ViewCVS and CVS Help