1: \ regexp test
2:
3: charclass [bl-] blanks +class '- +char
4: charclass [0-9(] '( +char '0 '9 ..char
5:
6: : telnum ( addr u -- flag )
7: (( {{ ` ( \( \d \d \d \) ` ) || \( \d \d \d \) }} blanks c?
8: \( \d \d \d \) [bl-] c?
9: \( \d \d \d \d \) {{ \$ || -\d }} )) ;
10:
11: : ?tel ( addr u -- ) telnum
12: IF '( emit \1 type ." ) " \2 type '- emit \3 type ." succeeded"
13: ELSE \0 type ." failed " THEN ;
14:
15: : ?tel-s ( addr u -- ) ?tel ." should succeed" space depth . cr ;
16: : ?tel-f ( addr u -- ) ?tel ." should fail" space depth . cr ;
17:
18: ." --- Telephone number match ---" cr
19: s" (123) 456-7890" ?tel-s
20: s" (123) 456-7890 " ?tel-s
21: s" (123)-456 7890" ?tel-f
22: s" (123) 456 789" ?tel-f
23: s" 123 456-7890" ?tel-s
24: s" 123 456-78909" ?tel-f
25:
26: : telnum2 ( addr u -- flag )
27: (( // {{ [0-9(] -c? || \^ }}
28: {{ ` ( \( \d \d \d \) ` ) || \( \d \d \d \) }} blanks c?
29: \( \d \d \d \) [bl-] c?
30: \( \d \d \d \d \) {{ \$ || -\d }} )) ;
31:
32: : ?tel2 ( addr u -- ) telnum2
33: IF '( emit \1 type ." ) " \2 type '- emit \3 type ." succeeded"
34: ELSE \0 type ." failed " THEN cr ;
35: ." --- Telephone number search ---" cr
36: s" blabla (123) 456-7890" ?tel2
37: s" blabla (123) 456-7890 " ?tel2
38: s" blabla (123)-456 7890" ?tel2
39: s" blabla (123) 456 789" ?tel2
40: s" blabla 123 456-7890" ?tel2
41: s" blabla 123 456-78909" ?tel2
42: s" (123) 456-7890" ?tel2
43: s" (123) 456-7890 " ?tel2
44: s" a (123)-456 7890" ?tel2
45: s" la (123) 456 789" ?tel2
46: s" bla 123 456-7890" ?tel2
47: s" abla 123 456-78909" ?tel2
48:
49: ." --- Number extraction test ---" cr
50:
51: charclass [0-9,./:] '0 '9 ..char ', +char '. +char '/ +char ': +char
52:
53: : ?num
54: (( // \( {++ [0-9,./:] c? ++} \) ))
55: IF \1 type ELSE \0 type ." failed" THEN cr ;
56:
57: s" 1234" ?num
58: s" 12,345abc" ?num
59: s" foobar12/345:678.9abc" ?num
60: s" blafasel" ?num
61:
62: ." --- String test --- " cr
63:
64: : ?string
65: (( // \( {{ =" foo" || =" bar" || =" test" }} \) ))
66: IF \1 type cr THEN ;
67: s" dies ist ein test" ?string
68: s" foobar" ?string
69: s" baz bar foo" ?string
70: s" Hier kommt nichts vor" ?string
71:
72: ." --- longer matches test --- " cr
73:
74: : ?foos
75: (( \( {** =" foo" **} \) ))
76: IF \1 type ELSE \0 type ." failed" THEN cr ;
77:
78: : ?foobars
79: (( // \( {** =" foo" **} \) \( {++ =" bar" ++} \) ))
80: IF \1 type ', emit \2 type ELSE \0 type ." failed" THEN cr ;
81:
82: : ?foos1
83: (( // \( {+ =" foo" +} \) \( {++ =" bar" ++} \) ))
84: IF \1 type ', emit \2 type ELSE \0 type ." failed" THEN cr ;
85:
86: s" foobar" ?foos
87: s" foofoofoobar" ?foos
88: s" fofoofoofofooofoobarbar" ?foos
89: s" bla baz bar" ?foos
90: s" foofoofoo" ?foos
91:
92: s" foobar" ?foobars
93: s" foofoofoobar" ?foobars
94: s" fofoofoofofooofoobarbar" ?foobars
95: s" bla baz bar" ?foobars
96: s" foofoofoo" ?foobars
97:
98: s" foobar" ?foos1
99: s" foofoofoobar" ?foos1
100: s" fofoofoofofooofoobarbar" ?foos1
101: s" bla baz bar" ?foos1
102: s" foofoofoo" ?foos1
103:
104: script? [IF] bye [THEN]
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>