make failed matches return empty list in list context

[p5sagit/p5-mst-13.2.git] / t / op / pat.t

diff --git a/t/op/pat.t b/t/op/pat.t
index 90623fb..ef014f2 100755 (executable)
--- a/t/op/pat.t
+++ b/t/op/pat.t
@@ -4,9 +4,7 @@
 # the format supported by op/regexp.t.  If you want to add a test
 # that does fit that format, add it to op/re_tests, not here.
 
-# $RCSfile: pat.t,v $$Revision: 4.1 $$Date: 92/08/07 18:28:12 $
-
-print "1..130\n";
+print "1..139\n";
 
 BEGIN {
     chdir 't' if -d 't';
@@ -14,6 +12,8 @@ BEGIN {
 }
 eval 'use Config';          #  Defaults assumed if this fails
 
+$ENV{PERL_DESTRUCT_LEVEL} = 0; # XXX known to leaks scalars
+
 $x = "abc\ndef\n";
 
 if ($x =~ /^abc/) {print "ok 1\n";} else {print "not ok 1\n";}
@@ -450,8 +450,27 @@ print "not " unless $^R eq '79' and $x eq '12';
 print "ok $test\n";
 $test++;
 
-# This should be changed to qr/\b\v$/ ASAP
-print "not " unless study(/\b\v$/) eq '(?:\bv$)';
+print "not " unless qr/\b\v$/i eq '(?i-xsm:\bv$)';
+print "ok $test\n";
+$test++;
+
+print "not " unless qr/\b\v$/s eq '(?s-xim:\bv$)';
+print "ok $test\n";
+$test++;
+
+print "not " unless qr/\b\v$/m eq '(?m-xis:\bv$)';
+print "ok $test\n";
+$test++;
+
+print "not " unless qr/\b\v$/x eq '(?x-ism:\bv$)';
+print "ok $test\n";
+$test++;
+
+print "not " unless qr/\b\v$/xism eq '(?msix:\bv$)';
+print "ok $test\n";
+$test++;
+
+print "not " unless qr/\b\v$/ eq '(?-xism:\bv$)';
 print "ok $test\n";
 $test++;
 
@@ -487,7 +506,7 @@ print "not " unless $1 and /$1/;
 print "ok $test\n";
 $test++;
 
-$a=study/(?{++$b})/; 
+$a=qr/(?{++$b})/; 
 $b = 7;
 /$a$a/; 
 print "not " unless $b eq '9'; 
@@ -539,3 +558,26 @@ my $for_future = make_must_warn('reserved for future extensions');
 &$for_future('q(a:[b]:) =~ /[x[:foo:]]/');
 &$for_future('q(a=[b]=) =~ /[x[=foo=]]/');
 &$for_future('q(a.[b].) =~ /[x[.foo.]]/');
+
+# test if failure of patterns returns empty list
+$_ = 'aaa';
+@_ = /bbb/;
+print "not " if @_;
+print "ok $test\n";
+$test++;
+
+@_ = /bbb/g;
+print "not " if @_;
+print "ok $test\n";
+$test++;
+
+@_ = /(bbb)/;
+print "not " if @_;
+print "ok $test\n";
+$test++;
+
+@_ = /(bbb)/g;
+print "not " if @_;
+print "ok $test\n";
+$test++;
+