regexp-test.fs 4.25 KB
Newer Older
bp's avatar
bp committed
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
\ regexp test

charclass [bl-]   blanks +class '- +char
charclass [0-9(]  '( +char '0 '9 ..char

: telnum ( addr u -- flag )
    (( {{ ` (  \( \d \d \d \) ` ) || \( \d \d \d \) }}  blanks c?
    \( \d \d \d \) [bl-] c?
    \( \d \d \d \d \) {{ \$ || -\d }} )) ;

: ?tel ( addr u -- ) telnum
    IF  '( emit \1 type ." ) " \2 type '- emit \3 type ."  succeeded"
    ELSE \0 type ."  failed " THEN ;

: ?tel-s ( addr u -- ) ?tel ."  should succeed" space depth . cr ;
: ?tel-f ( addr u -- ) ?tel ."  should fail" space depth . cr ;

." --- Telephone number match ---" cr
s" (123) 456-7890" ?tel-s
s" (123) 456-7890 " ?tel-s
s" (123)-456 7890" ?tel-f
s" (123) 456 789" ?tel-f
s" 123 456-7890" ?tel-s
s" 123 456-78909" ?tel-f

: telnum2 ( addr u -- flag )
    (( // {{ [0-9(] -c? || \^ }}
    {{ ` (  \( \d \d \d \) ` ) || \( \d \d \d \) }}  blanks c?
    \( \d \d \d \) [bl-] c?
    \( \d \d \d \d \) {{ \$ || -\d }} )) ;

: ?tel2 ( addr u -- ) telnum2
    IF   '( emit \1 type ." ) " \2 type '- emit \3 type ."  succeeded"
    ELSE \0 type ."  failed " THEN  cr ;
." --- Telephone number search ---" cr
s" blabla (123) 456-7890" ?tel2
s" blabla (123) 456-7890 " ?tel2
s" blabla (123)-456 7890" ?tel2
s" blabla (123) 456 789" ?tel2
s" blabla 123 456-7890" ?tel2
s" blabla 123 456-78909" ?tel2
s" (123) 456-7890" ?tel2
s"  (123) 456-7890 " ?tel2
s" a (123)-456 7890" ?tel2
s" la (123) 456 789" ?tel2
s" bla 123 456-7890" ?tel2
s" abla 123 456-78909" ?tel2

." --- Number extraction test ---" cr

charclass [0-9,./:]  '0 '9 ..char ', +char '. +char '/ +char ': +char

: ?num
    (( // \( {++ [0-9,./:] c? ++} \) ))
    IF  \1 type  ELSE  \0 type ."  failed"  THEN   cr ;

s" 1234" ?num
s" 12,345abc" ?num
s" foobar12/345:678.9abc" ?num
s" blafasel" ?num

." --- String test --- " cr

: ?string
    (( // \( {{ =" foo" || =" bar" || =" test" }} \) ))
    IF  \1 type  cr THEN ;
s" dies ist ein test" ?string
s" foobar" ?string
s" baz bar foo" ?string
s" Hier kommt nichts vor" ?string

." --- longer matches test --- " cr

: ?foos
    (( \( {** =" foo" **} \) ))
    IF  \1 type  ELSE  \0 type ."  failed"  THEN  cr ;

: ?foobars
    (( // \( {** =" foo" **} \) \( {++ =" bar" ++} \) ))
    IF  \1 type ', emit \2 type  ELSE  \0 type ."  failed"  THEN  cr ;

: ?foos1
    (( // \( {+ =" foo" +} \) \( {++ =" bar" ++} \) ))
    IF  \1 type ', emit \2 type  ELSE  \0 type ."  failed"  THEN  cr ;

s" foobar" ?foos
s" foofoofoobar" ?foos
s" fofoofoofofooofoobarbar" ?foos
s" bla baz bar" ?foos
s" foofoofoo" ?foos

s" foobar" ?foobars
s" foofoofoobar" ?foobars
s" fofoofoofofooofoobarbar" ?foobars
s" bla baz bar" ?foobars
s" foofoofoo" ?foobars

s" foobar" ?foos1
s" foofoofoobar" ?foos1
s" fofoofoofofooofoobarbar" ?foos1
s" bla baz bar" ?foos1
s" foofoofoo" ?foos1

bp's avatar
bp committed
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
\ simple replacement test
 
." --- simple replacement test ---" cr

: delnum  ( addr u -- addr' u' )   s// \d >> s" " //g ;
: test-delnum  ( addr u addr' u' -- )
   2swap delnum 2over 2over str= 0= IF
      ." test-delnum: got '" type ." ', expected '" type ." '"
   ELSE  2drop 2drop ." passed" cr  THEN ;
s" 0"  s" " test-delnum
s" 00"  s" " test-delnum
s" 0a"  s" a" test-delnum
s" a0"  s" a" test-delnum
s" aa"  s" aa" test-delnum

: delcomment  ( addr u -- addr' u' )  s// ` # {** .? **} >> s" " //g ;
s" hello # test " delcomment type cr
: delparents  ( addr u -- addr' u' )  s// ` ( {* .? *} ` ) >> s" ()" //g ;
s" delete (test) and (another test) " delparents type cr

bp's avatar
bp committed
124
125
\ replacement tests

bp's avatar
bp committed
126
127
." --- replacement tests ---" cr

bp's avatar
bp committed
128
: hms>s ( addr u -- addr' u' )
bp's avatar
bp committed
129
  s// \( \d \d \) ` : \( \d \d \) ` : \( \d \d \) >>
bp's avatar
bp committed
130
131
  \1 s>number drop 60 *
  \2 s>number drop + 60 *
bp's avatar
bp committed
132
  \3 s>number drop + 0 <<# 's' hold #s #> #>> //g ;
bp's avatar
bp committed
133

bp's avatar
bp committed
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
s" bla 12:34:56 fasel 00:01:57 blubber" 2dup type hms>s
."  replaced by " 2dup type
s" bla 45296s fasel 117s blubber" str= [IF] .(  ok) [ELSE] .(  failed) [THEN] cr

: delnum  ( addr u -- addr' u' )   s// \d >> s" " //g ;

s" 0a" delnum type cr
s" a" delnum type cr

: hms>s,del() ( addr u -- addr' u' )
  s// {{ \( \d \d \) ` : \( \d \d \) ` : \( \d \d \)
         >> \1 s>number drop 60 *
            \2 s>number drop + 60 *
            \3 s>number drop + 0 <# 's' hold #s #> <<
         || ` ( {* .? *} ` ) >> <<" "
      }} LEAVE //s ;

\ doesn't work yet
\ s" (bla) 12:34:56 (fasel) 00:01:57 (blubber)" 2dup type hms>s,del() space type cr
bp's avatar
bp committed
153

bp's avatar
bp committed
154
script? [IF] bye [THEN]