Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

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

Closed
p5pRT opened this issue Nov 26, 1999 · 7 comments
Closed

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

p5pRT opened this issue Nov 26, 1999 · 7 comments

Comments

@p5pRT
Copy link

@p5pRT p5pRT commented Nov 26, 1999

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

Searchable as RT1827$

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Nov 26, 1999

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

Loading

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Nov 26, 1999

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

Loading

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Nov 26, 1999

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

Loading

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Nov 26, 1999

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.

Loading

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Nov 26, 1999

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

Loading

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Nov 26, 1999

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

Loading

@p5pRT
Copy link
Author

@p5pRT p5pRT commented Dec 3, 1999

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.

Loading

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Projects
None yet
Linked pull requests

Successfully merging a pull request may close this issue.

None yet
1 participant