Remove all magic in untie()

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

diff --git a/t/op/tie.t b/t/op/tie.t
index 309656d..dfbf44b 100755 (executable)
--- a/t/op/tie.t
+++ b/t/op/tie.t
@@ -27,6 +27,7 @@ for (@prgs){
         unless defined $expected;
     my ($testname) = $prog =~ /^# (.*)\n/m;
     $testname ||= '';
+    $TODO = $testname =~ s/^TODO //;
     $results =~ s/\n+$//;
     $expected =~ s/\n+$//;
 
@@ -135,7 +136,7 @@ untie %h;
 EXPECT
 ########
 
-# strict error behaviour, with 2 extra references 
+# strict error behaviour, with 2 extra references
 use warnings 'untie';
 use Tie::Hash ;
 $a = tie %h, Tie::StdHash;
@@ -178,20 +179,24 @@ sub Self::DESTROY   { $destroyed = 1; }
     my $c = 42;
     tie $c, 'Self', \$c;
 }
-die "self-tied scalar not DESTROYd" unless $destroyed == 1;
+die "self-tied scalar not DESTROYed" unless $destroyed == 1;
 EXPECT
 ########
 
 # Allowed glob self-ties
 my $destroyed = 0;
+my $printed   = 0;
 sub Self2::TIEHANDLE { bless $_[1], $_[0] }
 sub Self2::DESTROY   { $destroyed = 1; }
+sub Self2::PRINT     { $printed = 1; }
 {
     use Symbol;
     my $c = gensym;
     tie *$c, 'Self2', $c;
+    print $c 'Hello';
 }
-die "self-tied glob not DESTROYd" unless $destroyed == 1;
+die "self-tied glob not PRINTed" unless $printed == 1;
+die "self-tied glob not DESTROYed" unless $destroyed == 1;
 EXPECT
 ########
 
@@ -199,12 +204,31 @@ EXPECT
 my $destroyed = 0;
 sub Self3::TIEHANDLE { bless $_[1], $_[0] }
 sub Self3::DESTROY   { $destroyed = 1; }
+sub Self3::PRINT     { $printed = 1; }
 {
     use Symbol 'geniosym';
     my $c = geniosym;
     tie *$c, 'Self3', $c;
+    print $c 'Hello';
 }
-die "self-tied IO not DESTROYd" unless $destroyed == 1;
+die "self-tied IO not PRINTed" unless $printed == 1;
+die "self-tied IO not DESTROYed" unless $destroyed == 1;
+EXPECT
+########
+
+# TODO IO "self-tie" via TEMP glob
+my $destroyed = 0;
+sub Self3::TIEHANDLE { bless $_[1], $_[0] }
+sub Self3::DESTROY   { $destroyed = 1; }
+sub Self3::PRINT     { $printed = 1; }
+{
+    use Symbol 'geniosym';
+    my $c = geniosym;
+    tie *$c, 'Self3', \*$c;
+    print $c 'Hello';
+}
+die "IO tied to TEMP glob not PRINTed" unless $printed == 1;
+die "IO tied to TEMP glob not DESTROYed" unless $destroyed == 1;
 EXPECT
 ########
 
@@ -235,3 +259,87 @@ tie FH, 'main';
 EXPECT
 Can't modify constant item in tie at - line 3, near "'main';"
 Execution of - aborted due to compilation errors.
+########
+
+# localizing tied hash slices
+$ENV{FooA} = 1;
+$ENV{FooB} = 2;
+print exists $ENV{FooA} ? 1 : 0, "\n";
+print exists $ENV{FooB} ? 2 : 0, "\n";
+print exists $ENV{FooC} ? 3 : 0, "\n";
+{
+    local @ENV{qw(FooA FooC)};
+    print exists $ENV{FooA} ? 4 : 0, "\n";
+    print exists $ENV{FooB} ? 5 : 0, "\n";
+    print exists $ENV{FooC} ? 6 : 0, "\n";
+}
+print exists $ENV{FooA} ? 7 : 0, "\n";
+print exists $ENV{FooB} ? 8 : 0, "\n";
+print exists $ENV{FooC} ? 9 : 0, "\n"; # this should not exist
+EXPECT
+1
+2
+0
+4
+5
+6
+7
+8
+0
+########
+#
+# FETCH freeing tie'd SV
+sub TIESCALAR { bless [] }
+sub FETCH { *a = \1; 1 }
+tie $a, 'main';
+print $a;
+EXPECT
+Tied variable freed while still in use at - line 6.
+########
+
+#  [20020716.007] - nested FETCHES
+
+sub F1::TIEARRAY { bless [], 'F1' }
+sub F1::FETCH { 1 }
+my @f1;
+tie @f1, 'F1';
+
+sub F2::TIEARRAY { bless [2], 'F2' }
+sub F2::FETCH { my $self = shift; my $x = $f1[3]; $self }
+my @f2;
+tie @f2, 'F2';
+
+print $f2[4][0],"\n";
+
+sub F3::TIEHASH { bless [], 'F3' }
+sub F3::FETCH { 1 }
+my %f3;
+tie %f3, 'F3';
+
+sub F4::TIEHASH { bless [3], 'F4' }
+sub F4::FETCH { my $self = shift; my $x = $f3{3}; $self }
+my %f4;
+tie %f4, 'F4';
+
+print $f4{'foo'}[0],"\n";
+
+EXPECT
+2
+3
+########
+# test untie() from within FETCH
+package Foo;
+sub TIESCALAR { my $pkg = shift; return bless [@_], $pkg; }
+sub FETCH {
+  my $self = shift;
+  my ($obj, $field) = @$self;
+  untie $obj->{$field};
+  $obj->{$field} = "Bar";
+}
+package main;
+tie $a->{foo}, "Foo", $a, "foo";
+$a->{foo}; # access once
+# the hash element should not be tied anymore
+print defined tied $a->{foo} ? "not ok" : "ok";
+EXPECT
+ok