1*0Sstevel@tonic-gate#!./perl 2*0Sstevel@tonic-gate 3*0Sstevel@tonic-gate# The tests are in a separate file 't/op/re_tests'. 4*0Sstevel@tonic-gate# Each line in that file is a separate test. 5*0Sstevel@tonic-gate# There are five columns, separated by tabs. 6*0Sstevel@tonic-gate# 7*0Sstevel@tonic-gate# Column 1 contains the pattern, optionally enclosed in C<''>. 8*0Sstevel@tonic-gate# Modifiers can be put after the closing C<'>. 9*0Sstevel@tonic-gate# 10*0Sstevel@tonic-gate# Column 2 contains the string to be matched. 11*0Sstevel@tonic-gate# 12*0Sstevel@tonic-gate# Column 3 contains the expected result: 13*0Sstevel@tonic-gate# y expect a match 14*0Sstevel@tonic-gate# n expect no match 15*0Sstevel@tonic-gate# c expect an error 16*0Sstevel@tonic-gate# B test exposes a known bug in Perl, should be skipped 17*0Sstevel@tonic-gate# b test exposes a known bug in Perl, should be skipped if noamp 18*0Sstevel@tonic-gate# 19*0Sstevel@tonic-gate# Columns 4 and 5 are used only if column 3 contains C<y> or C<c>. 20*0Sstevel@tonic-gate# 21*0Sstevel@tonic-gate# Column 4 contains a string, usually C<$&>. 22*0Sstevel@tonic-gate# 23*0Sstevel@tonic-gate# Column 5 contains the expected result of double-quote 24*0Sstevel@tonic-gate# interpolating that string after the match, or start of error message. 25*0Sstevel@tonic-gate# 26*0Sstevel@tonic-gate# Column 6, if present, contains a reason why the test is skipped. 27*0Sstevel@tonic-gate# This is printed with "skipped", for harness to pick up. 28*0Sstevel@tonic-gate# 29*0Sstevel@tonic-gate# \n in the tests are interpolated, as are variables of the form ${\w+}. 30*0Sstevel@tonic-gate# 31*0Sstevel@tonic-gate# If you want to add a regular expression test that can't be expressed 32*0Sstevel@tonic-gate# in this format, don't add it here: put it in op/pat.t instead. 33*0Sstevel@tonic-gate 34*0Sstevel@tonic-gateBEGIN { 35*0Sstevel@tonic-gate chdir 't' if -d 't'; 36*0Sstevel@tonic-gate @INC = '../lib'; 37*0Sstevel@tonic-gate} 38*0Sstevel@tonic-gate 39*0Sstevel@tonic-gate$iters = shift || 1; # Poor man performance suite, 10000 is OK. 40*0Sstevel@tonic-gate 41*0Sstevel@tonic-gateopen(TESTS,'op/re_tests') || open(TESTS,'t/op/re_tests') || open(TESTS,':op:re_tests') || 42*0Sstevel@tonic-gate die "Can't open re_tests"; 43*0Sstevel@tonic-gate 44*0Sstevel@tonic-gatewhile (<TESTS>) { } 45*0Sstevel@tonic-gate$numtests = $.; 46*0Sstevel@tonic-gateseek(TESTS,0,0); 47*0Sstevel@tonic-gate$. = 0; 48*0Sstevel@tonic-gate 49*0Sstevel@tonic-gate$bang = sprintf "\\%03o", ord "!"; # \41 would not be portable. 50*0Sstevel@tonic-gate$ffff = chr(0xff) x 2; 51*0Sstevel@tonic-gate$nulnul = "\0" x 2; 52*0Sstevel@tonic-gate 53*0Sstevel@tonic-gate$| = 1; 54*0Sstevel@tonic-gateprint "1..$numtests\n# $iters iterations\n"; 55*0Sstevel@tonic-gateTEST: 56*0Sstevel@tonic-gatewhile (<TESTS>) { 57*0Sstevel@tonic-gate chomp; 58*0Sstevel@tonic-gate s/\\n/\n/g; 59*0Sstevel@tonic-gate ($pat, $subject, $result, $repl, $expect, $reason) = split(/\t/,$_,6); 60*0Sstevel@tonic-gate $input = join(':',$pat,$subject,$result,$repl,$expect); 61*0Sstevel@tonic-gate infty_subst(\$pat); 62*0Sstevel@tonic-gate infty_subst(\$expect); 63*0Sstevel@tonic-gate $pat = "'$pat'" unless $pat =~ /^[:']/; 64*0Sstevel@tonic-gate $pat =~ s/(\$\{\w+\})/$1/eeg; 65*0Sstevel@tonic-gate $pat =~ s/\\n/\n/g; 66*0Sstevel@tonic-gate $subject =~ s/(\$\{\w+\})/$1/eeg; 67*0Sstevel@tonic-gate $subject =~ s/\\n/\n/g; 68*0Sstevel@tonic-gate $expect =~ s/(\$\{\w+\})/$1/eeg; 69*0Sstevel@tonic-gate $expect =~ s/\\n/\n/g; 70*0Sstevel@tonic-gate $expect = $repl = '-' if $skip_amp and $input =~ /\$[&\`\']/; 71*0Sstevel@tonic-gate $skip = ($skip_amp ? ($result =~ s/B//i) : ($result =~ s/B//)); 72*0Sstevel@tonic-gate $reason = 'skipping $&' if $reason eq '' && $skip_amp; 73*0Sstevel@tonic-gate $result =~ s/B//i unless $skip; 74*0Sstevel@tonic-gate for $study ('', 'study \$subject') { 75*0Sstevel@tonic-gate $c = $iters; 76*0Sstevel@tonic-gate eval "$study; \$match = (\$subject =~ m$pat) while \$c--; \$got = \"$repl\";"; 77*0Sstevel@tonic-gate chomp( $err = $@ ); 78*0Sstevel@tonic-gate if ($result eq 'c') { 79*0Sstevel@tonic-gate if ($err !~ m!^\Q$expect!) { print "not ok $. (compile) $input => `$err'\n"; next TEST } 80*0Sstevel@tonic-gate last; # no need to study a syntax error 81*0Sstevel@tonic-gate } 82*0Sstevel@tonic-gate elsif ( $skip ) { 83*0Sstevel@tonic-gate print "ok $. # skipped", length($reason) ? " $reason" : '', "\n"; 84*0Sstevel@tonic-gate next TEST; 85*0Sstevel@tonic-gate } 86*0Sstevel@tonic-gate elsif ($@) { 87*0Sstevel@tonic-gate print "not ok $. $input => error `$err'\n"; next TEST; 88*0Sstevel@tonic-gate } 89*0Sstevel@tonic-gate elsif ($result eq 'n') { 90*0Sstevel@tonic-gate if ($match) { print "not ok $. ($study) $input => false positive\n"; next TEST } 91*0Sstevel@tonic-gate } 92*0Sstevel@tonic-gate else { 93*0Sstevel@tonic-gate if (!$match || $got ne $expect) { 94*0Sstevel@tonic-gate print "not ok $. ($study) $input => `$got', match=$match\n"; 95*0Sstevel@tonic-gate next TEST; 96*0Sstevel@tonic-gate } 97*0Sstevel@tonic-gate } 98*0Sstevel@tonic-gate } 99*0Sstevel@tonic-gate print "ok $.\n"; 100*0Sstevel@tonic-gate} 101*0Sstevel@tonic-gate 102*0Sstevel@tonic-gateclose(TESTS); 103*0Sstevel@tonic-gate 104*0Sstevel@tonic-gatesub infty_subst # Special-case substitution 105*0Sstevel@tonic-gate{ # of $reg_infty and friends 106*0Sstevel@tonic-gate my $tp = shift; 107*0Sstevel@tonic-gate $$tp =~ s/,\$reg_infty_m}/,$reg_infty_m}/o; 108*0Sstevel@tonic-gate $$tp =~ s/,\$reg_infty_p}/,$reg_infty_p}/o; 109*0Sstevel@tonic-gate $$tp =~ s/,\$reg_infty}/,$reg_infty}/o; 110*0Sstevel@tonic-gate} 111