[win32] fix for bugs in handling DESTROY (adjusted test numbers)

	Message-Id: <199801010030.TAA14274@aatma.engin.umich.edu>
	Subject: Re: [PERL] RFD: iterative DESTROYing of objects

p4raw-id: //depot/win32/perl@490

1 files changed, 42 insertions, 4 deletions

diff --git a/t/op/ref.t b/t/op/ref.t
index 56925177d1..1d70f9fd4c 100755
--- a/t/op/ref.t
+++ b/t/op/ref.t
@@ -1,6 +1,6 @@
 #!./perl
 
-print "1..52\n";
+print "1..55\n";
 
 # Test glob operations.
 
@@ -235,12 +235,50 @@ $var = "ok 49";
 $_   = \$var;
 print $$_,"\n";
 
+# test if reblessing during destruction results in more destruction
+
+{
+    package A;
+    sub new { bless {}, shift }
+    DESTROY { print "# destroying 'A'\nok 51\n" }
+    package B;
+    sub new { bless {}, shift }
+    DESTROY { print "# destroying 'B'\nok 50\n"; bless shift, 'A' }
+    package main;
+    my $b = B->new;
+}
+
+# test if $_[0] is properly protected in DESTROY()
+
+{
+    my $i = 0;
+    local $SIG{'__DIE__'} = sub {
+	my $m = shift;
+	if ($i++ > 4) {
+	    print "# infinite recursion, bailing\nnot ok 52\n";
+	    exit 1;
+        }
+	print "# $m";
+	if ($m =~ /^Modification of a read-only/) { print "ok 52\n" }
+    };
+    package C;
+    sub new { bless {}, shift }
+    DESTROY { $_[0] = 'foo' }
+    {
+	print "# should generate an error...\n";
+	my $c = C->new;
+    }
+    print "# good, didn't recurse\n";
+}
+
+# test global destruction
+
 package FINALE;
 
 {
-    $ref3 = bless ["ok 52\n"];		# package destruction
-    my $ref2 = bless ["ok 51\n"];	# lexical destruction
-    local $ref1 = bless ["ok 50\n"];	# dynamic destruction
+    $ref3 = bless ["ok 55\n"];		# package destruction
+    my $ref2 = bless ["ok 54\n"];	# lexical destruction
+    local $ref1 = bless ["ok 53\n"];	# dynamic destruction
     1;					# flush any temp values on stack
 }