-
Notifications
You must be signed in to change notification settings - Fork 560
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
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. |
Migrated from rt.perl.org#1827 (status was 'resolved')
Searchable as RT1827$
The text was updated successfully, but these errors were encountered: