This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Call FETCH once on handle passed as 3rd arg to open()
authorFather Chrysostomos <sprout@cpan.org>
Sat, 19 Nov 2011 22:35:24 +0000 (14:35 -0800)
committerFather Chrysostomos <sprout@cpan.org>
Sun, 20 Nov 2011 00:14:54 +0000 (16:14 -0800)
When open() has three arguments and the second ends with & the third
argument is treated as a handle.

In some cases get-magic was being skipped; in others, it was being
called three times.

This commit fixes it by modifying sv_2io.

In 5.8.x (before commit 7a5fd60d4), sv_2io did not call get-magic at
all except when croaking ("Bad filehandle: %"SVf).  In 5.10.0 (after
commit 7a5fd60d4), it started calling get-magic only if the sv was
neither a glob, a reference, or undef.  So it has never been reliable
in its invocation of get-magic.

sv_2io now consistently skips get-magic on the sv passed in directly
to it (open(), the only caller in the core, has already called get-
magic before passing it in).  It now calls get-magic on SvRV(sv) if
what is passed in is a reference, so open(fh, ">&", \$tied) will work.

Interestingly, open supports multiple levels of references:

\\\\\\\\\\\\open+f,">&",\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
 \\\\\\\\\\\*STDOUT;print{f}"Just another Perl hacker,\n",.\\\\\\\y\\\

sv.c
t/op/tie_fetch_count.t

diff --git a/sv.c b/sv.c
index d9153b6..03aff4e 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -8842,15 +8842,23 @@ Perl_sv_2io(pTHX_ SV *const sv)
     default:
        if (!SvOK(sv))
            Perl_croak(aTHX_ PL_no_usym, "filehandle");
-       if (SvROK(sv))
+       if (SvROK(sv)) {
+           SvGETMAGIC(SvRV(sv));
            return sv_2io(SvRV(sv));
-       gv = gv_fetchsv(sv, 0, SVt_PVIO);
+       }
+       gv = gv_fetchsv_nomg(sv, 0, SVt_PVIO);
        if (gv)
            io = GvIO(gv);
        else
            io = 0;
-       if (!io)
-           Perl_croak(aTHX_ "Bad filehandle: %"SVf, SVfARG(sv));
+       if (!io) {
+           SV *newsv = sv;
+           if (SvGMAGICAL(sv)) {
+               newsv = sv_newmortal();
+               sv_setsv_nomg(newsv, sv);
+           }
+           Perl_croak(aTHX_ "Bad filehandle: %"SVf, SVfARG(newsv));
+       }
        break;
     }
     return io;
index 85d88d6..f308c33 100644 (file)
@@ -7,7 +7,7 @@ BEGIN {
     chdir 't' if -d 't';
     @INC = '../lib';
     require './test.pl';
-    plan (tests => 287);
+    plan (tests => 289);
 }
 
 use strict;
@@ -210,7 +210,7 @@ $var8->bolgy            ; check_count '->method';
 
 # Functions that operate on filenames or filehandles
 for ([chdir=>''],[chmod=>'0,'],[chown=>'0,0,'],[utime=>'0,0,'],
-     [truncate=>'',',0'],[stat=>''],[lstat=>'']) {
+     [truncate=>'',',0'],[stat=>''],[lstat=>''],[open=>'my $fh,"<&",']) {
     my($op,$args,$postargs) = @$_; $postargs //= '';
     # This line makes $var8 hold a glob:
     $var8 = *dummy; $dummy = $var8; $count = 0;