dcb3b7
From 03fcc0c44bc7972f2c92736daae5b63d601b7c49 Mon Sep 17 00:00:00 2001
dcb3b7
From: Dan Collins <dcollinsn@gmail.com>
dcb3b7
Date: Fri, 23 Sep 2016 01:21:20 -0400
dcb3b7
Subject: [PATCH] [rt #129336] #!perl -i u erroneously interpreted as -u
dcb3b7
MIME-Version: 1.0
dcb3b7
Content-Type: text/plain; charset=UTF-8
dcb3b7
Content-Transfer-Encoding: 8bit
dcb3b7
dcb3b7
Ported to 5.24.0:
dcb3b7
dcb3b7
commit f54cfdacff1f3744ef08fc70f1f3bc6c7d862e83
dcb3b7
Author: Dan Collins <dcollinsn@gmail.com>
dcb3b7
Date:   Fri Sep 23 01:21:20 2016 -0400
dcb3b7
dcb3b7
    [rt #129336] #!perl -i u erroneously interpreted as -u
dcb3b7
dcb3b7
    Perl_moreswitches processes a single switch, and returns a pointer
dcb3b7
    to the start of the next switch. It can return either
dcb3b7
    the a pointer to the next flag itself:
dcb3b7
dcb3b7
        #!perl -n -p
dcb3b7
                   ^ Can point here
dcb3b7
dcb3b7
    Or, to the space before the next "arg":
dcb3b7
dcb3b7
        #!perl -n -p
dcb3b7
                 ^ Can point here
dcb3b7
dcb3b7
    (Where the next call to Perl_moreswitches will consume " -".)
dcb3b7
dcb3b7
    In the case of -i[extension], the pointer is by default pointing at
dcb3b7
    the space after the end of the argument. The current code tries to
dcb3b7
    do the former, by unconditionally advancing the pointer, and then
dcb3b7
    advancing it again if it is on a '-'. But that is incorrect:
dcb3b7
dcb3b7
        #!perl -i p
dcb3b7
                  ^ Will point here, but that isn't a flag
dcb3b7
dcb3b7
    I could fix this by removing the unconditional s++, and having it
dcb3b7
    increment by 2 if *(s+1)=='-', but this work isn't actually
dcb3b7
    necessary - it's better to just leave it pointing at the space after
dcb3b7
    the argument.
dcb3b7
dcb3b7
Signed-off-by: Petr Písař <ppisar@redhat.com>
dcb3b7
---
dcb3b7
 perl.c     | 5 -----
dcb3b7
 t/op/lex.t | 9 ++++++++-
dcb3b7
 2 files changed, 8 insertions(+), 6 deletions(-)
dcb3b7
dcb3b7
diff --git a/perl.c b/perl.c
dcb3b7
index 228a0d8..5cc7d0b 100644
dcb3b7
--- a/perl.c
dcb3b7
+++ b/perl.c
dcb3b7
@@ -3306,11 +3306,6 @@ Perl_moreswitches(pTHX_ const char *s)
dcb3b7
 
dcb3b7
 	    PL_inplace = savepvn(start, s - start);
dcb3b7
 	}
dcb3b7
-	if (*s) {
dcb3b7
-	    ++s;
dcb3b7
-	    if (*s == '-')	/* Additional switches on #! line. */
dcb3b7
-		s++;
dcb3b7
-	}
dcb3b7
 	return s;
dcb3b7
     case 'I':	/* -I handled both here and in parse_body() */
dcb3b7
 	forbid_setid('I', FALSE);
dcb3b7
diff --git a/t/op/lex.t b/t/op/lex.t
dcb3b7
index c515449..9ada592 100644
dcb3b7
--- a/t/op/lex.t
dcb3b7
+++ b/t/op/lex.t
dcb3b7
@@ -7,7 +7,7 @@ use warnings;
dcb3b7
 
dcb3b7
 BEGIN { chdir 't' if -d 't'; require './test.pl'; }
dcb3b7
 
dcb3b7
-plan(tests => 26);
dcb3b7
+plan(tests => 27);
dcb3b7
 
dcb3b7
 {
dcb3b7
     no warnings 'deprecated';
dcb3b7
@@ -209,3 +209,10 @@ fresh_perl_is(
dcb3b7
    { stderr => 1 },
dcb3b7
   's;@{<
dcb3b7
 );
dcb3b7
+
dcb3b7
+fresh_perl_like(
dcb3b7
+    "#!perl -i u\nprint 'OK'",
dcb3b7
+    qr/OK/,
dcb3b7
+    {},
dcb3b7
+    '[perl #129336] - #!perl -i argument handling'
dcb3b7
+);
dcb3b7
-- 
dcb3b7
2.7.4
dcb3b7