From sdouglas@arm.com

-----------------------------------------------------------------
I'm having trouble with a script like this (adapted very slightly from the
perlrun man page)​:

--- foo ---
#!/usr/local/bin/perl -s
if ($xyz) { print "$xyz\n" }
-----------

If I invoke this as
  ./foo -xyz=abc
it prints
  abc
as expected.

But if I invoke this as
  /usr/local/bin/perl ./foo -xyz=abc
it prints nothing because the '-s' switch on the '#!' line is being ignored.

I do not expect the '-s' switch on the '#!' line to be ignored. man perlrun
says​:

[...] The #! line is always examined for switches as the line is being parsed.
[...]

Indeed, if I add other switches like this​:
  #!/usr/local/bin/perl -snw

The '-n' and '-w' have the expected effects no matter which of the two ways I
invoke the script.

I've tried this on perl 5.6.1, 5.004_04 and 5.002 on Solaris/SunOS 5.6.

Using perl 5.6.1 (ActiveState build 629) on Win2000 neither invocation obeys the
'-s' switch on the '#!' line. Probably because both invocations are equivalent
to 'perl ./foo -xyz=abc'.

[Invoking it as
  /usr/local/bin/perl -s ./foo -xyz=abc
does obey the '-s' switch -- but that's not how I want to invoke it.]

Flags:
    category=core
    severity=medium

Site configuration information for perl v5.6.1:

Configured by steve at Wed Apr 25 02:38:38 EDT 2001.

Summary of my perl5 (revision 5.0 version 6 subversion 1) configuration:
  Platform:
    osname=solaris, osvers=2.5.1, archname=sun4-solaris
    uname='sunos smc 5.5.1 generic_103640-32 sun4m sparc sunw,sparcstation-10 '
    config_args='-Dcc=gcc -de'
    hint=recommended, useposix=true, d_sigaction=define
    usethreads=undef use5005threads=undef useithreads=undef usemultiplicity=undef
    useperlio=undef d_sfio=undef uselargefiles=define usesocks=undef
    use64bitint=undef use64bitall=undef uselongdouble=undef
  Compiler:
    cc='gcc', ccflags ='-fno-strict-aliasing -I/usr/local/include ',
    optimize='-O',
    cppflags='-fno-strict-aliasing -I/usr/local/include'
    ccversion='', gccversion='2.95.3 20010315 (release)', gccosandvers='solaris2.5.1'
    intsize=4, longsize=4, ptrsize=4, doublesize=8, byteorder=4321
    d_longlong=define, longlongsize=8, d_longdbl=define, longdblsize=16
    ivtype='long', ivsize=4, nvtype='double', nvsize=8, Off_t='off_t', lseeksize=4
    alignbytes=8, usemymalloc=y, prototype=define
  Linker and Libraries:
    ld='gcc', ldflags =' -L/usr/local/lib '
    libpth=/usr/local/lib /usr/lib /usr/ccs/lib
    libs=-lsocket -lnsl -ldl -lm -lc
    perllibs=-lsocket -lnsl -ldl -lm -lc
    libc=/lib/libc.so, so=so, useshrplib=false, libperl=libperl.a
  Dynamic Linking:
    dlsrc=dl_dlopen.xs, dlext=so, d_dlsymun=undef, ccdlflags=' '
    cccdlflags='-fPIC', lddlflags='-G -L/usr/local/lib'

Locally applied patches:
    


@INC for perl v5.6.1:
    /usr/local/lib/perl5/5.6.1/sun4-solaris
    /usr/local/lib/perl5/5.6.1
    /usr/local/lib/perl5/site_perl/5.6.1/sun4-solaris
    /usr/local/lib/perl5/site_perl/5.6.1
    /usr/local/lib/perl5/site_perl
    .


Environment for perl v5.6.1:
    HOME=/home/sdouglas
    LANG (unset)
    LANGUAGE (unset)
    LD_LIBRARY_PATH=/usr/openwin/lib
    LOGDIR (unset)
    PATH=/eda/tools/gnu/native2.2/sunos5.6/bin:/home/sdouglas/bin:/chips/sdt/bin/solrs:/chips/sdt/scripts:/home/sdouglas/sdt/buildtools/bin/solrs:/home/sdouglas/sdt/buildtools/scripts/portable:/usr/local/contrib/bin:/usr/local/lsf/bin:/usr/local/bin:/usr/openwin/bin:/usr/openwin/bin/xview:/usr/local/gnu/bin:/usr/xpg4/bin:/bin:/usr/bin
    PERL_BADLANG (unset)
    SHELL=/bin/tcsh

From @schwern

That would be a bug. The problem appears to be that PL_doswitches is
getting set by Perl_moreswitches() *after* S_init_postdump_symbols()
is being called. So, basically, Perl acts on -s and then checks the
#! line.

Weeell... instead of calling S_init_postdump_symbols() before parsing,
we could call it during parsing just after Perl_moreswitches() is
called in Perl_yylex(). Someone tell me why this is a bad idea.

Heh, found this in toke.c

  Perl_croak(aTHX_ "Believe me, you don't want to use \"-u\" on a Macintosh");

--

Michael G. Schwern <schwern@​pobox.com> http​://www.pobox.com/~schwern/
Perl6 Quality Assurance <perl-qa@​perl.org> Kwalitee Is Job One
Our business in life is not to succeed but to continue to fail in high spirits.
  -- Robert Louis Stevenson

From @rgarcia

But if you invoke it as
  /usr/local/bin/perl -x ./foo -xyz=abc
it works !

That would be a bug. The problem appears to be that PL_doswitches is
getting set by Perl_moreswitches() *after* S_init_postdump_symbols()
is being called. So, basically, Perl acts on -s and then checks the
#! line.

Weeell... instead of calling S_init_postdump_symbols() before parsing,
we could call it during parsing just after Perl_moreswitches() is
called in Perl_yylex(). Someone tell me why this is a bad idea.

This wouldn't be sufficient. Perl_moreswitches() is also called for command-line
switches. You would have to call it a 2d time if you encounter a -s on the
shebang line. And, as perl.c says :

  /* init_postdump_symbols not currently designed to be called */
  /* more than once (ENV isn't cleared first, for example) */

Problem : init_postdump_symbols() handles different things (ARGV, ENV, $$).
I think it's necessary to put the ARGV handling code in a separate function,
so it can also be called by Perl_moreswitches(). Makes sense?

From @schwern

That sounds like a good idea.

Also, we could split out the #! parsing from the rest of the
parser/lexer/whatever so it's a little easier to know where the #!
parsing ends and the real parsing begins.

--

Michael G. Schwern <schwern@​pobox.com> http​://www.pobox.com/~schwern/
Perl6 Quality Assurance <perl-qa@​perl.org> Kwalitee Is Job One
Now I fight for wisdom.
  http​://sluggy.com/d/010204.html

From @rgarcia

Then, when the lexer encounters an -s on the shebang line, if
Perl_init_argv_symbols has not been called yet, it's called.

--- perl.c.orig	Sat Nov  3 02:01:26 2001
+++ perl.c	Wed Nov  7 22:04:14 2001
@@ -3370,17 +3370,10 @@
     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 @@
 		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 @@
     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 @@
 #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);
--- toke.c.orig	Wed Nov  7 07:20:49 2001
+++ toke.c	Wed Nov  7 21:52:22 2001
@@ -2688,6 +2688,7 @@
 		    while (SPACE_OR_TAB(*d)) d++;
 
 		    if (*d++ == '-') {
+			bool switches_done = PL_doswitches;
 			do {
 			    if (*d == 'M' || *d == 'm') {
 				char *m = d;
@@ -2710,6 +2711,14 @@
 			    if (PERLDB_LINE)
 				(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);
 			}
 		    }
 		}
--- embed.pl.orig	Wed Nov  7 03:05:25 2001
+++ embed.pl	Wed Nov  7 21:43:10 2001
@@ -1334,6 +1334,7 @@
 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

From @floatingatoll

This patch appears to be what was required to solve the problem, at the time; the bug
documented in this ticket [1] is still out there as of 5.8, and doesn't seem to have been
applied to the perl sources as of right now.

[1] http​://bugs6.perl.org/rt2/NoAuth/Display.html?id=7876

What's the status of this patch?

- R.

[RT_System - Wed Nov 7 05​:24​:45 2001]​:

Then, when the lexer encounters an -s on the shebang line, if
Perl_init_argv_symbols has not been called yet, it's called.

--- perl.c.orig Sat Nov 3 02​:01​:26 2001
+++ perl.c Wed Nov 7 22​:04​:14 2001
@​@​ -3370,17 +3370,10 @​@​
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 @​@​
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 @​@​
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 @​@​
#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);
--- toke.c.orig Wed Nov 7 07​:20​:49 2001
+++ toke.c Wed Nov 7 21​:52​:22 2001
@​@​ -2688,6 +2688,7 @​@​
while (SPACE_OR_TAB(*d)) d++;

         if \(\*d\+\+ == '\-'\) \{

+ bool switches_done = PL_doswitches;
do {
if (*d == 'M' || *d == 'm') {
char *m = d;
@​@​ -2710,6 +2711,14 @​@​
if (PERLDB_LINE)
(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);
}
}
}
--- embed.pl.orig Wed Nov 7 03​:05​:25 2001
+++ embed.pl Wed Nov 7 21​:43​:10 2001
@​@​ -1334,6 +1334,7 @​@​
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

From @rgs

[coral - Sun Jul 06 15​:48​:01 2003]​:

This patch appears to be what was required to solve the problem, at
the time; the bug
documented in this ticket [1] is still out there as of 5.8, and
doesn't seem to have been
applied to the perl sources as of right now.

[1] http​://bugs6.perl.org/rt2/NoAuth/Display.html?id=7876

What's the status of this patch?

Change 12900 on 2001/11/08 by jhi@​alpha
 
  Subject​: [PATCH 20011106.084] -s on #! line
  From​: Rafael Garcia-Suarez <rgarciasuarez@​free.fr>
  Date​: Wed, 7 Nov 2001 22​:23​:39 +0100
  Message-ID​: <20011107222339.E729@​rafael>

@rgs - Status changed from 'open' to 'resolved'