open(my $FH,..) emits false warning #894
Labels
Comments
From jarausch@numa1.igpm.rwth-aachen.deThe script: perl -w <<\EOP sub Check { Check; emits incorrectly:\ Use of uninitialized value at - line 4. This is perl 5.005_62 + Sarathy's patches upto 4590 plus most of Perl Info |
From [Unknown Contact. See original ticket]jarausch@numa1.igpm.rwth-aachen.de (Helmut Jarausch) wrote
$FH hasn't been given a value, so what do you expect? Mike Guy |
From [Unknown Contact. See original ticket]
Quiet autovivification of the handle. --tom |
From [Unknown Contact. See original ticket]M . J . T . Guy <mjtg@cus.cam.ac.uk> writes:
In 5.005_5X the my $FH is supposed to be vivified by open et al. -- |
From @gsarOn Fri, 26 Nov 1999 15:13:06 GMT, Nick Ing-Simmons wrote:
The run time lookup of the lexical's name in PL_comppad_name looks Sarathy |
From [Unknown Contact. See original ticket]Gurusamy Sarathy <gsar@ActiveState.com> wrote
It's certainly specific to that use of a lexical. Both of the %perl -w %perl -w Mike Guy |
From @gsarOn Fri, 26 Nov 1999 14:07:07 +0100, Helmut Jarausch wrote:
Try this patch. Sarathy 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. |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Migrated from rt.perl.org#1827 (status was 'resolved')
Searchable as RT1827$
The text was updated successfully, but these errors were encountered: