proxying overloads: returns seem to lie

rjbs has asked for the wisdom of the Perl Monks concerning the following question:

I am completely stumped! I'm working on a class which is implemented on a scalar reference. It overloads operations to pass through to the referenced scalar, mostly by building an appropriate string and evaluating it. It's not quite working. The frustrating thing is that after I added a few little print statements, it reports that it's eval'd the statement and gotten 1, but returns false! This code is a fairly minimal test case. You can remove the __END__ tag to see some extra testing using Test::More.

use strict;
use warnings;

package Object::Capsule;

sub encapsulate {
    my $object = shift;
    bless \$object => 'Object::Capsule';
}

use overload
    '${}'    => sub { $_[0] },
    '""'     => sub { "${$_[0]}" },
    '0+'     => sub { 0 + ${$_[0]} },
    nomethod => sub {
        my $expr = $_[2]
            ? "\$_[1] $_[3] \${\$_[0]}"
            : "\${\$_[0]} $_[3] \$_[1]";
        print "# capsule overload eval-ing : $expr\n";
        my $result  = eval $expr;
        print "# capsule overload returning: ", $result, "\n";
        return $result;
    },
;

package Widget;
    sub new  { my $class = shift; bless { @_ } => $class }
    sub size { (shift)->{size} }

    use overload
        '""' => sub { "It's a widget!" },
        '0+' => sub { $_[0]->{size} },
        fallback => 1
    ;
package main;

my $widget = new Widget size => 10;
my $capsule = Object::Capsule::encapsulate($widget);

my $result = $capsule eq "It's a widget!";
print "# result of comparison: ", ($result?'true':'false'), "\n";

   $result = $capsule ne "It's a widget!";
print "# result of comparison: ", ($result?'true':'false'), "\n";

print "\n";

print "# -- bytes of returned strings --\n";
print "# ", join(' ',map { ord($_) } split //, "$capsule"), "\n";
print "# ", join(' ',map { ord($_) } split //, "It's a widget!"), "\n"
+;

print "\n--(Test::More stuff below this point)--\n";

__END__

use Test::More 'no_plan';

isa_ok($widget, 'Widget');
cmp_ok($widget, '==',                10, "widget numifies as intended"
+);
cmp_ok($widget, 'eq',  "It's a widget!", "widget stringifies as intend
+ed");

print "\n";

isa_ok($capsule,  'Object::Capsule');
isa_ok($$capsule, 'Widget');
cmp_ok($capsule, '==',               10, "capsule cmp_ok == 10");
cmp_ok($capsule, 'eq', "It's a widget!", "capsule cmp_ok eq the string
+");
    ok($capsule == 10,               "capsule numifies as intended");
    ok($capsule eq "It's a widget!", "capsule stringifies as intended"
+);
[download]

rjbs

Comment on proxying overloads: returns seem to lie Download Code

Replies are listed 'Best First'.
Re: proxying overloads: returns seem to lie by Prior Nacre V (Hermit) on Sep 11, 2004 at 04:04 UTC
Your problem is context. `print` operates in interpolative context so `$capsule` returns `It's a widget!` but `ne` operates in boolean context so `$capsule` returns something like `Object::Capsule=SCALAR(0x1234567)`. I ran three tests: Your code as is Changed `$capsule ne ...` to `"$capsule" ne ...` (eq also) Changed `$capsule ne ...` to `$$capsule ne ...` (eq also) Here's the output using Perl 5.6, Cygwin and Win98: [ ~/tmp ] $ perl overload_context # capsule overload eval-ing : ${$_[0]} eq $_[1] Segmentation fault (core dumped) [ ~/tmp ] $ perl overload_context # result of comparison: true # result of comparison: false # -- bytes of returned strings -- # 73 116 39 115 32 97 32 119 105 100 103 101 116 33 # 73 116 39 115 32 97 32 119 105 100 103 101 116 33 --(Test::More stuff below this point)-- [ ~/tmp ] $ perl overload_context # result of comparison: true # result of comparison: false # -- bytes of returned strings -- # 73 116 39 115 32 97 32 119 105 100 103 101 116 33 # 73 116 39 115 32 97 32 119 105 100 103 101 116 33 --(Test::More stuff below this point)-- [ ~/tmp ] $ [download] Regards, PN5	[reply] [d/l] [select]
Re^2: proxying overloads: returns seem to lie by rjbs (Pilgrim) on Sep 11, 2004 at 14:26 UTC
Huh! Well, it's good that I can now make the code work, although it starts to suggest to me that I'm going to need to write more explicit overloading for the Capsule class to make everything work correctly. Meanwhile, I'm not sure, given your explanation, why this works normally: `my $result = $widget eq "It's a widget!"; print "# result of comparison: ", ($result?'true':'false'), "\n";` [download] I suppose there's some context change going on in the capsule's overload nomethod, but I'm not clear on what it is. Is there a simple tool I could use to see these context changes? I don't think it's the debugger, but maybe it's got voodoo I don't know about. rjbs	[reply] [d/l]
Re^3: proxying overloads: returns seem to lie by Prior Nacre V (Hermit) on Sep 25, 2004 at 23:26 UTC
Glad you got your code working. I'm not sure about tools for this: investigation of the CPAN Module: Want may prove fruitful. Regards, PN5	[reply]
Re: proxying overloads: returns seem to lie by Velaki (Chaplain) on Sep 10, 2004 at 19:31 UTC
I took a look at the code, and added `print "* ($capsule) * Result: ($result)\n";` [download] to the code. When I ran the code, I got `# capsule overload eval-ing : ${$_[0]} eq $_[1] # capsule overload returning: 1 * (It's a widget!) * Result: () # result of comparison: false` [download] which seems to mean that the eq has failed. However, when I replace eq with =~, the code appears to work as you expected; however, then it appears to bypass the nomethod overload. `* (It's a widget!) * Result: (1) # result of comparison: true # result of comparison: false` [download] Likewise with substituting !~ for ne. Wish I could be of more help, -v Update 1: It appears as if nomethod fails to return anything even when hardcoded. I probably need to do more research. -v Update 2: It looks like Capsule* is looking for a* nomethod in Widget, but failing to find that, invokes Capsule's nomethod. However, it appears to toss the value in what looks like a return through Widget. It should probably be run through the perl debugger will full tracing. Sorry again, -v "Perl. There is no substitute."	[reply] [d/l] [select]