1#!./perl -w
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';
8    require './test.pl';
9    set_up_inc('../lib');
10}
11
12use strict;
13no warnings 'experimental::regex_sets';
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))
32      (?<dtext>           (?&NO_WS_CTL) | (?[ [:ascii:] & [:graph:] & [^][ \\ ] ]))
33
34      (?<atext>           (?&ALPHA) | (?&DIGIT) | [-!#\$%&'*+/=?^_`{|}~])
35      (?<atom>            (?&CFWS)? (?&atext)+ (?&CFWS)?)
36      (?<dot_atom>        (?&CFWS)? (?&dot_atom_text) (?&CFWS)?)
37      (?<dot_atom_text>   (?&atext)+ (?: \. (?&atext)+)*)
38
39      (?<text>            (?[ [:ascii:] & [^ \000 \n \r ] ]))
40      (?<quoted_pair>     \\ (?&text))
41
42      (?<qtext>           (?&NO_WS_CTL) | (?[ [:ascii:] & [:graph:] & [^ " \\ ] ]))
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)+)
52      (?<ctext>           (?&NO_WS_CTL) | (?[ [:ascii:] & [:graph:] & [^ () ] & [^ \\ ] ]))
53      (?<ccontent>        (?&ctext) | (?&quoted_pair) | (?&comment))
54      (?<comment>         \( (?: (?&FWS)? (?&ccontent))* (?&FWS)? \) )
55      (?<CFWS>            (?: (?&FWS)? (?&comment))*
56                          (?: (?:(?&FWS)? (?&comment)) | (?&FWS)))
57
58      # No whitespace control
59      (?<NO_WS_CTL>       (?[ [:ascii:] & [:cntrl:] & [^ \000 \h \r \n ] ]))
60
61      (?<ALPHA>           [A-Za-z])
62      (?<DIGIT>           [0-9])
63      (?<CRLF>            \r \n)
64      (?<DQUOTE>          ")
65      (?<WSP>             [ \t])
66    )
67
68    (?&address)
69}x;
70
71run_tests() unless caller;
72
73sub run_tests {
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__/ }
78    while (<DATA>) {
79	chomp;
80	next if /^#/;
81	like($_, qr/^$email$/, $_);
82    }
83
84    done_testing();
85}
86
871; # Because reg_email_thr.t will (indirectly) require this script.
88
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>
106