This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Merge branch 'core-team-data' into blead
[perl5.git] / t / re / reg_email.t
CommitLineData
c7056ede 1#!./perl -w
e7707071
YO
2#
3# Tests to make sure the regexp engine doesn't run into limits too soon.
4#
5
6BEGIN {
7 chdir 't' if -d 't';
c7056ede 8 require './test.pl';
624c42e2 9 set_up_inc('../lib');
e7707071
YO
10}
11
c7056ede 12use strict;
d23552d7 13no warnings 'experimental::regex_sets';
e7707071
YO
14
15my $email = qr {
16 (?(DEFINE)
17 (?<address> (?&mailbox) | (?&group))
18 (?<mailbox> (?&name_addr) | (?&addr_spec))
19 (?<name_addr> (?&display_name)? (?&angle_addr))
20 (?<angle_addr> (?&CFWS)? < (?&addr_spec) > (?&CFWS)?)
21 (?<group> (?&display_name) : (?:(?&mailbox_list) | (?&CFWS))? ;
22 (?&CFWS)?)
23 (?<display_name> (?&phrase))
24 (?<mailbox_list> (?&mailbox) (?: , (?&mailbox))*)
25
26 (?<addr_spec> (?&local_part) \@ (?&domain))
27 (?<local_part> (?&dot_atom) | (?&quoted_string))
28 (?<domain> (?&dot_atom) | (?&domain_literal))
29 (?<domain_literal> (?&CFWS)? \[ (?: (?&FWS)? (?&dcontent))* (?&FWS)?
30 \] (?&CFWS)?)
31 (?<dcontent> (?&dtext) | (?&quoted_pair))
d23552d7 32 (?<dtext> (?&NO_WS_CTL) | (?[ [:ascii:] & [:graph:] & [^][ \\ ] ]))
e7707071 33
e9cdc2f5 34 (?<atext> (?&ALPHA) | (?&DIGIT) | [-!#\$%&'*+/=?^_`{|}~])
e7707071
YO
35 (?<atom> (?&CFWS)? (?&atext)+ (?&CFWS)?)
36 (?<dot_atom> (?&CFWS)? (?&dot_atom_text) (?&CFWS)?)
37 (?<dot_atom_text> (?&atext)+ (?: \. (?&atext)+)*)
38
d23552d7 39 (?<text> (?[ [:ascii:] & [^ \000 \n \r ] ]))
e7707071
YO
40 (?<quoted_pair> \\ (?&text))
41
d23552d7 42 (?<qtext> (?&NO_WS_CTL) | (?[ [:ascii:] & [:graph:] & [^ " \\ ] ]))
e7707071
YO
43 (?<qcontent> (?&qtext) | (?&quoted_pair))
44 (?<quoted_string> (?&CFWS)? (?&DQUOTE) (?:(?&FWS)? (?&qcontent))*
45 (?&FWS)? (?&DQUOTE) (?&CFWS)?)
46
47 (?<word> (?&atom) | (?&quoted_string))
48 (?<phrase> (?&word)+)
49
50 # Folding white space
51 (?<FWS> (?: (?&WSP)* (?&CRLF))? (?&WSP)+)
d23552d7 52 (?<ctext> (?&NO_WS_CTL) | (?[ [:ascii:] & [:graph:] & [^ () ] & [^ \\ ] ]))
e7707071
YO
53 (?<ccontent> (?&ctext) | (?&quoted_pair) | (?&comment))
54 (?<comment> \( (?: (?&FWS)? (?&ccontent))* (?&FWS)? \) )
55 (?<CFWS> (?: (?&FWS)? (?&comment))*
56 (?: (?:(?&FWS)? (?&comment)) | (?&FWS)))
57
58 # No whitespace control
d23552d7 59 (?<NO_WS_CTL> (?[ [:ascii:] & [:cntrl:] & [^ \000 \h \r \n ] ]))
e7707071
YO
60
61 (?<ALPHA> [A-Za-z])
62 (?<DIGIT> [0-9])
d23552d7 63 (?<CRLF> \r \n)
e7707071 64 (?<DQUOTE> ")
d23552d7 65 (?<WSP> [ \t])
e7707071
YO
66 )
67
68 (?&address)
69}x;
70
e3faa678
NC
71run_tests() unless caller;
72
73sub run_tests {
a0e63aba
RGS
74 # rewinding DATA is necessary with PERLIO=stdio when this
75 # test is run from another thread
76 seek *DATA, 0, 0;
77 while (<DATA>) { last if /^__DATA__/ }
e3faa678
NC
78 while (<DATA>) {
79 chomp;
80 next if /^#/;
c7056ede 81 like($_, qr/^$email$/, $_);
e3faa678 82 }
c7056ede
NC
83
84 done_testing();
e7707071
YO
85}
86
c7056ede
NC
871; # Because reg_email_thr.t will (indirectly) require this script.
88
e7707071
YO
89#
90# Acme::MetaSyntactic ++
91#
92__DATA__
93Jeff_Tracy@thunderbirds.org
94"Lady Penelope"@thunderbirds.org
95"The\ Hood"@thunderbirds.org
96fred @ flintstones.net
97barney (rubble) @ flintstones.org
98bammbamm (bam! bam! (bam! bam! (bam!)) bam!) @ flintstones.org
99Michelangelo@[127.0.0.1]
100Donatello @ [127.0.0.1]
101Raphael (He as well) @ [127.0.0.1]
102"Leonardo" @ [127.0.0.1]
103Barbapapa <barbapapa @ barbapapa.net>
104"Barba Mama" <barbamama @ [127.0.0.1]>
105Barbalala (lalalalalalalala) <barbalala (Yes, her!) @ (barba) barbapapa.net>