open(my $fh, ">&", STDOUT) should not warn under strict.

p4raw-id: //depot/perl@19173

diff --git a/op.c b/op.c
index 40fbec1..5ccb73d 100644 (file)
--- a/op.c
+++ b/op.c
@@ -5499,6 +5499,25 @@ Perl_ck_open(pTHX_ OP *o)
     }
     if (o->op_type == OP_BACKTICK)
        return o;
+    {
+        /* In case of three-arg dup open remove strictness
+         * from the last arg if it is a bareword. */
+        OP *first = cLISTOPx(o)->op_first; /* The pushmark. */
+        OP *last  = cLISTOPx(o)->op_last;  /* The bareword. */
+        OP *oa;
+        char *mode;
+
+        if ((last->op_type == OP_CONST) &&             /* The bareword. */
+            (last->op_private & OPpCONST_BARE) &&
+            (last->op_private & OPpCONST_STRICT) &&
+            (oa = first->op_sibling) &&                /* The fh. */
+            (oa = oa->op_sibling) &&                   /* The mode. */
+            SvPOK(((SVOP*)oa)->op_sv) &&
+            (mode = SvPVX(((SVOP*)oa)->op_sv)) &&
+            mode[0] == '>' && mode[1] == '&' &&        /* A dup open. */
+            (last == oa->op_sibling))                  /* The bareword. */
+             last->op_private &= ~OPpCONST_STRICT;
+    }
     return ck_fun(o);
 }
 

diff --git a/t/io/open.t b/t/io/open.t
index 300525a..09f2611 100755 (executable)
--- a/t/io/open.t
+++ b/t/io/open.t
@@ -12,7 +12,7 @@ use Config;
 $Is_VMS = $^O eq 'VMS';
 $Is_MacOS = $^O eq 'MacOS';
 
-plan tests => 99;
+plan tests => 100;
 
 my $Perl = which_perl();
 
@@ -228,6 +228,11 @@ like( $@, qr/Bad filehandle:\s+afile/,          '       right error' );
     ok( open(my $stdout, ">&", \*STDOUT),       'dup \*STDOUT into lexical fh');
     ok( open(STDOUT,     ">&", $stdout),        'restore dupped STDOUT from lexical fh');
 
+    {
+       use strict; # the below should not warn
+       ok( open(my $stdout, ">&", STDOUT),         'dup STDOUT into lexical fh');
+    }
+
     # used to try to open a file [perl #17830]
     ok( open(my $stdin,  "<&", fileno STDIN),   'dup fileno(STDIN) into lexical fh');
 }