develooper Front page | perl.perl5.porters | Postings from January 2004

Returning a typeglob from FETCH a tied hash - broken as of 5.8.1

Thread Next
From:
Kee Hinckley
Date:
January 24, 2004 18:29
Subject:
Returning a typeglob from FETCH a tied hash - broken as of 5.8.1
Message ID:
p0610082fbc38d5e4a18c@[10.252.134.153]
Prior to 5.8.1 it was possible to return a typeglob from FETCH in a 
tied hash.  DBIx::Recordset relies upon this behavior.  I've tested 
5.6.0 on MacOS X 10.2, 5.6.1 on MacOS X 10.3 and 5.8.0 on Linux.  It 
works in all of those.  In 5.8.1 and .3 on MacOS X 10.3, and in 5.8.1 
on Linux, it does not work.  I believe the problem was introduced by 
the addition of calls to sv_upgrade in hv.c.  One is in 
Perl_hv_fetch_ent, the other (which may or may not be involved) is in 
S_hv_fetch_flags.

At this point though I've reached the limit of what I can figure out. 
Replacing the call to croak with a break "fixes" the problem, but it 
seems unlikely that is the correct solution.  I've enclosed a test 
program that triggers the error at the end of this message.

Here is a test run under Perl 5.6 (MacOS X Jaguar)
------
Undefined value
Called fetch(foo)
          ->
Setting to 1
Called fetch(foo)
          -> 1
Setting to *foo
Retrieving *foo
Called fetch(foo)
          -> *main::foo
Retrieving a typeglob
Called fetch(2)
Returning a typglob
          -> *TestHash::bar
------
Here is the same test under Perl 5.8.1 (MacOS X Panther)
------
Undefined value
Called fetch(foo)

Setting to 1
Called fetch(foo)
          1
Setting to *foo
Can't upgrade that kind of scalar at ./tieglobtest.pl line 44.

Retrieving *foo
Called fetch(foo)
          1
Retrieving a typeglob
Called fetch(2)
Returning a typglob
Can't upgrade that kind of scalar at ./tieglobtest.pl line 48.
------
tieglobtest.pl
------
#!/usr/bin/perl

use strict;
package TestHash;
require Tie::Hash;

use vars qw(@ISA $internal2);
@ISA = qw(Tie::StdHash);


sub FETCH {
     my $this = shift;
     my ($value) = @_;

     print STDERR "Called fetch($value)\n";
     if ($value == 2) {
         print STDERR "Returning a typglob\n";
         local(*bar);
         $internal2 = *bar;
         return *bar;
     }
     return $this->SUPER::FETCH($value);
}



package main;

my ($th, %th);
use vars qw($internal);

tie %th, 'TestHash';

print STDERR "Undefined value\n";
print STDERR "\t -> $th{foo}\n";
print STDERR "Setting to 1\n";
$th{foo} = 1;
print STDERR "\t -> $th{foo}\n";

local(*foo);
*foo = $internal;

print STDERR "Setting to *foo\n";
eval { $th{foo} = *foo; }; print STDERR "$@\n" if ($@);
print STDERR "Retrieving *foo\n";
eval { print STDERR "\t -> $th{foo}\n"; };print STDERR "$@\n" if ($@);
print STDERR "Retrieving a typeglob\n";
eval { print STDERR "\t -> $th{2}\n"; };print STDERR "$@\n" if ($@);

-- 
Kee Hinckley
http://www.messagefire.com/         Next Generation Spam Defense
http://commons.somewhere.com/buzz/  Writings on Technology and Society

I'm not sure which upsets me more: that people are so unwilling to accept
responsibility for their own actions, or that they are so eager to regulate
everyone else's.

Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About