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 46d2b91..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..135\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";}
@@ -558,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++;
+