Beefy Boxes and Bandwidth Generously Provided by pair Networks
laziness, impatience, and hubris

Overloading for List Context

by Zaxo (Archbishop)
on May 31, 2002 at 14:04 UTC ( #170716=perlquestion: print w/replies, xml ) Need Help??

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

Replying to educated_foo's excellent question at Re: Basic Objects with Overloaded Operators, I quoted an example of overloading the diamond operator <> from the Camel Book, 3rd ed., p355. I mentioned my uneasiness about how closely the overloaded operator followed the 'rules' (whatever they are). Here is the overloaded module:

#!/usr/bin/perl -w use strict; package LuckyDraw; use overload '<>' => sub { my $self = shift; splice @$self, rand @$self, 1; }; sub new { my $class = shift; bless [@_], $class; }

It implements drawing elements from an array without replacement

I worried about whether false values in the array would interfere with while (<$foo>) {}, and whether list context would fail.

Sooo... I expanded the example to test a number of cases. It turns out that while <> is fine with zeros in the array. If undef is present, it ends the while loop, but the remainder of the array is still available. As I feared, list context fails to read the entire array. That means that neither my @foo = <$foo>; nor for (<$foo>) {} works as expected.

I rewrote a version of the module which I thought should do the right thing in list context. It doesn't. Anyone see what I'm forgetting?

Here is the test code:

package main; my $cards = LuckyDraw->new(1..52); for (1..5) { my $card = <$cards>; print name_card($card),$/; } my $alltrue = LuckyDraw->new(qw/foo bar baz/); print 'All True:', $/; print while <$alltrue>; print $/; my $onezero = LuckyDraw->new(0..9); print 'One Zero:', $/; print while <$onezero>; print $/; my $onefalse = LuckyDraw->new(0..9); print 'One False:', $/; $_+=0, print while <$onefalse>; print $/; my $onenil = LuckyDraw->new(undef,1..9); print 'One Undef:', $/; print while <$onenil>; print $/; print 'continuing...',$/; print while <$onenil>; print $/; my $shuffle = new LuckyDraw(1..52); print name_card($_),' ' for <$shuffle>; print $/; sub name_card { my $card = shift; sprintf "%s of %s", (qw/Ace Deuce Trey Four Five Six Seven Eight Nine Ten Jack Queen King/)[$card % 13], (qw/Clubs Diamonds Hearts Spades/)[$card / 13]; }
And here is the unsuccessful new code:
package LuckyDeck; use overload '<>' => sub { my $self = shift; return splice( @$self, rand @$self, 1) unless wantarray; my @deck; push @deck, splice( @$self, rand @$self, 1) while @$self; @deck; }; sub new { my $class = shift; bless [@_], $class; } package main; my $quux = LuckyDeck->new(0..9); print 'List Context',$/; print for <$quux>; print $/;

Why am I not getting a list back?

The code here is organized so that it runs as a single file.

After Compline,

Replies are listed 'Best First'.
Re: Overloading for List Context
by educated_foo (Vicar) on May 31, 2002 at 14:41 UTC
    I think the want context is something screwy in this case:
    package LuckyDeck; use Tie::Array; use overload '<>' => sub { use Want; my $self = shift; foreach (qw(BOOL SCALAR LIST ASSIGN REF)) { print STDERR "want $_\n" if want $_; } if (want ('BOOL') or want ('SCALAR')) { return splice( @$self, rand @$self, 1) unless wantarray; } my @deck; push @deck, splice( @$self, rand @$self, 1) while @$self; @deck; }; sub new { my $class = shift; bless [@_], $class; } package main; my $quux = LuckyDeck->new(1..9); print 'List Context',$/; print for <$quux>; print $/;
    Which, when run with 5.6.1, yields:
    perl/Language-FP% perl -l ../
    List Context
    zsh: 7739 segmentation fault (core dumped)  perl -l ../
    #0  0xfd7b77c in parent_op ()
       from #1  0xfd7bf28 in XS_Want_parent_op_name ()
       from #2  0x10076ddc in Perl_pp_entersub ()
    #3  0x1006fb80 in Perl_runops_standard ()
    #4  0x1001fa3c in Perl_amagic_call ()
    #5  0x100701e8 in Perl_pp_readline ()
    #6  0x1006fb80 in Perl_runops_standard ()
    #7  0x10014644 in S_run_body ()
    #8  0x10014288 in perl_run ()
    #9  0x10010f58 in main ()
    #10 0xfe2e69c in __libc_start_main ()
        at ../sysdeps/powerpc/elf/libc-start.c:106
    #11 0x0 in ?? ()
    So it's evidently giving Want something it can't handle. The "amagic_call()" makes me think it's trying to access $quux as a tied array, but I'm hardly Mr. Internals. In any case, it doesn't seem to be called in array context in the for. Which leads me back to my previous conclusion, that overloading '<>' isn't meant for prime-time.


Re: Overloading for List Context
by jmcnamara (Monsignor) on May 31, 2002 at 14:55 UTC

    From stepping through the code in the debugger it seems that wantarray() always returns false in the overloading sub. It seems that the overloaded operator is always called in a scalar context. I don't know why though.


Re: Overloading for List Context
by webfiend (Vicar) on May 31, 2002 at 16:29 UTC

    I can make it work with while. I'm just a monkeyboy, so I have no idea why it works. Anyways:

    package main; my $quux = LuckyDeck->new(0..9); print 'List Context',$/; while (<$quux>) { print $_; } print $/;

    Or, putting the while in the same style as the rest of the program:

    print while <$quux>;

    Would somebody smart like to explain why while works, but for doesn't?

    Update: Drank some more coffee, realized that wasn't really the question. Back to the drawing board ...

    Update: Okay, I am stumped (which isn't a major news item itself ;-) ). I have found no way to convince LuckyDraw that I wantarray. List assignment and while both come up in a scalar context. Where is the oddity coming from? Overload? The iterator <> operator? Does perl have a hangover today?

    "All you need is ignorance and confidence; then success is sure."-- Mark Twain

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://170716]
Approved by jlk
Front-paged by educated_foo
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others browsing the Monastery: (5)
As of 2021-05-12 03:21 GMT
Find Nodes?
    Voting Booth?
    Perl 7 will be out ...

    Results (124 votes). Check out past polls.