[perl #26587] File::Find clobbers $_

[Wolfgang Loch]

# New Ticket Created by "Wolfgang Loch"
# Please include the string: [perl #26587]
# in the subject line of all future correspondence about this issue.
# <URL: http://rt.perl.org:80/rt3/Ticket/Display.html?id=26587 >

This is a bug report for perl from Wolfgang Loch <wo...@wolosoft.com>,
generated with the help of perlbug 1.34 running under perl v5.8.0.

-----------------------------------------------------------------
[Please enter your report here]

The following line in File::Find 1.04 (line 782) clobbers the
global $_ variable.
Therefore it will create strange side effects if the find() or
finddepth() function is used inside map, grep or foreach
blocks.
The code is:

$_= ($no_chdir ? $dir_name : $dir_rel );

This technique is used several times in this module. An easy fix
would be to use "local $_" before writing to $_.

The bug was found in File::Find version 1.04, but it appears to
be still there in version 1.06 (Perl 5.83).

[Please do not change anything below this line]
-----------------------------------------------------------------
---
Flags:
category=library
severity=low
---
Site configuration information for perl v5.8.0:

Configured by wloch at Mon Sep 22 14:57:27 2003.

Summary of my perl5 (revision 5 version 8 subversion 0) configuration:
Platform:
osname=MSWin32, osvers=4.0, archname=MSWin32-x86-multi-thread
uname=''
config_args='undef'
hint=recommended, useposix=true, d_sigaction=undef
usethreads=undef use5005threads=undef useithreads=define
usemultiplicity=define
useperlio=define d_sfio=undef uselargefiles=undef usesocks=undef
use64bitint=undef use64bitall=undef uselongdouble=undef
usemymalloc=n, bincompat5005=undef
Compiler:
cc='cl', ccflags
='-nologo -Gf -W3 -MD -DNDEBUG -O1 -DWIN32 -D_CONSOLE -DNO_STRICT -DHAVE
_DES_FCRYPT -DPERL_IMPLICIT_CONTEXT -DPERL_IMPLICIT_SYS -DUSE_PERLIO -D
PERL_MSVCRT_READFIX',
optimize='-MD -DNDEBUG -O1',
cppflags='-DWIN32'
ccversion='', gccversion='', gccosandvers=''
intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=1234
d_longlong=undef, longlongsize=8, d_longdbl=define, longdblsize=10
ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t',
lseeksize=4
alignbytes=8, prototype=define
Linker and Libraries:
ld='link', ldflags
'-nologo -nodefaultlib -release -libpath:"C:\epages\Perl\lib\CORE" -ma
chine:x86'
libpth="C:\Programs\Microsoft Visual Studio .NET\VC7\lib"
libs= oldnames.lib kernel32.lib user32.lib gdi32.lib winspool.lib
comdlg32.lib advapi32.lib shell32.lib ole32.lib oleaut32.lib
netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib version.lib
odbc32.lib odbccp32.lib msvcrt.lib
perllibs= oldnames.lib kernel32.lib user32.lib gdi32.lib
winspool.lib comdlg32.lib advapi32.lib shell32.lib ole32.lib
oleaut32.lib netapi32.lib uuid.lib wsock32.lib mpr.lib winmm.lib
version.lib odbc32.lib odbccp32.lib msvcrt.lib
libc=msvcrt.lib, so=dll, useshrplib=yes, libperl=perl58.lib
gnulibc_version='undef'
Dynamic Linking:
dlsrc=dl_win32.xs, dlext=dll, d_dlsymun=undef, ccdlflags=' '
cccdlflags=' ',
ddlflags='-dll -nologo -nodefaultlib -release -libpath:"C:\epages\Perl\
lib\CORE" -machine:x86'

Locally applied patches:

---
@INC for perl v5.8.0:
c:\epages\Cartridges
C:/epages/Perl/lib
C:/epages/Perl/site/lib
.

---
Environment for perl v5.8.0:
HOME (unset)
LANG (unset)
LANGUAGE (unset)
LD_LIBRARY_PATH (unset)
LOGDIR (unset)

PATH=C:\WINNT\system32;C:\WINNT;C:\WINNT\System32\Wbem;C:\Programs\GNU;C
:\programs\Borland\CBuilder\BIN;C:\MySQL\lib\opt;C:\epages\bin;C:\epages
\Sybase\ASE-12_5\dll;C:\epages\Sybase\ASE-12_5\bin;C:\epages\Sybase\OCS-
12_5\dll;C:\epages\Sybase\OCS-12_5\bin;C:\epages\Sybase\ASEP-1_0;C:\epag
es\Sybase\Sybase Central
3.2\win32;C:\epages\ODBC;C:\epages\Perl\bin;C:\Program Files\Common
Files\Talisma Shared;
PERL5LIB=c:\epages\Cartridges
PERL_BADLANG (unset)
SHELL (unset)

[Rafael Garcia-Suarez]

"Wolfgang Loch" (via RT) <perlbug-...@perl.org> wrote:
> The following line in File::Find 1.04 (line 782) clobbers the
> global $_ variable.
> Therefore it will create strange side effects if the find() or
> finddepth() function is used inside map, grep or foreach
> blocks.
> The code is:
>
> $_= ($no_chdir ? $dir_name : $dir_rel );
>
> This technique is used several times in this module. An easy fix
> would be to use "local $_" before writing to $_.
>
> The bug was found in File::Find version 1.04, but it appears to
> be still there in version 1.06 (Perl 5.83).

Could you propose a test case ? This bug is supposed to have been fixed
in 1.06 by the following :

Change 18501 by rgs@rgs-home on 2003/01/16 21:28:42

Subject: Re: [perl #19977] unlocalized $_ in File::Find clobbers upstream $_
From: "Jos I. Boumans" <ka...@dwim.org>
Date: Thu, 16 Jan 2003 14:04:48 +0100
Message-ID: <3E26ADF0...@dwim.org>
(with test tweaks)

[Wolfgang Loch]

Dear Rafael,

> Could you propose a test case ?

The error occured when a module (I don't remember which one) of the
DateTime collection was used by a function that was called inside
foreach(). This module scanned for support files within its BEGIN block
using File::Find. - No, I don't have a simple test case.

> This bug is supposed to have been fixed in 1.06 by the following :
> Change 18501 by rgs@rgs-home on 2003/01/16 21:28:42

Sorry, but I don't know how to access this change number.

Maybe it's fixed in Perl 5.8.3, but I have only 5.8.0. I looked at the
source code of version File::Find 1.06 using search.cpan.org and I could
not find the "local $_" statement. Therefore I assumed that the bug
could still be there.

Regards,
Wolfgang

[Rafael Garcia-Suarez]

"Wolfgang Loch" <wo...@wolosoft.com> wrote:

Sorry, the original patch can be viewed here :

http://public.activestate.com/cgi-bin/perlbrowse?patch=18501

the local($_) is at the top of _find_opt().

[Wolfgang Loch]

> http://public.activestate.com/cgi-bin/perlbrowse?patch=18501
>
> the local($_) is at the top of _find_opt().

You are right, it's there. I was looking for it in _find_dir(), where $_
actually gets overwritten.

Wolfgang

[Mark Jason Dominus]

Rafael Garcia-Suarez <rgarci...@free.fr>:

> the local($_) is at the top of _find_opt().

This is still a bug. It needs to be local(*_).

[Rafael Garcia-Suarez]

Fixed as #22327.

[h...@crypt.org]

Rafael Garcia-Suarez <rgarci...@free.fr> wrote:

Hmm, I wonder whether we owe any duty of care to someone that defines
a global C< sub _ {} >, and plans to call it within their File::Find
callback. Well, maybe not, but it underscores the need for a better
solution - probably the one that makes C< local $_ > do what we want.

Hugo

[Ton Hospel]

In article <200402180236...@zen.crypt.org>,

It also invalidates use of a global %_. Since it actually breaks
reasonable code to protect people who intentionally shot themselves
in the foot, I don't think it should go in.

And actually a solution only impacting $_ exists: wrap the local $_ value
in a for:

Using Mark Jason Dominus' example:

#! /usr/bin/perl -lw
tie $_, "main";
sub TIESCALAR { bless []}
sub FETCH { print "FETCH"; return 119 }
sub STORE { print "STORE $_[1]" }

func();

sub bar {
# Show $_ is global
print;
}

sub func {
for (my $a) {
$_ = 12;
foo::bar();
}
}

[Rafael Garcia-Suarez]

Ton Hospel wrote:
>
> It also invalidates use of a global %_. Since it actually breaks
> reasonable code to protect people who intentionally shot themselves
> in the foot, I don't think it should go in.
>
> And actually a solution only impacting $_ exists: wrap the local $_ value
> in a for:

I thus applied the following solution:

==== //depot/perl/lib/File/Find.pm#75 (text) ====

@@ -591,8 +591,8 @@
local ($wanted_callback, $avoid_nlink, $bydepth, $no_chdir, $follow,
$follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
$pre_process, $post_process, $dangling_symlinks);
- my @_args = @_;
- local($dir, $name, $fullname, $prune, *_);
+ local($dir, $name, $fullname, $prune);
+ for (my $_temp) { # creates a local $_ without retaining magic

my $cwd = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::getcwd();
my $cwd_untainted = $cwd;
@@ -619,7 +619,7 @@
my ($abs_dir, $Is_Dir);

Proc_Top_Item:
- foreach my $TOP (@_args) {
+ foreach my $TOP (@_) {
my $top_item = $TOP;

if ($Is_MacOS) {
@@ -743,6 +743,7 @@
}
}
}
+ }
}

# API:

[Ton Hospel]

In article <20040223232843.3a3310a3.rgarciasuarez@_ree._r>,
Rafael Garcia-Suarez <rgarci...@free.fr> writes:

> Ton Hospel wrote:
>>
>> And actually a solution only impacting $_ exists: wrap the local $_ value
>> in a for:
>

> I thus applied the following solution:
>

In the mean time I found a somewhat less hacky way:

local *_ = \my $a;

Demo:

#! /usr/bin/perl -lw
tie $_, "main";
sub TIESCALAR { bless []}
sub FETCH { print "FETCH"; return 119 }
sub STORE { print "STORE $_[1]" }

%_ = (a => 5);
func();

sub bar {
# Show $_ is global
print;

# Show global %_
print "%_=$_{a}";
}

sub func {
# local $_;
# local *_;
local *_ = \my $a;
$_ = 12;
bar();
}

[Nicholas Clark]

On Wed, Feb 25, 2004 at 04:00:03PM +0000, Ton Hospel wrote:
> In article <20040223232843.3a3310a3.rgarciasuarez@_ree._r>,
> Rafael Garcia-Suarez <rgarci...@free.fr> writes:
> > Ton Hospel wrote:
> >>
> >> And actually a solution only impacting $_ exists: wrap the local $_ value
> >> in a for:
> >
> > I thus applied the following solution:
> >
> In the mean time I found a somewhat less hacky way:
>
> local *_ = \my $a;

Which I liked better, so I made this change:

Change 22401 by nicholas@faith on 2004/02/27 16:27:19

Create a new local $_ without triggering tie by using local *_ = \my $a
(an idea from Ton Hospel, Message-Id: <c1igq3$n84$1...@post.home.lunix>)

Affected files ...

... //depot/perl/lib/File/Find.pm#76 edit
... //depot/perl/lib/File/Find/t/find.t#12 edit

Differences ...

==== //depot/perl/lib/File/Find.pm#76 (text) ====

@@ -592,7 +592,7 @@

$follow_skip, $full_check, $untaint, $untaint_skip, $untaint_pat,
$pre_process, $post_process, $dangling_symlinks);

local($dir, $name, $fullname, $prune);
- for (my $_temp) { # creates a local $_ without retaining magic
+ local *_ = \my $a;

my $cwd = $wanted->{bydepth} ? Cwd::fastcwd() : Cwd::getcwd();
my $cwd_untainted = $cwd;

@@ -743,7 +743,6 @@
}
}
}
- }
}

# API:

==== //depot/perl/lib/File/Find/t/find.t#12 (text) ====

@@ -15,8 +15,8 @@
$SIG{'__WARN__'} = sub { $warn_msg = $_[0]; warn "# $_[0]"; }
}

-if ( $symlink_exists ) { print "1..189\n"; }
-else { print "1..79\n"; }
+if ( $symlink_exists ) { print "1..195\n"; }
+else { print "1..85\n"; }

# Uncomment this to see where File::Find is chdir'ing to. Helpful for
# debugging its little jaunts around the filesystem.
@@ -497,6 +497,41 @@
Check( scalar( keys %pre ) == 0 );
}

+# see thread starting
+# http://www.xray.mpe.mpg.de/mailing-lists/perl5-porters/2004-02/msg00351.html
+{
+ print "# checking that &_ and %_ are still accessible and that\n",
+ "# tie magic on \$_ is not triggered\n";
+
+ my $true_count;
+ my $sub = 0;
+ sub _ {
+ ++$sub;
+ }
+ my $tie_called = 0;
+
+ package Foo;
+ sub STORE {
+ ++$tie_called;
+ }
+ sub FETCH {return 'N'};
+ sub TIESCALAR {bless []};
+ package main;
+
+ Check( scalar( keys %_ ) == 0 );
+ my @foo = 'n';
+ tie $foo[0], "Foo";
+
+ File::Find::find( sub { $true_count++; $_{$_}++; &_; } , 'fa' ) for @foo;
+ untie $_;
+
+ Check( $tie_called == 0);
+ Check( scalar( keys %_ ) == $true_count );
+ Check( $sub == $true_count );
+ Check( scalar( @foo ) == 1);
+ Check( $foo[0] eq 'N' );
+}
+
if ( $symlink_exists ) {
print "# --- symbolic link tests --- \n";
$FastFileTests_OK= 1;