develooper Front page | perl.perl5.porters | Postings from December 2001

[ID 20011226.004] tie returning overload values

From:
Alex Gough
Date:
December 26, 2001 15:50
Subject:
[ID 20011226.004] tie returning overload values
Message ID:
20011226234945.A6256@ermine.ox.ac.uk
I think the following shows a problem where tie and overload interact.
My aim is to be able to tag values with attributes as they fly between
tied variables, although this is not demonstrated in the bug report
below.  I sometimes get segfaults with more complicated examples, but
not in a simply reproducable fashion.

Alex Gough

#!/usr/bin/perl -w

my($foo, $bar);
tie $foo, 'TIEME'; tie $bar, 'TIEME';

$foo = 2; $bar = 2;

print $bar / $foo;
print "\n";

package TIEME;
sub TIESCALAR {
    my ($class) = shift;
    my $foo = bless \my $bar, 'OLME';
    return bless \$foo, $class;
}
sub FETCH { print "fetch ", caller(), "\n";  ${$_[0]}; }
sub STORE { print "store\n";${${$_[0]}} = $_[1];  }

package OLME;
use overload
    '0+' => sub { print "0+\n"; ${$_[0]} },
    '/'  => sub { print " / \n";
	my $rt = $_[2] ? $_[0]->[0] / $_[1]->[0]
	               : $_[1]->[0] / $_[0]->[0];
	return bless \$rt, 'OLME';
    }
;

__END__
####################
Using the above, perl@13865 and gdb (line 8 is the first
Perl_pp_divide)...

Breakpoint 1, Perl_pp_divide () at pp.c:1007
1007	    dSP; dATARGET; tryAMAGICbin(div,opASSIGN);
(gdb) n
1112		dPOPPOPnnrl;
(gdb) n
fetch maingah.pl8
0+
fetch OLMEgah.pl22
fetch maingah.pl8
0+
fetch OLMEgah.pl22
1113		if (right == 0.0)
(gdb) 

Because the tie is not accessed until well after pp.c:1007, the
appropriate overload q{/} cannot eventually be called, instead
dPOPPOPnnrl eventually triggers the tie FETCH which in turn causes the
numeric coercion q{0+}, instead of the expected division of the return
values of FETCH.

Also FETCH is being called from inappropriate places, but that might
be a side issue.

I would expect the program above to behave as if line 8 read:

print (tied $foo)->FETCH() / (tied $bar)->FETCH();

Similar trouble is caused by other operations.

##
[12:58AM]~/smoke% perl/perl -I/var/smoke/lib -V
Summary of my perl5 (revision 5.0 version 7 subversion 2 patch 13864) configuration:
  Platform:
    osname=freebsd, osvers=4.4-release, archname=i386-freebsd
    uname='freebsd lintilla 4.4-release freebsd 4.4-release #0: tue sep 18 11:57:08 pdt 2001 murray@builder.freebsd.org:usrsrcsyscompilegeneric i386 '
    config_args='-DDEBUGING -Doptimize=-g -de -Dusedevel'
    hint=recommended, useposix=true, d_sigaction=define
    usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef
    useperlio=define d_sfio=undef uselargefiles=define usesocks=undef
    use64bitint=undef use64bitall=undef uselongdouble=undef
    usemymalloc=n, bincompat5005=define
  Compiler:
    cc='cc', ccflags ='-DHAS_FPSETMASK -DHAS_FLOATINGPOINT_H -DDEBUGGING -fno-strict-aliasing -I/usr/local/include',
    optimize='-g',
    cppflags='-DHAS_FPSETMASK -DHAS_FLOATINGPOINT_H -DDEBUGGING -fno-strict-aliasing -I/usr/local/include'
    ccversion='', gccversion='2.95.3 20010315 (release) [FreeBSD]', gccosandvers=''
    intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=12
    ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=8
    alignbytes=4, prototype=define
  Linker and Libraries:
    ld='cc', ldflags ='-Wl,-E  -L/usr/local/lib'
    libpth=/usr/lib /usr/local/lib
    libs=-lgdbm -ldb -lm -lc -lcrypt -lutil
    perllibs=-lm -lc -lcrypt -lutil
    libc=, so=so, useshrplib=false, libperl=libperl.a
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags=' '
    cccdlflags='-DPIC -fpic', lddlflags='-shared  -L/usr/local/lib'


Characteristics of this binary (from libperl): 
  Compile-time options: DEBUGGING USE_LARGE_FILES
  Locally applied patches:
  	DEVEL13864
  Built under freebsd
  Compiled at Dec 23 2001 23:22:55
  @INC:
    /var/smoke/lib
    /usr/local/lib/perl5/5.7.2/i386-freebsd
    /usr/local/lib/perl5/5.7.2
    /usr/local/lib/perl5/site_perl/5.7.2/i386-freebsd
    /usr/local/lib/perl5/site_perl/5.7.2
    /usr/local/lib/perl5/site_perl/5.6.1/i386-freebsd
    /usr/local/lib/perl5/site_perl/5.6.1
    /usr/local/lib/perl5/site_perl/5.6.0/i386-freebsd
    /usr/local/lib/perl5/site_perl/5.6.0
    /usr/local/lib/perl5/site_perl/5.005/i386-freebsd
    /usr/local/lib/perl5/site_perl/5.005
    /usr/local/lib/perl5/site_perl
    .

-- 
Liberty means responsibility. That is why most men dread it. 




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