[gforth] / gforth / regexp-test.fs  

gforth: gforth/regexp-test.fs

1 : pazsan 1.1 \ regexp test
2 :    
3 : anton 1.6 \ Copyright (C) 2005,2007,2009 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.5 charclass [bl-] blanks +class '-' +char
21 :     charclass [0-9(] '(' +char '0' '9' ..char
22 : pazsan 1.1
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 : pazsan 1.5 IF '(' emit \1 type ." ) " \2 type '-' emit \3 type ." succeeded"
30 : pazsan 1.1 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 : pazsan 1.5 IF '(' emit \1 type ." ) " \2 type '-' emit \3 type ." succeeded"
51 : pazsan 1.1 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 : pazsan 1.5 charclass [0-9,./:] '0' '9' ..char ',' +char '.' +char '/' +char ':' +char
69 : pazsan 1.1
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 : pazsan 1.5 IF \1 type ',' emit \2 type ELSE \0 type ." failed" THEN cr ;
98 : pazsan 1.1
99 :     : ?foos1
100 :     (( // \( {+ =" foo" +} \) \( {++ =" bar" ++} \) ))
101 : pazsan 1.5 IF \1 type ',' emit \2 type ELSE \0 type ." failed" THEN cr ;
102 : pazsan 1.1
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 : dvdkhlng 1.8 \ simple replacement test
122 :    
123 :     : delnum ( addr u -- addr' u' ) s// \d s" " //g ;
124 :     : test-delnum ( addr u addr' u' -- )
125 :     2swap delnum 2over 2over str= 0= IF
126 :     ." test-delnum: got '" type ." ', expected '" type ." '"
127 :     THEN ;
128 :     s" 0" s" " test-delnum
129 :     s" 00" s" " test-delnum
130 :     s" 0a" s" a" test-delnum
131 :     s" a0" s" a" test-delnum
132 :     s" aa" s" aa" test-delnum
133 :    
134 : pazsan 1.7 \ replacement tests
135 :    
136 :     : hms>s ( addr u -- addr' u' )
137 :     s// \( \d \d \) ` : \( \d \d \) ` : \( \d \d \)
138 :     \1 s>number drop 60 *
139 :     \2 s>number drop + 60 *
140 :     \3 s>number drop + 0 <# 's' hold #s #> //g ;
141 :    
142 :     s" bla 12:34:56 fasel 00:01:57 blubber" hms>s
143 : dvdkhlng 1.8 s" bla 45296s fasel 117s" str= 0= [IF] .( replacement failed) [THEN]
144 : pazsan 1.7
145 : pazsan 1.1 script? [IF] bye [THEN]
CVS Admin

Powered by ViewCVS 1.0-dev 		(Powered by ViewCVS)

ViewCVS and CVS Help