FAQ
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.

Search Discussions

Discussion Posts

Follow ups

Related Discussions

Discussion Navigation
viewthread | post
posts ‹ prev | 1 of 16 | next ›
Discussion Overview
groupperl5-porters @
categoriesperl
postedJan 25, '04 at 2:29a
activeFeb 16, '04 at 12:45a
posts16
users5
websiteperl.org

People

Translate

site design / logo © 2022 Grokbase