From: Jarkko Hietaniemi Date: Thu, 2 Nov 2000 22:08:49 +0000 (+0000) Subject: Fix the problem discussed in X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2fc7fd3f18733037e46c7d20cc82d759b0c5a03a;p=p5sagit%2Fp5-mst-13.2.git Fix the problem discussed in Subject: [ID 20001015.004] Fwd: Tie::SubstrHash -- bug & fix (all Perl versions) Date: Mon, 16 Oct 2000 04:48:59 +0300 (EET DST) Message-Id: <200010160148.EAA14523@alpha.hut.fi> originally from Linc Madison. Also Andreas König's comments taken into account. Some other problems with Tie::SubstrHash fixed: didn't croak when the table exceeded the requested number of entries (as documented) but instead when the number of entries exceeded the size of the table, a croak() had an unnecessary \n, didn't have a CLEAR method, documented that there is no exists(). Didn't fix to be strict-proof because the module uses &foo; and dynamic scope. Added a test script exercizing both first tamely the basic functionality, and then the failure cases reported by Linc Madison. p4raw-id: //depot/perl@7530 --- diff --git a/MANIFEST b/MANIFEST index cfb0fdc..1b40213 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1452,6 +1452,7 @@ t/lib/tie-splice.t Test for Tie::Array::SPLICE t/lib/tie-stdarray.t Test for Tie::StdArray t/lib/tie-stdhandle.t Test for Tie::StdHandle t/lib/tie-stdpush.t Test for Tie::StdArray +t/lib/tie-substrhash.t Test for Tie::SubstrHash t/lib/timelocal.t See if Time::Local works t/lib/trig.t See if Math::Trig works t/op/64bitint.t See if 64 bit integers work diff --git a/lib/Tie/SubstrHash.pm b/lib/Tie/SubstrHash.pm index 4b18a58..b8f6449 100644 --- a/lib/Tie/SubstrHash.pm +++ b/lib/Tie/SubstrHash.pm @@ -33,6 +33,8 @@ Because the current implementation uses the table and key sizes for the hashing algorithm, there is no means by which to dynamically change the value of any of the initialization parameters. +The hash does not support exists(). + =cut use Carp; @@ -41,12 +43,20 @@ sub TIEHASH { my $pack = shift; my ($klen, $vlen, $tsize) = @_; my $rlen = 1 + $klen + $vlen; - $tsize = findprime($tsize * 1.1); # Allow 10% empty. + $tsize = [$tsize, + findgteprime($tsize * 1.1)]; # Allow 10% empty. $self = bless ["\0", $klen, $vlen, $tsize, $rlen, 0, -1]; - $$self[0] x= $rlen * $tsize; + $$self[0] x= $rlen * $tsize->[1]; $self; } +sub CLEAR { + local($self) = @_; + $$self[0] = "\0" x ($$self[4] * $$self[3]->[1]); + $$self[5] = 0; + $$self[6] = -1; +} + sub FETCH { local($self,$key) = @_; local($klen, $vlen, $tsize, $rlen) = @$self[1..4]; @@ -69,8 +79,8 @@ sub FETCH { sub STORE { local($self,$key,$val) = @_; local($klen, $vlen, $tsize, $rlen) = @$self[1..4]; - croak("Table is full") if $$self[5] == $tsize; - croak(qq/Value "$val" is not $vlen characters long./) + croak("Table is full ($tsize->[0] elements)") if $$self[5] > $tsize->[0]; + croak(qq/Value "$val" is not $vlen characters long/) if length($val) != $vlen; my $writeoffset; @@ -129,7 +139,7 @@ sub FIRSTKEY { sub NEXTKEY { local($self) = @_; local($klen, $vlen, $tsize, $rlen, $entries, $iterix) = @$self[1..6]; - for (++$iterix; $iterix < $tsize; ++$iterix) { + for (++$iterix; $iterix < $tsize->[1]; ++$iterix) { next unless substr($$self[0], $iterix * $rlen, 1) eq "\2"; $$self[6] = $iterix; return substr($$self[0], $iterix * $rlen + 1, $klen); @@ -138,35 +148,48 @@ sub NEXTKEY { undef; } +sub EXISTS { + croak "Tie::SubstrHash does not support exists()"; +} + sub hashkey { - croak(qq/Key "$key" is not $klen characters long.\n/) + croak(qq/Key "$key" is not $klen characters long/) if length($key) != $klen; $hash = 2; for (unpack('C*', $key)) { $hash = $hash * 33 + $_; &_hashwrap if $hash >= 1e13; } - &_hashwrap if $hash >= $tsize; + &_hashwrap if $hash >= $tsize->[1]; $hash = 1 unless $hash; $hashbase = $hash; } sub _hashwrap { - $hash -= int($hash / $tsize) * $tsize; + $hash -= int($hash / $tsize->[1]) * $tsize->[1]; } sub rehash { $hash += $hashbase; - $hash -= $tsize if $hash >= $tsize; + $hash -= $tsize->[1] if $hash >= $tsize->[1]; +} + +# using POSIX::ceil() would be too heavy, and not all platforms have it. +sub ceil { + my $num = shift; + $num = int($num + 1) unless $num == int $num; + return $num; } -sub findprime { +sub findgteprime { # find the smallest prime integer greater than or equal to use integer; - my $num = shift; + my $num = ceil(shift); + return 2 if $num <= 2; + $num++ unless $num % 2; - $max = int sqrt $num; + my $max = int sqrt $num; NUM: for (;; $num += 2) { diff --git a/t/lib/tie-substrhash.t b/t/lib/tie-substrhash.t new file mode 100644 index 0000000..d21ca0a --- /dev/null +++ b/t/lib/tie-substrhash.t @@ -0,0 +1,99 @@ +#!/usr/bin/perl -w +# + +BEGIN { + chdir 't' if -d 't'; + @INC = '.'; + push @INC, '../lib'; +} + +print "1..16\n"; + +use strict; + +require Tie::SubstrHash; + +my %a; + +tie %a, 'Tie::SubstrHash', 3, 3, 3; + +$a{abc} = 123; +$a{bcd} = 234; + +print "not " unless $a{abc} == 123; +print "ok 1\n"; + +print "not " unless keys %a == 2; +print "ok 2\n"; + +delete $a{abc}; + +print "not " unless $a{bcd} == 234; +print "ok 3\n"; + +print "not " unless (values %a)[0] == 234; +print "ok 4\n"; + +eval { $a{abcd} = 123 }; +print "not " unless $@ =~ /Key "abcd" is not 3 characters long/; +print "ok 5\n"; + +eval { $a{abc} = 1234 }; +print "not " unless $@ =~ /Value "1234" is not 3 characters long/; +print "ok 6\n"; + +eval { $a = $a{abcd}; $a++ }; +print "not " unless $@ =~ /Key "abcd" is not 3 characters long/; +print "ok 7\n"; + +@a{qw(abc cde)} = qw(123 345); + +print "not " unless $a{cde} == 345; +print "ok 8\n"; + +eval { $a{def} = 456 }; +print "not " unless $@ =~ /Table is full \(3 elements\)/; +print "ok 9\n"; + +%a = (); + +print "not " unless keys %a == 0; +print "ok 10\n"; + +# Tests 11..16 by Linc Madison. + +my $hashsize = 119; # arbitrary values from my data +my %test; +tie %test, "Tie::SubstrHash", 13, 86, $hashsize; + +for (my $i = 1; $i <= $hashsize; $i++) { + my $key1 = $i + 100_000; # fix to uniform 6-digit numbers + my $key2 = "abcdefg$key1"; + $test{$key2} = ("abcdefgh" x 10) . "$key1"; +} + +for (my $i = 1; $i <= $hashsize; $i++) { + my $key1 = $i + 100_000; + my $key2 = "abcdefg$key1"; + unless ($test{$key2}) { + print "not "; + last; + } +} +print "ok 11\n"; + +print "not " unless Tie::SubstrHash::findgteprime(1) == 2; +print "ok 12\n"; + +print "not " unless Tie::SubstrHash::findgteprime(2) == 2; +print "ok 13\n"; + +print "not " unless Tie::SubstrHash::findgteprime(5.5) == 7; +print "ok 14\n"; + +print "not " unless Tie::SubstrHash::findgteprime(13) == 13; +print "ok 15\n"; + +print "not " unless Tie::SubstrHash::findgteprime(13.000001) == 17; +print "ok 16\n"; +