From: Nick Ing-Simmons <nik@tiuk.ti.com>
Date: Wed, 8 Nov 2000 13:03:04 +0000 (+0000)
Subject: Fix for the tie-refhash string table leaks.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=240263869b859eb47916a5c595018abdc313547e;p=p5sagit%2Fp5-mst-13.2.git

Fix for the tie-refhash string table leaks.
Message-Id: <200011081303.NAA07042@mikado.tiuk.ti.com>

p4raw-id: //depot/perl@7602
---

diff --git a/t/lib/tie-refhash.t b/t/lib/tie-refhash.t
index 7ad2beb..d80b2e1 100644
--- a/t/lib/tie-refhash.t
+++ b/t/lib/tie-refhash.t
@@ -30,6 +30,7 @@ my $ref = []; my $ref1 = [];
 # buggy :-)
 # 
 my @tests = standard_hash_tests();
+
 my @ordinary_results = runtests(\@tests, undef);
 foreach my $class ('Tie::RefHash', 'Tie::RefHash::Nestable') {
     my @tied_results = runtests(\@tests, $class);
@@ -66,7 +67,7 @@ foreach my $class ('Tie::RefHash', 'Tie::RefHash::Nestable') {
 
 # Now test Tie::RefHash's special powers
 my (%h, $h);
-eval { $h = tie %h, 'Tie::RefHash' };
+$h = eval { tie %h, 'Tie::RefHash' };
 warn $@ if $@;
 test(not $@);
 test(ref($h) eq 'Tie::RefHash');
@@ -96,7 +97,7 @@ undef $h;
 untie %h;
 
 # And now Tie::RefHash::Nestable's differences from Tie::RefHash.
-eval { $h = tie %h, 'Tie::RefHash::Nestable' };
+$h = eval { tie %h, 'Tie::RefHash::Nestable' };
 warn $@ if $@;
 test(not $@);
 test(ref($h) eq 'Tie::RefHash::Nestable');
@@ -113,8 +114,14 @@ test((keys %h)[0] eq $ref);
 test((keys %{$h{$ref}}) == 1);
 test((keys %{$h{$ref}})[0] eq $ref1);
 
+
 die "expected to run $numtests tests, but ran ", $currtest - 1
   if $currtest - 1 != $numtests;
+
+@tests = ();
+undef $ref;
+undef $ref1;
+
 exit();
 
 
@@ -169,7 +176,7 @@ sub runtests {
 
     my (%h, $h);
     if (defined $class) {
-        eval { $h = tie %h, $class };
+        $h = eval { tie %h, $class };
         warn $@ if $@;
         test(not $@);
         test(ref($h) eq $class);
@@ -180,7 +187,11 @@ sub runtests {
         my ($result, $warning, $exception);
         local $SIG{__WARN__} = sub { $warning .= $_[0] };
         $result = scalar(eval $_);
-        $exception = $@ if $@;
+        if ($@)
+         {
+          die "$@:$_" unless defined $class;
+          $exception = $@;
+         }
 
         foreach ($warning, $exception) {
             next if not defined;
@@ -219,9 +230,8 @@ sub standard_hash_tests {
     my $STD_TESTS = <<'END'
     join $;, sort keys %h;
     join $;, sort values %h;
-    { my ($v, %tmp); %tmp{$v}++ while (defined($v = each %h)); dumph(\%tmp) }
-    { my ($k, $v, %tmp); $tmp{"$k$;$v"}++ while (($k, $v) = each %h); dumph(\%t
-mp) }
+    { my ($v, %tmp); $tmp{$v}++ while (defined($v = each %h)); dumph(\%tmp) }
+    { my ($k, $v, %tmp); $tmp{"$k$;$v"}++ while (($k, $v) = each %h); dumph(\%tmp) }
 END
   ;
     
@@ -272,8 +282,6 @@ END
     # Test hash slices
     my @slicetests;
     @slicetests = split /\n/, <<'END'
-    @h{} = ();
-    @h{} = ('a');
     @h{'b'} = ();
     @h{'c'} = ('d');
     @h{'e'} = ('f', 'g');
@@ -290,7 +298,7 @@ END
     }
 
     # Test CLEAR
-    push @r, 'clear %h', split(/\n/, $STD_TESTS);
+    push @r, '%h = ();', split(/\n/, $STD_TESTS);
 
     return @r;
 }