Add a test that "eval" does not create additional reference to ouside variables.
[p5sagit/p5-mst-13.2.git] / t / op / ref.t
old mode 100755 (executable)
new mode 100644 (file)
index 9ef7b7a..aca94a3
@@ -7,8 +7,9 @@ BEGIN {
 
 require 'test.pl';
 use strict qw(refs subs);
+use re ();
 
-plan(189);
+plan(196);
 
 # Test glob operations.
 
@@ -124,6 +125,32 @@ $subrefref = \\&mysub2;
 is ($$subrefref->("GOOD"), "good");
 sub mysub2 { lc shift }
 
+# Test REGEXP assignment
+
+{
+    my $x = qr/x/;
+    my $str = "$x"; # regex stringification may change
+
+    my $y = $$x;
+    is ($y, $str, "bare REGEXP stringifies correctly");
+    ok (eval { "x" =~ $y }, "bare REGEXP matches correctly");
+    
+    my $z = \$y;
+    ok (re::is_regexp($z), "new ref to REXEXP passes is_regexp");
+    is ($z, $str, "new ref to REGEXP stringifies correctly");
+    ok (eval { "x" =~ $z }, "new ref to REGEXP matches correctly");
+}
+{
+    my ($x, $str);
+    {
+        my $y = qr/x/;
+        $str = "$y";
+        $x = $$y;
+    }
+    is ($x, $str, "REGEXP keeps a ref to its mother_re");
+    ok (eval { "x" =~ $x }, "REGEXP with mother_re still matches");
+}
+
 # Test the ref operator.
 
 sub PVBM () { 'foo' }
@@ -588,9 +615,10 @@ ok (!eval { $rpvbm->foo }, 'PVBM is not an object');
 is( runperl(stderr => 1, prog => 'map eval qq(exit),1 for 1'), "");
 is( runperl(stderr => 1, prog => 'eval { for (1) { map { die } 2 } };'), "");
 is( runperl(stderr => 1, prog => 'for (125) { map { exit } (213)}'), "");
-is( runperl(stderr => 1, prog => 'map die,4 for 3'), "Died at -e line 1.\n");
-is( runperl(stderr => 1, prog => 'grep die,4 for 3'), "Died at -e line 1.\n");
-is( runperl(stderr => 1, prog => 'for $a (3) {@b=sort {die} 4,5}'), "Died at -e line 1.\n");
+my $hushed = $^O eq 'VMS' ? 'use vmsish qw(hushed);' : '';
+is( runperl(stderr => 1, prog => $hushed . 'map die,4 for 3'), "Died at -e line 1.\n");
+is( runperl(stderr => 1, prog => $hushed . 'grep die,4 for 3'), "Died at -e line 1.\n");
+is( runperl(stderr => 1, prog => $hushed . 'for $a (3) {@b=sort {die} 4,5}'), "Died at -e line 1.\n");
 
 # bug 57564
 is( runperl(stderr => 1, prog => 'my $i;for $i (1) { for $i (2) { } }'), "");