This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
TODO tests for untimely destruction introduced by lvalue ops [RT#67838]
authorEric Brine <ikegami@adaelis.com>
Fri, 30 Jul 2010 16:43:29 +0000 (09:43 -0700)
committerRafael Garcia-Suarez <rgs@consttype.org>
Fri, 13 Aug 2010 11:36:29 +0000 (13:36 +0200)
t/op/hash.t
t/op/pos.t
t/op/vec.t
t/re/substr.t

index 9bde518..999ffc0 100644 (file)
@@ -8,7 +8,7 @@ BEGIN {
 
 use strict;
 
-plan tests => 6;
+plan tests => 7;
 
 my %h;
 
@@ -118,3 +118,18 @@ my $dummy = index 'foo', PVBM;
 eval { my %h = (a => PVBM); 1 };
 
 ok (!$@, 'fbm scalar can be inserted into a hash');
+
+
+my $destroyed;
+{ package Class; DESTROY { ++$destroyed; } }
+
+$destroyed = 0;
+{
+    my %h;
+    keys(%h) = 1;
+    $h{key} = bless({}, 'Class');
+}
+{
+    local our $TODO = "RT#67838";
+    is($destroyed, 1, 'Timely hash destruction with lvalue keys');
+}
index 04263e1..2d60417 100644 (file)
@@ -6,7 +6,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 7;
+plan tests => 8;
 
 $x='banana';
 $x=~/.a/g;
@@ -36,3 +36,17 @@ $x = "\x{100}BC";
 $x =~ m/.*/g;
 is(pos $x, 3);
 
+
+my $destroyed;
+{ package Class; DESTROY { ++$destroyed; } }
+
+$destroyed = 0;
+{
+    my $x = '';
+    pos($x) = 0;
+    $x = bless({}, 'Class');
+}
+{
+    local $TODO = "RT#67838";
+    is($destroyed, 1, 'Timely scalar destruction with lvalue pos');
+}
index aed1d0f..7fb3019 100644 (file)
@@ -6,7 +6,7 @@ BEGIN {
 }
 
 require "test.pl";
-plan( tests => 31 );
+plan( tests => 32 );
 
 my $Is_EBCDIC = (ord('A') == 193) ? 1 : 0;
 
@@ -95,3 +95,18 @@ is($foo, "\x61\x62\x63\x34\x65\x66");
     $r[$_] = \ vec $s, $_, 1 for (0, 1);
     ok(!(${ $r[0] } != 0 || ${ $r[1] } != 1)); 
 }
+
+
+my $destroyed;
+{ package Class; DESTROY { ++$destroyed; } }
+
+$destroyed = 0;
+{
+    my $x = '';
+    vec($x,0,1) = 0;
+    $x = bless({}, 'Class');
+}
+{
+    local $TODO = "RT#67838";
+    is($destroyed, 1, 'Timely scalar destruction with lvalue vec');
+}
index d0717ba..b136502 100644 (file)
@@ -24,7 +24,7 @@ $SIG{__WARN__} = sub {
 
 require './test.pl';
 
-plan(360);
+plan(361);
 
 run_tests() unless caller;
 
@@ -723,3 +723,18 @@ SKIP: {
 }
 
 }
+
+
+my $destroyed;
+{ package Class; DESTROY { ++$destroyed; } }
+
+$destroyed = 0;
+{
+    my $x = '';
+    substr($x,0,1) = "";
+    $x = bless({}, 'Class');
+}
+{
+    local $TODO = "RT#67838";
+    is($destroyed, 1, 'Timely scalar destruction with lvalue substr');
+}