Beefy Boxes and Bandwidth Generously Provided by pair Networks
Pathologically Eclectic Rubbish Lister
 
PerlMonks  

proxying overloads: returns seem to lie

by rjbs (Pilgrim)
on Sep 10, 2004 at 19:06 UTC ( [id://390161]=perlquestion: print w/replies, xml ) Need Help??

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" +);
rjbs

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 ] $

    Regards,

    PN5

      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";
      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

        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

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";
    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
    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

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

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://390161]
Approved by petdance
Front-paged by petdance
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others rifling through the Monastery: (3)
As of 2024-03-28 17:57 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found