-s on #! line

Message-ID: <20011107222339.E729@rafael>

p4raw-id: //depot/perl@12900

5 files changed, 42 insertions, 20 deletions

diff --git a/embed.h b/embed.h
index bef032d98a..a3d430e245 100644
--- a/embed.h
+++ b/embed.h
@@ -262,6 +262,7 @@
 #define ibcmp			Perl_ibcmp
 #define ibcmp_locale		Perl_ibcmp_locale
 #define ingroup			Perl_ingroup
+#define init_argv_symbols	Perl_init_argv_symbols
 #define init_debugger		Perl_init_debugger
 #define init_stacks		Perl_init_stacks
 #define init_tm			Perl_init_tm
@@ -1781,6 +1782,7 @@
 #define ibcmp(a,b,c)		Perl_ibcmp(aTHX_ a,b,c)
 #define ibcmp_locale(a,b,c)	Perl_ibcmp_locale(aTHX_ a,b,c)
 #define ingroup(a,b)		Perl_ingroup(aTHX_ a,b)
+#define init_argv_symbols(a,b)	Perl_init_argv_symbols(aTHX_ a,b)
 #define init_debugger()		Perl_init_debugger(aTHX)
 #define init_stacks()		Perl_init_stacks(aTHX)
 #define init_tm(a)		Perl_init_tm(aTHX_ a)
diff --git a/embed.pl b/embed.pl
index eeee42147b..25b39468da 100755
--- a/embed.pl
+++ b/embed.pl
@@ -1334,6 +1334,7 @@ Apd	|void	|hv_undef	|HV* tb
 Ap	|I32	|ibcmp		|const char* a|const char* b|I32 len
 Ap	|I32	|ibcmp_locale	|const char* a|const char* b|I32 len
 p	|bool	|ingroup	|Gid_t testgid|Uid_t effective
+p	|void	|init_argv_symbols|int|char **
 p	|void	|init_debugger
 Ap	|void	|init_stacks
 Ap	|void	|init_tm	|struct tm *ptm
diff --git a/perl.c b/perl.c
index ee55c911e2..292b56b3ec 100644
--- a/perl.c
+++ b/perl.c
@@ -3370,17 +3370,10 @@ S_init_predump_symbols(pTHX)
     PL_osname = savepv(OSNAME);
 }
 
-STATIC void
-S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register char **env)
+void
+Perl_init_argv_symbols(pTHX_ register int argc, register char **argv)
 {
     char *s;
-    SV *sv;
-    GV* tmpgv;
-#ifdef NEED_ENVIRON_DUP_FOR_MODIFY
-    char **dup_env_base = 0;
-    int dup_env_count = 0;
-#endif
-
     argc--,argv++;	/* skip name of script */
     if (PL_doswitches) {
 	for (; argc > 0 && **argv == '-'; argc--,argv++) {
@@ -3398,6 +3391,30 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
 		sv_setiv(GvSV(gv_fetchpv(argv[0]+1,TRUE, SVt_PV)),1);
 	}
     }
+    if ((PL_argvgv = gv_fetchpv("ARGV",TRUE, SVt_PVAV))) {
+	GvMULTI_on(PL_argvgv);
+	(void)gv_AVadd(PL_argvgv);
+	av_clear(GvAVn(PL_argvgv));
+	for (; argc > 0; argc--,argv++) {
+	    SV *sv = newSVpv(argv[0],0);
+	    av_push(GvAVn(PL_argvgv),sv);
+	    if (PL_widesyscalls)
+		(void)sv_utf8_decode(sv);
+	}
+    }
+}
+
+STATIC void
+S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register char **env)
+{
+    char *s;
+    SV *sv;
+    GV* tmpgv;
+#ifdef NEED_ENVIRON_DUP_FOR_MODIFY
+    char **dup_env_base = 0;
+    int dup_env_count = 0;
+#endif
+
     PL_toptarget = NEWSV(0,0);
     sv_upgrade(PL_toptarget, SVt_PVFM);
     sv_setpvn(PL_toptarget, "", 0);
@@ -3407,6 +3424,9 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
     PL_formtarget = PL_bodytarget;
 
     TAINT;
+
+    init_argv_symbols(argc,argv);
+
     if ((tmpgv = gv_fetchpv("0",TRUE, SVt_PV))) {
 #ifdef MACOS_TRADITIONAL
 	/* $0 is not majick on a Mac */
@@ -3422,17 +3442,6 @@ S_init_postdump_symbols(pTHX_ register int argc, register char **argv, register
 #else
 	sv_setpv(GvSV(tmpgv),PL_origargv[0]);
 #endif
-    if ((PL_argvgv = gv_fetchpv("ARGV",TRUE, SVt_PVAV))) {
-	GvMULTI_on(PL_argvgv);
-	(void)gv_AVadd(PL_argvgv);
-	av_clear(GvAVn(PL_argvgv));
-	for (; argc > 0; argc--,argv++) {
-	    SV *sv = newSVpv(argv[0],0);
-	    av_push(GvAVn(PL_argvgv),sv);
-	    if (PL_widesyscalls)
-		(void)sv_utf8_decode(sv);
-	}
-    }
     if ((PL_envgv = gv_fetchpv("ENV",TRUE, SVt_PVHV))) {
 	HV *hv;
 	GvMULTI_on(PL_envgv);
diff --git a/proto.h b/proto.h
index 27872ca980..80b2c2ce0c 100644
--- a/proto.h
+++ b/proto.h
@@ -316,6 +316,7 @@ PERL_CALLCONV void	Perl_hv_undef(pTHX_ HV* tb);
 PERL_CALLCONV I32	Perl_ibcmp(pTHX_ const char* a, const char* b, I32 len);
 PERL_CALLCONV I32	Perl_ibcmp_locale(pTHX_ const char* a, const char* b, I32 len);
 PERL_CALLCONV bool	Perl_ingroup(pTHX_ Gid_t testgid, Uid_t effective);
+PERL_CALLCONV void	Perl_init_argv_symbols(pTHX_ int, char **);
 PERL_CALLCONV void	Perl_init_debugger(pTHX);
 PERL_CALLCONV void	Perl_init_stacks(pTHX);
 PERL_CALLCONV void	Perl_init_tm(pTHX_ struct tm *ptm);
diff --git a/toke.c b/toke.c
index ae44e89cdd..b5e6b9caa2 100644
--- a/toke.c
+++ b/toke.c
@@ -2688,6 +2688,7 @@ Perl_yylex(pTHX)
 		    while (SPACE_OR_TAB(*d)) d++;
 
 		    if (*d++ == '-') {
+			bool switches_done = PL_doswitches;
 			do {
 			    if (*d == 'M' || *d == 'm') {
 				char *m = d;
@@ -2711,6 +2712,14 @@ Perl_yylex(pTHX)
 				(void)gv_fetchfile(PL_origfilename);
 			    goto retry;
 			}
+			if (PL_doswitches && !switches_done) {
+			    int argc = PL_origargc;
+			    char **argv = PL_origargv;
+			    do {
+				argc--,argv++;
+			    } while (argc && argv[0][0] == '-' && argv[0][1]);
+			    init_argv_symbols(argc,argv);
+			}
 		    }
 		}
 	    }