From: Yitzchak Scott-Thoennes <sthoenna@efn.org>
Date: Wed, 7 May 2003 15:27:07 +0000 (-0700)
Subject: Re: [perl #17718] %tiedhash in bool context doesn't check if hash is empty
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=126c71c82576d5dc652db25ca9e3f8e18442c4fd;p=p5sagit%2Fp5-mst-13.2.git

Re: [perl #17718] %tiedhash in bool context doesn't check if hash is empty
Message-ID: <7gYu+gzkgaFU092yn@efn.org>

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

diff --git a/pod/perldata.pod b/pod/perldata.pod
index 5720589..c58d419 100644
--- a/pod/perldata.pod
+++ b/pod/perldata.pod
@@ -257,7 +257,9 @@ Perl's internal hashing algorithm is performing poorly on your data
 set.  For example, you stick 10,000 things in a hash, but evaluating
 %HASH in scalar context reveals C<"1/16">, which means only one out
 of sixteen buckets has been touched, and presumably contains all
-10,000 of your items.  This isn't supposed to happen.
+10,000 of your items.  This isn't supposed to happen.  If a tied hash
+is evaluated in scalar context, a fatal error will result, since this
+bucket usage information is currently not available for tied hashes.
 
 You can preallocate space for a hash by assigning to the keys() function.
 This rounds up the allocated buckets to the next power of two:
diff --git a/pod/perldiag.pod b/pod/perldiag.pod
index b6558ec..ad5841c 100644
--- a/pod/perldiag.pod
+++ b/pod/perldiag.pod
@@ -912,6 +912,14 @@ for stdout.
 
 (F) The script you specified can't be opened for the indicated reason.
 
+=item Can't provide tied hash usage; use keys(%hash) to test if empty
+
+(F) When a hash is evaluated in scalar context, bucket usage is
+returned if the hash is populated, and false is returned if the hash
+is empty.  Bucket usage is not currently available for tied hashes.
+To test if a hash is empty or populated, use keys(%hash) in scalar
+context instead.
+
 =item Can't read CRTL environ
 
 (S) A warning peculiar to VMS.  Perl tried to read an element of %ENV
diff --git a/pod/perltie.pod b/pod/perltie.pod
index 05b7973..3665f04 100644
--- a/pod/perltie.pod
+++ b/pod/perltie.pod
@@ -1076,6 +1076,14 @@ source code to MLDBM.
 Tied filehandles are still incomplete.  sysopen(), truncate(),
 flock(), fcntl(), stat() and -X can't currently be trapped.
 
+The bucket usage information provided by C<scalar(%hash)> is not
+available.  If C<%hash> is tied, this will currently result in a
+fatal error.
+
+Counting the number of entries in a hash via C<scalar(keys(%hash))> or
+C<scalar(values(%hash)>) is inefficient since it needs to iterate
+through all the entries with FIRSTKEY/NEXTKEY.
+
 =head1 AUTHOR
 
 Tom Christiansen
diff --git a/pp.c b/pp.c
index 53aea9b..7acc1da 100644
--- a/pp.c
+++ b/pp.c
@@ -107,6 +107,9 @@ PP(pp_padhv)
     }
     else if (gimme == G_SCALAR) {
 	SV* sv = sv_newmortal();
+        if (SvRMAGICAL(TARG) && mg_find(TARG, PERL_MAGIC_tied))
+	     Perl_croak(aTHX_ "Can't provide tied hash usage; "
+			"use keys(%%hash) to test if empty");
 	if (HvFILL((HV*)TARG))
 	    Perl_sv_setpvf(aTHX_ sv, "%ld/%ld",
 		      (long)HvFILL((HV*)TARG), (long)HvMAX((HV*)TARG) + 1);
diff --git a/pp_hot.c b/pp_hot.c
index d907570..416eba5 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -795,6 +795,7 @@ PP(pp_rv2hv)
 {
     dSP; dTOPss;
     HV *hv;
+    I32 gimme = GIMME_V;
 
     if (SvROK(sv)) {
       wasref:
@@ -808,7 +809,7 @@ PP(pp_rv2hv)
 	    RETURN;
 	}
 	else if (LVRET) {
-	    if (GIMME == G_SCALAR)
+	    if (GIMME != G_SCALAR)
 		Perl_croak(aTHX_ "Can't return hash to lvalue scalar context");
 	    SETs((SV*)hv);
 	    RETURN;
diff --git a/t/op/magic.t b/t/op/magic.t
index 3279e1e..f48422b 100755
--- a/t/op/magic.t
+++ b/t/op/magic.t
@@ -316,16 +316,20 @@ else {
     skip('no caseless %ENV support') for 1..4;
 }
 
+{
+   no warnings 'void';
+
 # Make sure Errno hasn't been prematurely autoloaded
 
-ok !defined %Errno::;
+   ok !defined %Errno::;
 
 # Test auto-loading of Errno when %! is used
 
-ok scalar eval q{
-   my $errs = %!;
-   defined %Errno::;
-}, $@;
+   ok scalar eval q{
+      %!;
+      defined %Errno::;
+   }, $@;
+}
 
 
 # Make sure that Errno loading doesn't clobber $!