Integrate mainline

p4raw-id: //depot/perlio@15713

12 files changed, 563 insertions, 15 deletions

diff --git a/MANIFEST b/MANIFEST
index 8598a847fa..add706fa6e 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1457,6 +1457,7 @@ lib/Tie/File/t/31_autodefer.t   Test for Tie::File
 lib/Tie/File/t/32_defer_misc.t  Test for Tie::File
 lib/Tie/File/t/33_defer_vs.t	Test for Tie::File
 lib/Tie/File/t/40_abs_cache.t	Test for Tie::File
+lib/Tie/File/t/41_heap.t	Test for Tie::File
 lib/Tie/Handle.pm		Base class for tied handles
 lib/Tie/Handle/stdhandle.t	Test for Tie::StdHandle
 lib/Tie/Hash.pm			Base class for tied hashes
diff --git a/ext/threads/threads.pm b/ext/threads/threads.pm
index a925898d6f..d8e8b5a77e 100755
--- a/ext/threads/threads.pm
+++ b/ext/threads/threads.pm
@@ -128,6 +128,17 @@ quick way to get current thread id.
 
 =back
 
+=head1 WARNINGS
+
+=over 4
+
+=item Cleanup skipped %d active threads
+
+The main thread exited while there were still other threads running.
+This is not a good sign: you should either explicitly join the threads,
+or somehow be certain that all the non-main threads have finished.
+
+=back
 
 =head1 TODO
 
diff --git a/lib/ExtUtils/MM_Win95.pm b/lib/ExtUtils/MM_Win95.pm
index af53336f37..aaabc132bc 100644
--- a/lib/ExtUtils/MM_Win95.pm
+++ b/lib/ExtUtils/MM_Win95.pm
@@ -40,3 +40,5 @@ sub xs_o {
 	$(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.c
 	';
 }
+
+1;
diff --git a/lib/File/Compare.pm b/lib/File/Compare.pm
index eba17c3253..0b73d7c765 100644
--- a/lib/File/Compare.pm
+++ b/lib/File/Compare.pm
@@ -166,8 +166,8 @@ is basically equivalent to
 
 =head1 RETURN
 
-File::Compare::compare return 0 if the files are equal, 1 if the
-files are unequal, or -1 if an error was encountered.
+File::Compare::compare and its sibling functions return 0 if the files
+are equal, 1 if the files are unequal, or -1 if an error was encountered.
 
 =head1 AUTHOR
 
diff --git a/lib/Tie/File/t/41_heap.t b/lib/Tie/File/t/41_heap.t
new file mode 100644
index 0000000000..efd34caeac
--- /dev/null
+++ b/lib/Tie/File/t/41_heap.t
@@ -0,0 +1,514 @@
+#!/usr/bin/perl
+#
+# Unit tests for heap implementation
+#
+# Test the following methods:
+# new
+# is_empty
+# empty
+# insert
+# remove
+# popheap
+# promote
+# lookup
+# set_val
+# rekey
+# expire_order
+
+
+# Finish these later.
+# They're nonurgent because the important heap stuff is extensively tested by 
+# test 19, 20, 24, 30, 32, 33, and 40, as well as pretty much everything else.
+print "1..0\n"; exit;
+
+__END__
+print "1..19\n";
+
+
+my ($N, @R, $Q, $ar) = (1);
+
+use Tie::File;
+print "ok $N\n";
+$N++;
+
+my @HEAP_MOVE;
+sub Fake::Cache::_heap_move { push @HEAP_MOVE, @_ }
+
+my $h = Tie::File::Heap->new(bless [] => 'Fake::Cache');
+print "ok $N\n";
+$N++;
+
+# (3) Are all the methods there?
+{
+  my $good = 1;
+  for my $meth (qw(new is_empty empty lookup insert remove popheap
+                   promote set_val rekey expire_order)) {
+    unless ($h->can($meth)) {
+      print STDERR "# Method '$meth' is missing.\n";
+      $good = 0;
+    }
+  }
+  print $good ? "ok $N\n" : "not ok $N\n";
+  $N++;
+}
+
+# (4) Straight insert and removal FIFO test
+$ar = 'a0';
+for (1..10) {
+  $h->insert($_, $ar++);
+}
+for (1..10) {
+  push @R, $h->popheap;
+}
+$iota = iota('a',9);
+print "@R" eq $iota
+  ? "ok $N\n" : "not ok $N \# expected ($iota), got (@R)\n";
+$N++;
+
+# (5) Remove from empty heap
+$n = $h->popheap;
+print ! defined $n ? "ok $N\n" : "not ok $N \# expected UNDEF, got $n";
+$N++;
+
+# (6) Interleaved insert and removal
+$Q = 0;
+@R = ();
+for my $i (1..4) {
+  for my $j (1..$i) {
+    $h->insert($Q, "b$Q");
+    $Q++;
+  }
+  for my $j (1..$i) {
+    push @R, $h->popheap;
+  }
+}
+$iota = iota('b', 9);
+print "@R" eq $iota ? "ok $N\n" : "not ok $N \# expected ($iota), got (@R)\n";
+$N++;
+
+# (7) It should be empty now
+print $h->is_empty ? "ok $N\n" : "not ok $N\n";
+$N++;
+
+# (8) Insert and delete
+$Q = 1;
+for (1..10) {
+  $h->insert($_, "c$Q");
+  $Q++;
+}
+for (2, 4, 6, 8, 10) {
+  $h->remove($_);
+}
+@R = ();
+push @R, $n while defined ($n = $h->popheap);
+print "@R" eq "c1 c3 c5 c7 c9" ? 
+  "ok $N\n" : "not ok $N \# expected (c1 c3 c5 c7 c9), got (@R)\n";
+$N++;
+
+# (9) Interleaved insert and delete
+$Q = 1; my $QQ = 1;
+@R = ();
+for my $i (1..4) {
+  for my $j (1..$i) {
+    $h->insert($Q, "d$Q");
+    $Q++;
+  }
+  for my $j (1..$i) {
+    $h->remove($QQ) if $QQ % 2 == 0;
+    $QQ++;
+  }
+}
+push @R, $n while defined ($n = $h->popheap);
+print "@R" eq "d1 d3 d5 d7 d9" ? 
+  "ok $N\n" : "not ok $N \# expected (d1 d3 d5 d7 d9), got (@R)\n";
+$N++;
+
+# (10) Promote
+$Q = 1;
+for (1..10) {
+  $h->insert($_, "e$Q");
+  $Q++;
+}
+for (2, 4, 6, 8, 10) {
+  $h->promote($_);
+}
+@R = ();
+push @R, $n while defined ($n = $h->popheap);
+print "@R" eq "e1 e3 e5 e7 e9 e2 e4 e6 e8 e10" ? 
+  "ok $N\n" : 
+  "not ok $N \# expected (e1 e3 e5 e7 e9 e2 e4 e6 e8 e10), got (@R)\n";
+$N++;
+
+# (11-15) Lookup
+$Q = 1;
+for (1..10) {
+  $h->insert($_, "f$Q");
+  $Q++;
+}
+for (2, 4, 6, 4, 8) {
+  my $r = $h->lookup($_);
+  print $r eq "f$_" ? "ok $N\n" : "not ok $N \# expected f$_, got $r\n";
+  $N++;
+}
+
+# (16) It shouldn't be empty
+print ! $h->is_empty ? "ok $N\n" : "not ok $N\n";
+$N++;
+
+# (17) Lookup should have promoted the looked-up records
+@R = ();
+push @R, $n while defined ($n = $h->popheap);
+print "@R" eq "f1 f3 f5 f7 f9 f10 f2 f6 f4 f8" ?
+  "ok $N\n" : 
+  "not ok $N \# expected (f1 f3 f5 f7 f9 f10 f2 f6 f4 f8), got (@R)\n";
+$N++;
+
+# (18-19) Typical 'rekey' operation
+$Q = 1;
+for (1..10) {
+  $h->insert($_, "g$Q");
+  $Q++;
+}
+
+$h->rekey([6,7,8,9,10], [8,9,10,11,12]);
+my %x = qw(1 g1 2 g2  3 g3  4 g4  5 g5
+           8 g6 9 g7 10 g8 11 g9 12 g10);
+{
+  my $good = 1;
+  for my $k (keys %x) {
+    my $v = $h->lookup($k);
+    $v = "UNDEF" unless defined $v;
+    unless ($v eq $x{$k}) {
+      print "# looked up $k, got $v, expected $x{$k}\n";
+      $good = 0;
+    }
+  }
+  print $good ? "ok $N\n" : "not ok $N\n";
+  $N++;
+}
+{
+  my $good = 1;
+  for my $k (6, 7) {
+    my $v = $h->lookup($k);
+    if (defined $v) {
+      print "# looked up $k, got $v, should have been undef\n";
+      $good = 0;
+    }
+  }
+  print $good ? "ok $N\n" : "not ok $N\n";
+  $N++;
+}
+
+# (20) keys
+@R = sort { $a <=> $b } $h->keys;
+print "@R" eq "1 2 3 4 5 8 9 10 11 12" ?
+  "ok $N\n" : 
+  "not ok $N \# expected (1 2 3 4 5 8 9 10 11 12) got (@R)\n";
+$N++;
+
+# (21) update
+for (1..5, 8..12) {
+  $h->update($_, "h$_");
+}
+@R = ();
+for (sort { $a <=> $b } $h->keys) {
+  push @R, $h->lookup($_);
+}
+print "@R" eq "h1 h2 h3 h4 h5 h8 h9 h10 h11 h12" ?
+  "ok $N\n" : 
+  "not ok $N \# expected (h1 h2 h3 h4 h5 h8 h9 h10 h11 h12) got (@R)\n";
+$N++;
+
+# (22-23) bytes
+my $B;
+$B = $h->bytes;
+print $B == 23 ? "ok $N\n" : "not ok $N \# expected 23, got $B\n";
+$N++;
+$h->update('12', "yobgorgle");
+$B = $h->bytes;
+print $B == 29 ? "ok $N\n" : "not ok $N \# expected 29, got $B\n";
+$N++;
+
+# (24-25) empty
+$h->empty;
+print $h->is_empty ? "ok $N\n" : "not ok $N\n";
+$N++;
+$n = $h->popheap;
+print ! defined $n ? "ok $N\n" : "not ok $N \# expected UNDEF, got $n";
+$N++;
+
+# (26) very weak testing of DESTROY
+undef $h;
+# are we still alive?
+print "ok $N\n";
+$N++;
+
+
+sub iota {
+  my ($p, $n) = @_;
+  my $r;
+  my $i = 0;
+  while ($i <= $n) {
+    $r .= "$p$i ";
+    $i++;
+  }
+  chop $r;
+  $r;
+}
+#!/usr/bin/perl
+#
+# Unit tests for heap implementation
+#
+# Test the following methods:
+# new
+# is_empty
+# empty
+# insert
+# remove
+# popheap
+# promote
+# lookup
+# set_val
+# rekey
+# expire_order
+
+
+# Finish these later.
+# They're nonurgent because the important heap stuff is extensively tested by 
+# test 19, 20, 24, 30, 32, 33, and 40, as well as pretty much everything else.
+print "1..0\n"; exit;
+
+__END__
+print "1..19\n";
+
+
+my ($N, @R, $Q, $ar) = (1);
+
+use Tie::File;
+print "ok $N\n";
+$N++;
+
+my @HEAP_MOVE;
+sub Fake::Cache::_heap_move { push @HEAP_MOVE, @_ }
+
+my $h = Tie::File::Heap->new(bless [] => 'Fake::Cache');
+print "ok $N\n";
+$N++;
+
+# (3) Are all the methods there?
+{
+  my $good = 1;
+  for my $meth (qw(new is_empty empty lookup insert remove popheap
+                   promote set_val rekey expire_order)) {
+    unless ($h->can($meth)) {
+      print STDERR "# Method '$meth' is missing.\n";
+      $good = 0;
+    }
+  }
+  print $good ? "ok $N\n" : "not ok $N\n";
+  $N++;
+}
+
+# (4) Straight insert and removal FIFO test
+$ar = 'a0';
+for (1..10) {
+  $h->insert($_, $ar++);
+}
+for (1..10) {
+  push @R, $h->popheap;
+}
+$iota = iota('a',9);
+print "@R" eq $iota
+  ? "ok $N\n" : "not ok $N \# expected ($iota), got (@R)\n";
+$N++;
+
+# (5) Remove from empty heap
+$n = $h->popheap;
+print ! defined $n ? "ok $N\n" : "not ok $N \# expected UNDEF, got $n";
+$N++;
+
+# (6) Interleaved insert and removal
+$Q = 0;
+@R = ();
+for my $i (1..4) {
+  for my $j (1..$i) {
+    $h->insert($Q, "b$Q");
+    $Q++;
+  }
+  for my $j (1..$i) {
+    push @R, $h->popheap;
+  }
+}
+$iota = iota('b', 9);
+print "@R" eq $iota ? "ok $N\n" : "not ok $N \# expected ($iota), got (@R)\n";
+$N++;
+
+# (7) It should be empty now
+print $h->is_empty ? "ok $N\n" : "not ok $N\n";
+$N++;
+
+# (8) Insert and delete
+$Q = 1;
+for (1..10) {
+  $h->insert($_, "c$Q");
+  $Q++;
+}
+for (2, 4, 6, 8, 10) {
+  $h->remove($_);
+}
+@R = ();
+push @R, $n while defined ($n = $h->popheap);
+print "@R" eq "c1 c3 c5 c7 c9" ? 
+  "ok $N\n" : "not ok $N \# expected (c1 c3 c5 c7 c9), got (@R)\n";
+$N++;
+
+# (9) Interleaved insert and delete
+$Q = 1; my $QQ = 1;
+@R = ();
+for my $i (1..4) {
+  for my $j (1..$i) {
+    $h->insert($Q, "d$Q");
+    $Q++;
+  }
+  for my $j (1..$i) {
+    $h->remove($QQ) if $QQ % 2 == 0;
+    $QQ++;
+  }
+}
+push @R, $n while defined ($n = $h->popheap);
+print "@R" eq "d1 d3 d5 d7 d9" ? 
+  "ok $N\n" : "not ok $N \# expected (d1 d3 d5 d7 d9), got (@R)\n";
+$N++;
+
+# (10) Promote
+$Q = 1;
+for (1..10) {
+  $h->insert($_, "e$Q");
+  $Q++;
+}
+for (2, 4, 6, 8, 10) {
+  $h->promote($_);
+}
+@R = ();
+push @R, $n while defined ($n = $h->popheap);
+print "@R" eq "e1 e3 e5 e7 e9 e2 e4 e6 e8 e10" ? 
+  "ok $N\n" : 
+  "not ok $N \# expected (e1 e3 e5 e7 e9 e2 e4 e6 e8 e10), got (@R)\n";
+$N++;
+
+# (11-15) Lookup
+$Q = 1;
+for (1..10) {
+  $h->insert($_, "f$Q");
+  $Q++;
+}
+for (2, 4, 6, 4, 8) {
+  my $r = $h->lookup($_);
+  print $r eq "f$_" ? "ok $N\n" : "not ok $N \# expected f$_, got $r\n";
+  $N++;
+}
+
+# (16) It shouldn't be empty
+print ! $h->is_empty ? "ok $N\n" : "not ok $N\n";
+$N++;
+
+# (17) Lookup should have promoted the looked-up records
+@R = ();
+push @R, $n while defined ($n = $h->popheap);
+print "@R" eq "f1 f3 f5 f7 f9 f10 f2 f6 f4 f8" ?
+  "ok $N\n" : 
+  "not ok $N \# expected (f1 f3 f5 f7 f9 f10 f2 f6 f4 f8), got (@R)\n";
+$N++;
+
+# (18-19) Typical 'rekey' operation
+$Q = 1;
+for (1..10) {
+  $h->insert($_, "g$Q");
+  $Q++;
+}
+
+$h->rekey([6,7,8,9,10], [8,9,10,11,12]);
+my %x = qw(1 g1 2 g2  3 g3  4 g4  5 g5
+           8 g6 9 g7 10 g8 11 g9 12 g10);
+{
+  my $good = 1;
+  for my $k (keys %x) {
+    my $v = $h->lookup($k);
+    $v = "UNDEF" unless defined $v;
+    unless ($v eq $x{$k}) {
+      print "# looked up $k, got $v, expected $x{$k}\n";
+      $good = 0;
+    }
+  }
+  print $good ? "ok $N\n" : "not ok $N\n";
+  $N++;
+}
+{
+  my $good = 1;
+  for my $k (6, 7) {
+    my $v = $h->lookup($k);
+    if (defined $v) {
+      print "# looked up $k, got $v, should have been undef\n";
+      $good = 0;
+    }
+  }
+  print $good ? "ok $N\n" : "not ok $N\n";
+  $N++;
+}
+
+# (20) keys
+@R = sort { $a <=> $b } $h->keys;
+print "@R" eq "1 2 3 4 5 8 9 10 11 12" ?
+  "ok $N\n" : 
+  "not ok $N \# expected (1 2 3 4 5 8 9 10 11 12) got (@R)\n";
+$N++;
+
+# (21) update
+for (1..5, 8..12) {
+  $h->update($_, "h$_");
+}
+@R = ();
+for (sort { $a <=> $b } $h->keys) {
+  push @R, $h->lookup($_);
+}
+print "@R" eq "h1 h2 h3 h4 h5 h8 h9 h10 h11 h12" ?
+  "ok $N\n" : 
+  "not ok $N \# expected (h1 h2 h3 h4 h5 h8 h9 h10 h11 h12) got (@R)\n";
+$N++;
+
+# (22-23) bytes
+my $B;
+$B = $h->bytes;
+print $B == 23 ? "ok $N\n" : "not ok $N \# expected 23, got $B\n";
+$N++;
+$h->update('12', "yobgorgle");
+$B = $h->bytes;
+print $B == 29 ? "ok $N\n" : "not ok $N \# expected 29, got $B\n";
+$N++;
+
+# (24-25) empty
+$h->empty;
+print $h->is_empty ? "ok $N\n" : "not ok $N\n";
+$N++;
+$n = $h->popheap;
+print ! defined $n ? "ok $N\n" : "not ok $N \# expected UNDEF, got $n";
+$N++;
+
+# (26) very weak testing of DESTROY
+undef $h;
+# are we still alive?
+print "ok $N\n";
+$N++;
+
+
+sub iota {
+  my ($p, $n) = @_;
+  my $r;
+  my $i = 0;
+  while ($i <= $n) {
+    $r .= "$p$i ";
+    $i++;
+  }
+  chop $r;
+  $r;
+}
diff --git a/perl.c b/perl.c
index bc69454090..1a5ec5c5b5 100644
--- a/perl.c
+++ b/perl.c
@@ -303,7 +303,7 @@ no threads.
 */
 
 int
-Perl_nothreadhook(pTHXx)
+Perl_nothreadhook(pTHX)
 {
     return 0;
 }
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index 08f342aee1..6bcd87a46e 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -1125,6 +1125,13 @@ and so on) and not for Unicode characters, so Perl behaved as if you meant
 If you actually want to pack Unicode codepoints, use the C<"U"> format
 instead.
 
+=item Cleanup skipped %d active threads
+
+(W) When using threaded Perl, the main thread exited while there were
+still other threads running.  This is not a good sign: you should
+either explicitly join the threads, or somehow be certain that all
+the non-main threads have finished.  See L<threads>.
+
 =item close() on unopened filehandle %s
 
 (W unopened) You tried to close a filehandle that was never opened.
diff --git a/pp_ctl.c b/pp_ctl.c
index 11b36134ff..886dd8c3fb 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2535,6 +2535,7 @@ S_docatch(pTHX_ OP *o)
 {
     int ret;
     OP *oldop = PL_op;
+    OP *retop;
     volatile PERL_SI *cursi = PL_curstackinfo;
     dJMPENV;
 
@@ -2542,6 +2543,15 @@ S_docatch(pTHX_ OP *o)
     assert(CATCH_GET == TRUE);
 #endif
     PL_op = o;
+
+    /* Normally, the leavetry at the end of this block of ops will
+     * pop an op off the return stack and continue there. By setting
+     * the op to Nullop, we force an exit from the inner runops()
+     * loop. DAPM.
+     */
+    retop = pop_return();
+    push_return(Nullop);
+
 #ifdef PERL_FLEXIBLE_EXCEPTIONS
  redo_body:
     CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_docatch_body));
@@ -2556,11 +2566,15 @@ S_docatch(pTHX_ OP *o)
 #endif
 	break;
     case 3:
+	/* die caught by an inner eval - continue inner loop */
 	if (PL_restartop && cursi == PL_curstackinfo) {
 	    PL_op = PL_restartop;
 	    PL_restartop = 0;
 	    goto redo_body;
 	}
+	/* a die in this eval - continue in outer loop */
+	if (!PL_restartop)
+	    break;
 	/* FALL THROUGH */
     default:
 	JMPENV_POP;
@@ -2570,7 +2584,7 @@ S_docatch(pTHX_ OP *o)
     }
     JMPENV_POP;
     PL_op = oldop;
-    return Nullop;
+    return retop;
 }
 
 OP *
@@ -3414,13 +3428,14 @@ PP(pp_leavetry)
     register SV **mark;
     SV **newsp;
     PMOP *newpm;
+    OP* retop;
     I32 gimme;
     register PERL_CONTEXT *cx;
     I32 optype;
 
     POPBLOCK(cx,newpm);
     POPEVAL(cx);
-    pop_return();
+    retop = pop_return();
 
     TAINT_NOT;
     if (gimme == G_VOID)
@@ -3452,7 +3467,7 @@ PP(pp_leavetry)
 
     LEAVE;
     sv_setpv(ERRSV,"");
-    RETURN;
+    RETURNOP(retop);
 }
 
 STATIC void
diff --git a/regcomp.c b/regcomp.c
index 43c46bb2bb..6726ba104c 100644
--- a/regcomp.c
+++ b/regcomp.c
@@ -505,6 +505,8 @@ S_scan_commit(pTHX_ RExC_state_t *pRExC_state, scan_data_t *data)
 	    data->offset_float_max = (l
 				      ? data->last_start_max
 				      : data->pos_min + data->pos_delta);
+	    if ((U32)data->offset_float_max > (U32)I32_MAX)
+		data->offset_float_max = I32_MAX;
 	    if (data->flags & SF_BEFORE_EOL)
 		data->flags
 		    |= ((data->flags & SF_BEFORE_EOL) << SF_FL_SHIFT_EOL);
diff --git a/regexec.c b/regexec.c
index 29b870436a..4380fd8916 100644
--- a/regexec.c
+++ b/regexec.c
@@ -1015,7 +1015,7 @@ S_find_byclass(pTHX_ regexp * prog, regnode *c, char *s, char *strend, char *sta
 	    c1 = *(U8*)m;
 	    c2 = PL_fold_locale[c1];
 	  do_exactf:
-	    e = HOP3c(strend, -ln, s);
+	    e = HOP3c(strend, -(I32)ln, s);
 
 	    if (norun && e < s)
 		e = s;			/* Due to minlen logic of intuit() */
diff --git a/t/op/re_tests b/t/op/re_tests
index 88f69f2500..55bd63766c 100644
--- a/t/op/re_tests
+++ b/t/op/re_tests
@@ -833,3 +833,4 @@ ab(?i)cd	abCd	y	-	-
 (.*?)(?<=c|b)c	abcd	y	$1	ab
 (.*?)(?<=[bc])	abcd	y	$1	ab
 (.*?)(?<=[bc])c	abcd	y	$1	ab
+2(]*)?$\1	2	y	$&	2
diff --git a/t/op/tiearray.t b/t/op/tiearray.t
index 0c9130367e..9544f89f74 100755
--- a/t/op/tiearray.t
+++ b/t/op/tiearray.t
@@ -225,11 +225,7 @@ untie @ary;
 
 # 20020401 mjd-perl-patch+@plover.com
 # Thanks to Dave Mitchell for the small test case
-{ require './test.pl';
-  curr_test(35);
-  local $::TODO = 'Not fixed yet';
-  fresh_perl_is(<<'End_of_Test', "ok", {}, "Core dump in 'leavetry'");
-######## [ID 20020301.011] Core dump in 'leavetry' in 5.7.2
+{
   my @a;
   
   sub X::TIEARRAY { bless {}, 'X' }
@@ -241,10 +237,9 @@ untie @ary;
 
   tie @a, 'X';
   eval { splice(@a) };
-  print "ok\n"
-End_of_Test
+  # If we survived this far.
+  print "ok ", $test++, "\n";
 }
-$test++;
                            
 print "not " unless $seen{'DESTROY'} == 2;
 print "ok ", $test++,"\n";