Skip Menu |
Report information
Id: 1827
Status: resolved
Priority: 0/
Queue: perl5

Owner: Nobody
Requestors: jarausch [at] numa1.igpm.rwth-aachen.de
Cc:
AdminCc:

Operating System: irix
PatchStatus: (no value)
Severity: medium
Type: library
Perl Version: (no value)
Fixed In: (no value)



Date: Fri, 26 Nov 1999 14:07:07 +0100 (CST)
From: jarausch [...] numa1.igpm.rwth-aachen.de (Helmut Jarausch)
Subject: open(my $FH,..) emits false warning
To: perlbug [...] perl.com
Download (untitled) / with headers
text/plain 2.5k
----------------------------------------------------------------- [Please enter your report here] The script: perl -w <<\EOP use strict; sub Check { open(my $FH,">dummy"); # line 4 } Check; EOP emits incorrectly:\ Use of uninitialized value at - line 4. This is perl 5.005_62 + Sarathy's patches upto 4590 plus most of Ilya's patches [Please do not change anything below this line] ----------------------------------------------------------------- --- Site configuration information for perl 5.00563: Configured by jarausch at Thu Nov 11 12:46:47 CST 1999. Summary of my perl5 (revision 5.0 version 5 subversion 63) configuration: Platform: osname=irix, osvers=6.5, archname=IP26-irix uname='irix64 numa1 6.5 07151439 ip26 ' config_args='-Dcc=cc -Dprefix=/usr/LOCAL -Dlocincpth=/usr/LOCAL/include -Dloclibpth=/usr/LOCAL/lib' hint=previous, useposix=true, d_sigaction=define usethreads=undef useperlio=undef d_sfio=undef use64bits=undef usemultiplicity=undef Compiler: cc='cc', optimize='-O3 -OPT:space=on -mips4', gccversion= cppflags='-D_BSD_TYPES -D_BSD_TIME -I/usr/LOCAL/include -DLANGUAGE_C' ccflags ='-D_BSD_TYPES -D_BSD_TIME -woff 1009,1110,1184 -I/usr/LOCAL/include -DLANGUAGE_C' stdchar='unsigned char', d_stdstdio=define, usevfork=false intsize=4, longsize=4, ptrsize=4, doublesize=8 d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16 alignbytes=8, usemymalloc=y, prototype=define Linker and Libraries: ld='cc', ldflags ='-mips4 -Wl,-woff,84 -L/usr/LOCAL/lib' libpth=/usr/LOCAL/lib /usr/lib32 /lib32 libs=-lgdbm -ldb -lm -lc libc=/usr/lib32/libc.so, so=so, useshrplib=true, libperl=libperl.so Dynamic Linking: dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags=' -Wl,-rpath,/usr/LOCAL/lib/perl5/5.00562/IP26-irix/CORE' cccdlflags='-Wl,-rpath,/usr/LOCAL/lib/perl5/5.00562/IP26-irix/CORE', lddlflags='-shared -L/usr/LOCAL/lib' Locally applied patches: --- @INC for perl 5.00563: /usr/LOCAL/lib/perl5/5.00562/IP26-irix /usr/LOCAL/lib/perl5/5.00562 /usr/LOCAL/lib/site_perl/5.00562/IP26-irix /usr/LOCAL/lib/site_perl . --- Environment for perl 5.00563: HOME=/usr/people/jarausch LANG=C LANGUAGE (unset) LD_LIBRARY_PATH (unset) LOGDIR (unset) PATH=.:/usr/people/jarausch/bin:/usr/PRIVATE/bin:/usr/LOCAL/bin:/usr/LOCAL/teTeX/bin:/usr/bin:/usr/java/bin:/usr/bsd:/bin:/usr/bin/X11:/usr/local/bin:/usr/local/bin/X11:/usr/sbin:/usr/demos/bin PERL_BADLANG (unset) SHELL=/bin/zsh
To: jarausch [...] numa1.igpm.rwth-aachen.de, perl5-porters [...] perl.org
Subject: Re: [ID 19991126.001] open(my $FH,..) emits false warning
From: "M.J.T. Guy" <mjtg [...] cus.cam.ac.uk>
Date: Fri, 26 Nov 1999 13:42:37 +0000
Download (untitled) / with headers
text/plain 223b
jarausch@numa1.igpm.rwth-aachen.de (Helmut Jarausch) wrote Show quoted text
> sub Check { > open(my $FH,">dummy"); # line 4 > }
Show quoted text
> Use of uninitialized value at - line 4.
$FH hasn't been given a value, so what do you expect? Mike Guy
To: "M.J.T. Guy" <mjtg [...] cus.cam.ac.uk>
Cc: jarausch [...] numa1.igpm.rwth-aachen.de, perl5-porters [...] perl.org
Subject: Re: [ID 19991126.001] open(my $FH,..) emits false warning
Date: Fri, 26 Nov 1999 07:56:13 -0700
From: Tom Christiansen <tchrist [...] jhereg.perl.com>
Download (untitled) / with headers
text/plain 202b
Show quoted text
>> sub Check { >> open(my $FH,">dummy"); # line 4 >> } >> Use of uninitialized value at - line 4.
>$FH hasn't been given a value, so what do you expect?
Quiet autovivification of the handle. --tom
Date: Fri, 26 Nov 1999 15:13:06 GMT
Subject: Re: [ID 19991126.001] open(my $FH,..) emits false warning
From: Nick Ing-Simmons <nik [...] tiuk.ti.com>
To: mjtg [...] cus.cam.ac.uk
Cc: jarausch [...] numa1.igpm.rwth-aachen.de, perl5-porters [...] perl.org
Download (untitled) / with headers
text/plain 457b
M . J . T . Guy <mjtg@cus.cam.ac.uk> writes: Show quoted text
>jarausch@numa1.igpm.rwth-aachen.de (Helmut Jarausch) wrote
>> sub Check { >> open(my $FH,">dummy"); # line 4 >> }
>
>> Use of uninitialized value at - line 4.
> >$FH hasn't been given a value, so what do you expect?
In 5.005_5X the my $FH is supposed to be vivified by open et al. Looks like I/we botched something. -- Nick Ing-Simmons <nik@tiuk.ti.com> Via, but not speaking for: Texas Instruments Ltd.
To: Nick Ing-Simmons <nik [...] tiuk.ti.com>
Cc: mjtg [...] cus.cam.ac.uk, jarausch [...] numa1.igpm.rwth-aachen.de, perl5-porters [...] perl.org
Subject: Re: [ID 19991126.001] open(my $FH,..) emits false warning
Date: Fri, 26 Nov 1999 08:09:32 -0800
From: Gurusamy Sarathy <gsar [...] ActiveState.com>
Download (untitled) / with headers
text/plain 676b
On Fri, 26 Nov 1999 15:13:06 GMT, Nick Ing-Simmons wrote: Show quoted text
>M . J . T . Guy <mjtg@cus.cam.ac.uk> writes:
>>jarausch@numa1.igpm.rwth-aachen.de (Helmut Jarausch) wrote
>>> sub Check { >>> open(my $FH,">dummy"); # line 4 >>> }
>>
>>> Use of uninitialized value at - line 4.
>> >>$FH hasn't been given a value, so what do you expect?
> >In 5.005_5X the my $FH is supposed to be vivified by open et al. >Looks like I/we botched something.
The run time lookup of the lexical's name in PL_comppad_name looks like the problem. PL_comppad_name is not usually set to the executing sub's pad at run time. It's value is valid only during compile time. Sarathy gsar@ActiveState.com
To: perl5-porters [...] perl.org
Subject: Re: [ID 19991126.001] open(my $FH,..) emits false warning
From: "M.J.T. Guy" <mjtg [...] cus.cam.ac.uk>
Date: Fri, 26 Nov 1999 16:13:13 +0000
Download (untitled) / with headers
text/plain 511b
Gurusamy Sarathy <gsar@ActiveState.com> wrote Show quoted text
> The run time lookup of the lexical's name in PL_comppad_name looks > like the problem. PL_comppad_name is not usually set to the executing > sub's pad at run time. It's value is valid only during compile time.
It's certainly specific to that use of a lexical. Both of the following work fine: %perl -w my $a; open $a, '/etc/passwd' or die "open:$!\n"; print <$a>; __END__ %perl -w open $a, '/etc/passwd' or die "open:$!\n"; print <$a>; __END__ Mike Guy
To: jarausch [...] numa1.igpm.rwth-aachen.de
Cc: perl5-porters [...] perl.org, gsar [...] activestate.com
Subject: Re: [ID 19991126.001] open(my $FH,..) emits false warning
Date: Fri, 03 Dec 1999 17:19:03 -0800
From: Gurusamy Sarathy <gsar [...] ActiveState.com>
Download (untitled) / with headers
text/plain 12.4k
On Fri, 26 Nov 1999 14:07:07 +0100, Helmut Jarausch wrote: Show quoted text
>The script: > >perl -w <<\EOP >use strict; > >sub Check { > open(my $FH,">dummy"); # line 4 >} > >Check; >EOP > >emits incorrectly:\ > >Use of uninitialized value at - line 4.
Try this patch. Sarathy gsar@ActiveState.com -----------------------------------8<----------------------------------- Change 4639 by gsar@auger on 1999/12/04 01:00:49 better implementation of change#3326; open(local $foo,...) now allowed in addition to any uninitialized variable, for consistency with how autovivification works elsewhere; add code to use the variable name as the name of the handle for simple variables, so that diagnostics report the handle: "... at - line 1, <$foo> line 10." Affected files ... ... //depot/perl/op.c#226 edit ... //depot/perl/pod/perldelta.pod#115 edit ... //depot/perl/pp.c#161 edit ... //depot/perl/t/io/open.t#11 edit Differences ... ==== //depot/perl/op.c#226 (text) ==== Index: perl/op.c --- perl/op.c.~1~ Fri Dec 3 17:00:53 1999 +++ perl/op.c Fri Dec 3 17:00:53 1999 @@ -5286,26 +5286,46 @@ else { I32 flags = OPf_SPECIAL; I32 priv = 0; + PADOFFSET targ = 0; + /* is this op a FH constructor? */ if (is_handle_constructor(o,numargs)) { - flags = 0; - /* Set a flag to tell rv2gv to vivify + char *name = Nullch; + STRLEN len; + + flags = 0; + /* Set a flag to tell rv2gv to vivify * need to "prove" flag does not mean something * else already - NI-S 1999/05/07 - */ - priv = OPpDEREF; -#if 0 - /* Helps with open($array[$n],...) - but is too simplistic - need to do selectively - */ - mod(kid,type); -#endif + */ + priv = OPpDEREF; + if (kid->op_type == OP_PADSV) { + SV **namep = av_fetch(PL_comppad_name, + kid->op_targ, 4); + if (namep && *namep) + name = SvPV(*namep, len); + } + else if (kid->op_type == OP_RV2SV + && kUNOP->op_first->op_type == OP_GV) + { + GV *gv = cGVOPx_gv(kUNOP->op_first); + name = GvNAME(gv); + len = GvNAMELEN(gv); + } + if (name) { + SV *namesv; + targ = pad_alloc(OP_RV2GV, SVs_PADTMP); + namesv = PL_curpad[targ]; + SvUPGRADE(namesv, SVt_PV); + if (*name != '$') + sv_setpvn(namesv, "$", 1); + sv_catpvn(namesv, name, len); + } } kid->op_sibling = 0; kid = newUNOP(OP_RV2GV, flags, scalar(kid)); - if (priv) { - kid->op_private |= priv; - } + kid->op_targ = targ; + kid->op_private |= priv; } kid->op_sibling = sibl; *tokid = kid; ==== //depot/perl/pod/perldelta.pod#115 (text) ==== Index: perl/pod/perldelta.pod --- perl/pod/perldelta.pod.~1~ Fri Dec 3 17:00:53 1999 +++ perl/pod/perldelta.pod Fri Dec 3 17:00:53 1999 @@ -360,11 +360,14 @@ =head2 Filehandles can be autovivified -The construct C<open(my $fh, ...)> can be used to create filehandles -more easily. The filehandle will be automatically closed at the end -of the scope of $fh, provided there are no other references to it. This -largely eliminates the need for typeglobs when opening filehandles -that must be passed around, as in the following example: +Similar to how constructs such as C<$x->[0]> autovivify a reference, +open() now autovivifies a filehandle if the first argument is an +uninitialized variable. This allows the constructs C<open(my $fh, ...)> and +C<open(local $fh,...)> to be used to create filehandles that will +conveniently be closed automatically when the scope ends, provided there +are no other references to them. This largely eliminates the need for +typeglobs when opening filehandles that must be passed around, as in the +following example: sub myopen { open my $fh, "@_" ==== //depot/perl/pp.c#161 (text) ==== Index: perl/pp.c --- perl/pp.c.~1~ Fri Dec 3 17:00:53 1999 +++ perl/pp.c Fri Dec 3 17:00:53 1999 @@ -241,26 +241,25 @@ * NI-S 1999/05/07 */ if (PL_op->op_private & OPpDEREF) { - GV *gv = (GV *) newSV(0); - STRLEN len = 0; - char *name = ""; - if (cUNOP->op_first->op_type == OP_PADSV) { - SV **namep = av_fetch(PL_comppad_name, cUNOP->op_first->op_targ, 4); - if (namep && *namep) { - name = SvPV(*namep,len); - if (!name) { - name = ""; - len = 0; - } - } + char *name; + GV *gv; + if (cUNOP->op_targ) { + STRLEN len; + SV *namesv = PL_curpad[cUNOP->op_targ]; + name = SvPV(namesv, len); + gv = (GV*)NEWSV(0,len); + gv_init(gv, CopSTASH(PL_curcop), name, len, 0); + } + else { + name = CopSTASHPV(PL_curcop); + gv = newGVgen(name); } - gv_init(gv, CopSTASH(PL_curcop), name, len, 0); sv_upgrade(sv, SVt_RV); - SvRV(sv) = (SV *) gv; + SvRV(sv) = (SV*)gv; SvROK_on(sv); SvSETMAGIC(sv); goto wasref; - } + } if (PL_op->op_flags & OPf_REF || PL_op->op_private & HINT_STRICT_REFS) DIE(aTHX_ PL_no_usym, "a symbol"); ==== //depot/perl/t/io/open.t#11 (xtext) ==== Index: perl/t/io/open.t --- perl/t/io/open.t.~1~ Fri Dec 3 17:00:53 1999 +++ perl/t/io/open.t Fri Dec 3 17:00:53 1999 @@ -5,110 +5,256 @@ $^W = 1; $Is_VMS = $^O eq 'VMS'; -print "1..32\n"; +print "1..64\n"; + +my $test = 1; + +sub ok { print "ok $test\n"; $test++ } # my $file tests +# 1..9 { -unlink("afile") if -f "afile"; -print "$!\nnot " unless open(my $f,"+>afile"); -print "ok 1\n"; -binmode $f; -print "not " unless -f "afile"; -print "ok 2\n"; -print "not " unless print $f "SomeData\n"; -print "ok 3\n"; -print "not " unless tell($f) == 9; -print "ok 4\n"; -print "not " unless seek($f,0,0); -print "ok 5\n"; -$b = <$f>; -print "not " unless $b eq "SomeData\n"; -print "ok 6\n"; -print "not " unless -f $f; -print "ok 7\n"; -eval { die "Message" }; -# warn $@; -print "not " unless $@ =~ /<\$f> line 1/; -print "ok 8\n"; -print "not " unless close($f); -print "ok 9\n"; -unlink("afile"); + unlink("afile") if -f "afile"; + print "$!\nnot " unless open(my $f,"+>afile"); + ok; + binmode $f; + print "not " unless -f "afile"; + ok; + print "not " unless print $f "SomeData\n"; + ok; + print "not " unless tell($f) == 9; + ok; + print "not " unless seek($f,0,0); + ok; + $b = <$f>; + print "not " unless $b eq "SomeData\n"; + ok; + print "not " unless -f $f; + ok; + eval { die "Message" }; + # warn $@; + print "not " unless $@ =~ /<\$f> line 1/; + ok; + print "not " unless close($f); + ok; + unlink("afile"); } + +# 10..12 { -print "# \$!='$!'\nnot " unless open(my $f,'>', 'afile'); -print "ok 10\n"; -print $f "a row\n"; -print "not " unless close($f); -print "ok 11\n"; -print "not " unless -s 'afile' < 10; -print "ok 12\n"; + print "# \$!='$!'\nnot " unless open(my $f,'>', 'afile'); + ok; + print $f "a row\n"; + print "not " unless close($f); + ok; + print "not " unless -s 'afile' < 10; + ok; } + +# 13..15 { -print "# \$!='$!'\nnot " unless open(my $f,'>>', 'afile'); -print "ok 13\n"; -print $f "a row\n"; -print "not " unless close($f); -print "ok 14\n"; -print "not " unless -s 'afile' > 10; -print "ok 15\n"; + print "# \$!='$!'\nnot " unless open(my $f,'>>', 'afile'); + ok; + print $f "a row\n"; + print "not " unless close($f); + ok; + print "not " unless -s 'afile' > 10; + ok; } + +# 16..18 { -print "# \$!='$!'\nnot " unless open(my $f, '<', 'afile'); -print "ok 16\n"; -@rows = <$f>; -print "not " unless @rows == 2; -print "ok 17\n"; -print "not " unless close($f); -print "ok 18\n"; + print "# \$!='$!'\nnot " unless open(my $f, '<', 'afile'); + ok; + @rows = <$f>; + print "not " unless @rows == 2; + ok; + print "not " unless close($f); + ok; } + +# 19..23 { -print "not " unless -s 'afile' < 20; -print "ok 19\n"; -print "# \$!='$!'\nnot " unless open(my $f, '+<', 'afile'); -print "ok 20\n"; -@rows = <$f>; -print "not " unless @rows == 2; -print "ok 21\n"; -seek $f, 0, 1; -print $f "yet another row\n"; -print "not " unless close($f); -print "ok 22\n"; -print "not " unless -s 'afile' > 20; -print "ok 23\n"; + print "not " unless -s 'afile' < 20; + ok; + print "# \$!='$!'\nnot " unless open(my $f, '+<', 'afile'); + ok; + @rows = <$f>; + print "not " unless @rows == 2; + ok; + seek $f, 0, 1; + print $f "yet another row\n"; + print "not " unless close($f); + ok; + print "not " unless -s 'afile' > 20; + ok; + + unlink("afile"); +} -unlink("afile"); +# 24..26 +if ($Is_VMS) { + for (24..26) { print "ok $_ # skipped: not Unix fork\n"; } } -if ($Is_VMS) { for (24..26) { print "ok $_ # skipped: not Unix fork\n"; } } else { -print "# \$!='$!'\nnot " unless open(my $f, '-|', <<'EOC'); -./perl -e "print qq(a row\n); print qq(another row\n)" + print "# \$!='$!'\nnot " unless open(my $f, '-|', <<'EOC'); + ./perl -e "print qq(a row\n); print qq(another row\n)" EOC -print "ok 24\n"; -@rows = <$f>; -print "not " unless @rows == 2; -print "ok 25\n"; -print "not " unless close($f); -print "ok 26\n"; + ok; + @rows = <$f>; + print "not " unless @rows == 2; + ok; + print "not " unless close($f); + ok; +} + +# 27..30 +if ($Is_VMS) { + for (27..30) { print "ok $_ # skipped: not Unix fork\n"; } } -if ($Is_VMS) { for (27..30) { print "ok $_ # skipped: not Unix fork\n"; } } else { -print "# \$!='$!'\nnot " unless open(my $f, '|-', <<'EOC'); -./perl -pe "s/^not //" + print "# \$!='$!'\nnot " unless open(my $f, '|-', <<'EOC'); + ./perl -pe "s/^not //" EOC -print "ok 27\n"; -@rows = <$f>; -print $f "not ok 28\n"; -print $f "not ok 29\n"; -print "#\nnot " unless close($f); -sleep 1; -print "ok 30\n"; + ok; + @rows = <$f>; + print $f "not ok $test\n"; $test++; + print $f "not ok $test\n"; $test++; + print "#\nnot " unless close($f); + sleep 1; + ok; } +# 31..32 eval <<'EOE' and print "not "; open my $f, '<&', 'afile'; +1; +EOE +ok; +$@ =~ /Unknown open\(\) mode \'<&\'/ or print "not "; +ok; + +# local $file tests + +# 33..41 +{ + unlink("afile") if -f "afile"; + print "$!\nnot " unless open(local $f,"+>afile"); + ok; + binmode $f; + print "not " unless -f "afile"; + ok; + print "not " unless print $f "SomeData\n"; + ok; + print "not " unless tell($f) == 9; + ok; + print "not " unless seek($f,0,0); + ok; + $b = <$f>; + print "not " unless $b eq "SomeData\n"; + ok; + print "not " unless -f $f; + ok; + eval { die "Message" }; + # warn $@; + print "not " unless $@ =~ /<\$f> line 1/; + ok; + print "not " unless close($f); + ok; + unlink("afile"); +} + +# 42..44 +{ + print "# \$!='$!'\nnot " unless open(local $f,'>', 'afile'); + ok; + print $f "a row\n"; + print "not " unless close($f); + ok; + print "not " unless -s 'afile' < 10; + ok; +} + +# 45..47 +{ + print "# \$!='$!'\nnot " unless open(local $f,'>>', 'afile'); + ok; + print $f "a row\n"; + print "not " unless close($f); + ok; + print "not " unless -s 'afile' > 10; + ok; +} + +# 48..50 +{ + print "# \$!='$!'\nnot " unless open(local $f, '<', 'afile'); + ok; + @rows = <$f>; + print "not " unless @rows == 2; + ok; + print "not " unless close($f); + ok; +} + +# 51..55 +{ + print "not " unless -s 'afile' < 20; + ok; + print "# \$!='$!'\nnot " unless open(local $f, '+<', 'afile'); + ok; + @rows = <$f>; + print "not " unless @rows == 2; + ok; + seek $f, 0, 1; + print $f "yet another row\n"; + print "not " unless close($f); + ok; + print "not " unless -s 'afile' > 20; + ok; + + unlink("afile"); +} + +# 56..58 +if ($Is_VMS) { + for (56..58) { print "ok $_ # skipped: not Unix fork\n"; } +} +else { + print "# \$!='$!'\nnot " unless open(local $f, '-|', <<'EOC'); + ./perl -e "print qq(a row\n); print qq(another row\n)" +EOC + ok; + @rows = <$f>; + print "not " unless @rows == 2; + ok; + print "not " unless close($f); + ok; +} + +# 59..62 +if ($Is_VMS) { + for (59..62) { print "ok $_ # skipped: not Unix fork\n"; } +} +else { + print "# \$!='$!'\nnot " unless open(local $f, '|-', <<'EOC'); + ./perl -pe "s/^not //" +EOC + ok; + @rows = <$f>; + print $f "not ok $test\n"; $test++; + print $f "not ok $test\n"; $test++; + print "#\nnot " unless close($f); + sleep 1; + ok; +} + +# 63..64 +eval <<'EOE' and print "not "; +open local $f, '<&', 'afile'; 1; EOE -print "ok 31\n"; +ok; $@ =~ /Unknown open\(\) mode \'<&\'/ or print "not "; -print "ok 32\n"; +ok; End of Patch.


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

For issues related to this RT instance (aka "perlbug"), please contact perlbug-admin at perl.org