Commit | Line | Data |
---|---|---|
e7707071 YO |
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 NC |
70 | run_tests() unless caller; |
71 | ||
72 | sub run_tests { | |
73 | my $count = 0; | |
74 | ||
75 | $| = 1; | |
a0e63aba RGS |
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 NC |
80 | while (<DATA>) { |
81 | chomp; | |
82 | next if /^#/; | |
83 | print /^$email$/ ? "ok " : "not ok ", ++ $count, "\n"; | |
84 | } | |
e7707071 YO |
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> |