open(my $FH,..) emits false warning

[p5pRT]

Migrated from rt.perl.org#1827 (status was 'resolved')

Searchable as RT1827$

[p5pRT]

From jarausch@numa1.igpm.rwth-aachen.de

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

Perl Info

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

[p5pRT]

From [Unknown Contact. See original ticket]

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?

Mike Guy

[p5pRT]

From [Unknown Contact. See original ticket]

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

[p5pRT]

From [Unknown Contact. See original ticket]

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.

--
Nick Ing-Simmons <nik@​tiuk.ti.com>
Via, but not speaking for​: Texas Instruments Ltd.

[p5pRT]

From @gsar

On Fri, 26 Nov 1999 15​:13​:06 GMT, Nick Ing-Simmons wrote​:

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

[p5pRT]

From [Unknown Contact. See original ticket]

Gurusamy Sarathy <gsar@​ActiveState.com> wrote

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

[p5pRT]

From @gsar

On Fri, 26 Nov 1999 14​:07​:07 +0100, Helmut Jarausch wrote​:

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

Inline Patch

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