Make '-s' on the shebang line able to parse -foo=bar switches again.

This feature was broken by change 19695 some years ago
and integrated into perl-5.8.1.  perl-5.8.0 was fine.
Ref http://bugs.activestate.com/show_bug.cgi?id=43483

p4raw-id: //depot/perl@26670

diff --git a/perl.c b/perl.c
index 720fe15..f378578 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -4519,8 +4519,9 @@ Perl_init_argv_symbols(pTHX_ register int argc, register char **argv)
                break;
            }
            if ((s = strchr(argv[0], '='))) {
-               *s++ = '\0';
-               sv_setpv(GvSV(gv_fetchpv(argv[0]+1,TRUE, SVt_PV)),s);
+               *s = '\0';
+               sv_setpv(GvSV(gv_fetchpv(argv[0] + 1, TRUE, SVt_PV)), s + 1);
+               *s = '=';
            }
            else
                sv_setiv(GvSV(gv_fetchpv(argv[0]+1,TRUE, SVt_PV)),1);

diff --git a/t/run/switches.t b/t/run/switches.t
index f654486..a81a962 100644 (file)
--- a/t/run/switches.t
+++ b/t/run/switches.t
@@ -11,7 +11,7 @@ BEGIN {
 
 require "./test.pl";
 
-plan(tests => 30);
+plan(tests => 31);
 
 use Config;
 
@@ -125,11 +125,27 @@ $r = runperl(
 );
 is( $r, '21-', '-s switch parsing' );
 
-# Bug ID 20011106.084
 $filename = 'swstest.tmp';
 SKIP: {
     open my $f, ">$filename" or skip( "Can't write temp file $filename: $!" );
     print $f <<'SWTEST';
+#!perl -s
+BEGIN { print $x,$y; exit }
+SWTEST
+    close $f or die "Could not close: $!";
+    $r = runperl(
+       progfile    => $filename,
+       args        => [ '-x=foo -y' ],
+    );
+    is( $r, 'foo1', '-s on the shebang line' );
+    push @tmpfiles, $filename;
+}
+
+# Bug ID 20011106.084
+$filename = 'swsntest.tmp';
+SKIP: {
+    open my $f, ">$filename" or skip( "Can't write temp file $filename: $!" );
+    print $f <<'SWTEST';
 #!perl -sn
 BEGIN { print $x; exit }
 SWTEST
@@ -138,7 +154,7 @@ SWTEST
        progfile    => $filename,
        args        => [ '-x=foo' ],
     );
-    is( $r, 'foo', '-s on the shebang line' );
+    is( $r, 'foo', '-sn on the shebang line' );
     push @tmpfiles, $filename;
 }