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) | (?"ed_string)) 28 (?<domain> (?&dot_atom) | (?&domain_literal)) 29 (?<domain_literal> (?&CFWS)? \[ (?: (?&FWS)? (?&dcontent))* (?&FWS)? 30 \] (?&CFWS)?) 31 (?<dcontent> (?&dtext) | (?"ed_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) | (?"ed_pair)) 44 (?<quoted_string> (?&CFWS)? (?&DQUOTE) (?:(?&FWS)? (?&qcontent))* 45 (?&FWS)? (?&DQUOTE) (?&CFWS)?) 46 47 (?<word> (?&atom) | (?"ed_string)) 48 (?<phrase> (?&word)+) 49 50 # Folding white space 51 (?<FWS> (?: (?&WSP)* (?&CRLF))? (?&WSP)+) 52 (?<ctext> (?&NO_WS_CTL) | (?[ [:ascii:] & [:graph:] & [^ () ] & [^ \\ ] ])) 53 (?<ccontent> (?&ctext) | (?"ed_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