Commit | Line | Data |
e7707071 |
1 | #!./perl |
2 | # |
3 | # Tests to make sure the regexp engine doesn't run into limits too soon. |
4 | # |
5 | |
6 | BEGIN { |
7 | chdir 't' if -d 't'; |
8 | @INC = '../lib'; |
9 | } |
10 | |
11 | print "1..13\n"; |
12 | |
13 | my $email = qr { |
14 | (?(DEFINE) |
15 | (?<address> (?&mailbox) | (?&group)) |
16 | (?<mailbox> (?&name_addr) | (?&addr_spec)) |
17 | (?<name_addr> (?&display_name)? (?&angle_addr)) |
18 | (?<angle_addr> (?&CFWS)? < (?&addr_spec) > (?&CFWS)?) |
19 | (?<group> (?&display_name) : (?:(?&mailbox_list) | (?&CFWS))? ; |
20 | (?&CFWS)?) |
21 | (?<display_name> (?&phrase)) |
22 | (?<mailbox_list> (?&mailbox) (?: , (?&mailbox))*) |
23 | |
24 | (?<addr_spec> (?&local_part) \@ (?&domain)) |
25 | (?<local_part> (?&dot_atom) | (?"ed_string)) |
26 | (?<domain> (?&dot_atom) | (?&domain_literal)) |
27 | (?<domain_literal> (?&CFWS)? \[ (?: (?&FWS)? (?&dcontent))* (?&FWS)? |
28 | \] (?&CFWS)?) |
29 | (?<dcontent> (?&dtext) | (?"ed_pair)) |
30 | (?<dtext> (?&NO_WS_CTL) | [\x21-\x5a\x5e-\x7e]) |
31 | |
32 | (?<atext> (?&ALPHA) | (?&DIGIT) | [!#\$%&'*+-/=?^_`{|}~]) |
33 | (?<atom> (?&CFWS)? (?&atext)+ (?&CFWS)?) |
34 | (?<dot_atom> (?&CFWS)? (?&dot_atom_text) (?&CFWS)?) |
35 | (?<dot_atom_text> (?&atext)+ (?: \. (?&atext)+)*) |
36 | |
37 | (?<text> [\x01-\x09\x0b\x0c\x0e-\x7f]) |
38 | (?<quoted_pair> \\ (?&text)) |
39 | |
40 | (?<qtext> (?&NO_WS_CTL) | [\x21\x23-\x5b\x5d-\x7e]) |
41 | (?<qcontent> (?&qtext) | (?"ed_pair)) |
42 | (?<quoted_string> (?&CFWS)? (?&DQUOTE) (?:(?&FWS)? (?&qcontent))* |
43 | (?&FWS)? (?&DQUOTE) (?&CFWS)?) |
44 | |
45 | (?<word> (?&atom) | (?"ed_string)) |
46 | (?<phrase> (?&word)+) |
47 | |
48 | # Folding white space |
49 | (?<FWS> (?: (?&WSP)* (?&CRLF))? (?&WSP)+) |
50 | (?<ctext> (?&NO_WS_CTL) | [\x21-\x27\x2a-\x5b\x5d-\x7e]) |
51 | (?<ccontent> (?&ctext) | (?"ed_pair) | (?&comment)) |
52 | (?<comment> \( (?: (?&FWS)? (?&ccontent))* (?&FWS)? \) ) |
53 | (?<CFWS> (?: (?&FWS)? (?&comment))* |
54 | (?: (?:(?&FWS)? (?&comment)) | (?&FWS))) |
55 | |
56 | # No whitespace control |
57 | (?<NO_WS_CTL> [\x01-\x08\x0b\x0c\x0e-\x1f\x7f]) |
58 | |
59 | (?<ALPHA> [A-Za-z]) |
60 | (?<DIGIT> [0-9]) |
61 | (?<CRLF> \x0d \x0a) |
62 | (?<DQUOTE> ") |
63 | (?<WSP> [\x20\x09]) |
64 | ) |
65 | |
66 | (?&address) |
67 | }x; |
68 | |
e7707071 |
69 | |
e3faa678 |
70 | run_tests() unless caller; |
71 | |
72 | sub run_tests { |
73 | my $count = 0; |
74 | |
75 | $| = 1; |
a0e63aba |
76 | # rewinding DATA is necessary with PERLIO=stdio when this |
77 | # test is run from another thread |
78 | seek *DATA, 0, 0; |
79 | while (<DATA>) { last if /^__DATA__/ } |
e3faa678 |
80 | while (<DATA>) { |
81 | chomp; |
82 | next if /^#/; |
83 | print /^$email$/ ? "ok " : "not ok ", ++ $count, "\n"; |
84 | } |
e7707071 |
85 | } |
86 | |
87 | # |
88 | # Acme::MetaSyntactic ++ |
89 | # |
90 | __DATA__ |
91 | Jeff_Tracy@thunderbirds.org |
92 | "Lady Penelope"@thunderbirds.org |
93 | "The\ Hood"@thunderbirds.org |
94 | fred @ flintstones.net |
95 | barney (rubble) @ flintstones.org |
96 | bammbamm (bam! bam! (bam! bam! (bam!)) bam!) @ flintstones.org |
97 | Michelangelo@[127.0.0.1] |
98 | Donatello @ [127.0.0.1] |
99 | Raphael (He as well) @ [127.0.0.1] |
100 | "Leonardo" @ [127.0.0.1] |
101 | Barbapapa <barbapapa @ barbapapa.net> |
102 | "Barba Mama" <barbamama @ [127.0.0.1]> |
103 | Barbalala (lalalalalalalala) <barbalala (Yes, her!) @ (barba) barbapapa.net> |