At first I thought it was due to the ALIASING magic that a foreach(@array) does, but it turns out, it has nothing to do with aliasing.
It has to do with string interpolation.
If you interpolate our magical $_ in a string, and there is nothing before the "$_", then two FETCHs are performed.
I'm glad this is fixed after 5.6 (works fine in 5.7)
#!/usr/bin/perl
use strict;
use warnings;
package Dummy;
sub TIEARRAY
{
my $class = shift;
return bless [], $class;
}
sub STORE
{
my $self = shift;
my $index = shift;
my $value = shift;
return ($self->[ $index ] = $value );
}
sub FETCH
{
my $self = shift;
my $index = shift;
print STDERR "Now I'm fetching the element with index: $index\n";
return $self->[ $index ];
}
sub FETCHSIZE
{
my $self = shift;
return scalar( @$self );
}
package main;
$|=1;
my @array;
tie @array, 'Dummy';
$array[0] = 'Perl';
$array[1] = 'Monks';
print "for $_\n" for @array;
print "\n\n fine ", 'x' x 60, "\n\n";
print "foreach $_\n" foreach @array;
print "\n\n fine ", 'x' x 60, "\n\n";
for my $z(@array){
print "for my $z\n";
}
print "\n\n fine ", 'x' x 60, "\n\n";
for my $z(@array){
print "??????\n";
print $z;
print "\n";
}
print "\n\n buggy ", 'x' x 60, "\n\n";
{
local $\="\n";
print "$_\ta" for @array;
}
print "\n\n fine ", 'x' x 60, "\n\n";
for(@array) {
my $a = $_;
print "$a\n";
}
print "\n\n buggy ", 'x' x 60, "\n\n";
for(@array) {
warn "$_\n";
}
print "\n\noriginal\n\n";
foreach ( @array ) {
print "$_\n";
# print $_; print "\n";
}
__END__
E:\dev\LOOSE>perl tie.bug.t
Now I'm fetching the element with index: 0
for Perl
Now I'm fetching the element with index: 1
for Monks
fine xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
Now I'm fetching the element with index: 0
foreach Perl
Now I'm fetching the element with index: 1
foreach Monks
fine xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
Now I'm fetching the element with index: 0
for my Perl
Now I'm fetching the element with index: 1
for my Monks
fine xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
??????
Now I'm fetching the element with index: 0
Perl
??????
Now I'm fetching the element with index: 1
Monks
buggy xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
Now I'm fetching the element with index: 0
Now I'm fetching the element with index: 0
Perl a
Now I'm fetching the element with index: 1
Now I'm fetching the element with index: 1
Monks a
fine xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
Now I'm fetching the element with index: 0
Perl
Now I'm fetching the element with index: 1
Monks
buggy xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
Now I'm fetching the element with index: 0
Now I'm fetching the element with index: 0
Perl
Now I'm fetching the element with index: 1
Now I'm fetching the element with index: 1
Monks
original
Now I'm fetching the element with index: 0
Now I'm fetching the element with index: 0
Perl
Now I'm fetching the element with index: 1
Now I'm fetching the element with index: 1
Monks
E:\dev\LOOSE>
____________________________________________________
** The Third rule of perl club is a statement of fact: pod is sexy.