MM_Unix patch for use under CVS

[p5sagit/p5-mst-13.2.git] / perl.c

diff --git a/perl.c b/perl.c
index 0bd1ad1..7ffd52a 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -20,6 +20,10 @@
 #include <unistd.h>
 #endif
 
+#if !defined(STANDARD_C) && !defined(HAS_GETENV_PROTOTYPE)
+char *getenv _((char *)); /* Usually in <stdlib.h> */
+#endif
+
 dEXTCONST char rcsid[] = "perl.c\nPatch level: ###\n";
 
 #ifdef IAMSUID
@@ -191,14 +195,6 @@ register PerlInterpreter *sv_interp;
     }
 #endif
 
-    /* unhook hooks which will soon be, or use, destroyed data */
-    SvREFCNT_dec(warnhook);
-    warnhook = Nullsv;
-    SvREFCNT_dec(diehook);
-    diehook = Nullsv;
-    SvREFCNT_dec(parsehook);
-    parsehook = Nullsv;
-
     LEAVE;
     FREETMPS;
 
@@ -225,6 +221,14 @@ register PerlInterpreter *sv_interp;
        sv_clean_objs();
     }
 
+    /* unhook hooks which will soon be, or use, destroyed data */
+    SvREFCNT_dec(warnhook);
+    warnhook = Nullsv;
+    SvREFCNT_dec(diehook);
+    diehook = Nullsv;
+    SvREFCNT_dec(parsehook);
+    parsehook = Nullsv;
+
     if (destruct_level == 0){
 
        DEBUG_P(debprofdump());
@@ -436,9 +440,6 @@ PerlInterpreter *sv_interp;
        return;
     Safefree(sv_interp);
 }
-#if !defined(STANDARD_C) && !defined(HAS_GETENV_PROTOTYPE)
-char *getenv _((char *)); /* Usually in <stdlib.h> */
-#endif
 
 int
 perl_parse(sv_interp, xsinit, argc, argv, env)
@@ -456,6 +457,7 @@ char **env;
     I32 oldscope;
     AV* comppadlist;
     dJMPENV;
+    int ret;
 
 #ifdef SETUID_SCRIPTS_ARE_SECURE_NOW
 #ifdef IAMSUID
@@ -504,7 +506,8 @@ setuid perl scripts securely.\n");
     time(&basetime);
     oldscope = scopestack_ix;
 
-    switch (JMPENV_PUSH) {
+    JMPENV_PUSH(ret);
+    switch (ret) {
     case 1:
        STATUS_ALL_FAILURE;
        /* FALL THROUGH */
@@ -527,6 +530,7 @@ setuid perl scripts securely.\n");
     sv = newSVpv("",0);                /* first used for -I flags */
     SAVEFREESV(sv);
     init_main_stash();
+
     for (argc--,argv++; argc > 0; argc--,argv++) {
        if (argv[0][0] != '-' || !argv[0][1])
            break;
@@ -639,9 +643,9 @@ setuid perl scripts securely.\n");
                sv_catpv(Sv,buf);
 #endif
 #if defined(LOCAL_PATCH_COUNT)
-               if (LOCAL_PATCH_COUNT > 0)
-               {   int i;
-                   sv_catpv(Sv,"print \"  Locally applied patches:\\n\",");
+               if (LOCAL_PATCH_COUNT > 0) {
+                   int i;
+                   sv_catpv(Sv,"\"  Locally applied patches:\\n\",");
                    for (i = 1; i <= LOCAL_PATCH_COUNT; i++) {
                        if (localpatches[i]) {
                            sprintf(buf,"\"  \\t%s\\n\",",localpatches[i]);
@@ -650,17 +654,21 @@ setuid perl scripts securely.\n");
                    }
                }
 #endif
-               sprintf(buf,"\"  Built under %s\\n\",",OSNAME);
+               sprintf(buf,"\"  Built under %s\\n\"",OSNAME);
                sv_catpv(Sv,buf);
 #ifdef __DATE__
 #  ifdef __TIME__
-               sprintf(buf,"\"  Compiled at %s %s\\n\"",__DATE__,__TIME__);
+               sprintf(buf,",\"  Compiled at %s %s\\n\"",__DATE__,__TIME__);
 #  else
-               sprintf(buf,"\"  Compiled on %s\\n\"",__DATE__);
+               sprintf(buf,",\"  Compiled on %s\\n\"",__DATE__);
 #  endif
                sv_catpv(Sv,buf);
 #endif
-               sv_catpv(Sv,"; $\"=\"\\n    \"; print \"  \\@INC:\\n    @INC\\n\"");
+               sv_catpv(Sv, "; \
+$\"=\"\\n    \"; \
+@env = map { \"$_=\\\"$ENV{$_}\\\"\" } sort grep {/^PERL/} keys %ENV; \
+print \"  \\%ENV:\\n    @env\\n\" if @env; \
+print \"  \\@INC:\\n    @INC\\n\";");
            }
            else {
                Sv = newSVpv("config_vars(qw(",0);
@@ -687,6 +695,24 @@ setuid perl scripts securely.\n");
        }
     }
   switch_end:
+
+    if (!tainting && (s = getenv("PERL5OPT"))) {
+       for (;;) {
+           while (isSPACE(*s))
+               s++;
+           if (*s == '-') {
+               s++;
+               if (isSPACE(*s))
+                   continue;
+           }
+           if (!*s)
+               break;
+           if (!strchr("DIMUdmw", *s))
+               croak("Illegal switch in PERL5OPT: -%c", *s);
+           s = moreswitches(s);
+       }
+    }
+
     if (!scriptname)
        scriptname = argv[0];
     if (e_fp) {
@@ -797,15 +823,17 @@ int
 perl_run(sv_interp)
 PerlInterpreter *sv_interp;
 {
-    dJMPENV;
     I32 oldscope;
+    dJMPENV;
+    int ret;
 
     if (!(curinterp = sv_interp))
        return 255;
 
     oldscope = scopestack_ix;
 
-    switch (JMPENV_PUSH) {
+    JMPENV_PUSH(ret);
+    switch (ret) {
     case 1:
        cxstack_ix = -1;                /* start context stack again */
        break;
@@ -981,6 +1009,7 @@ I32 flags;         /* See G_* flags in cop.h */
     static CV *DBcv;
     bool oldcatch = CATCH_GET;
     dJMPENV;
+    int ret;
 
     if (flags & G_DISCARD) {
        ENTER;
@@ -988,12 +1017,12 @@ I32 flags;               /* See G_* flags in cop.h */
     }
 
     Zero(&myop, 1, LOGOP);
+    myop.op_next = Nullop;
     if (!(flags & G_NOARGS))
        myop.op_flags |= OPf_STACKED;
-    myop.op_next = Nullop;
-    myop.op_flags |= OPf_KNOW;
-    if (flags & G_ARRAY)
-       myop.op_flags |= OPf_LIST;
+    myop.op_flags |= ((flags & G_VOID) ? OPf_WANT_VOID :
+                     (flags & G_ARRAY) ? OPf_WANT_LIST :
+                     OPf_WANT_SCALAR);
     SAVESPTR(op);
     op = (OP*)&myop;
 
@@ -1016,7 +1045,7 @@ I32 flags;                /* See G_* flags in cop.h */
        /* we're trying to emulate pp_entertry() here */
        {
            register CONTEXT *cx;
-           I32 gimme = GIMME;
+           I32 gimme = GIMME_V;
            
            ENTER;
            SAVETMPS;
@@ -1034,7 +1063,8 @@ I32 flags;                /* See G_* flags in cop.h */
        }
        markstack_ptr++;
 
-       switch (JMPENV_PUSH) {
+       JMPENV_PUSH(ret);
+       switch (ret) {
        case 0:
            break;
        case 1:
@@ -1118,6 +1148,7 @@ I32 flags;                /* See G_* flags in cop.h */
     I32 retval;
     I32 oldscope;
     dJMPENV;
+    int ret;
     
     if (flags & G_DISCARD) {
        ENTER;
@@ -1135,13 +1166,14 @@ I32 flags;              /* See G_* flags in cop.h */
        myop.op_flags = OPf_STACKED;
     myop.op_next = Nullop;
     myop.op_type = OP_ENTEREVAL;
-    myop.op_flags |= OPf_KNOW;
+    myop.op_flags |= ((flags & G_VOID) ? OPf_WANT_VOID :
+                     (flags & G_ARRAY) ? OPf_WANT_LIST :
+                     OPf_WANT_SCALAR);
     if (flags & G_KEEPERR)
        myop.op_flags |= OPf_SPECIAL;
-    if (flags & G_ARRAY)
-       myop.op_flags |= OPf_LIST;
 
-    switch (JMPENV_PUSH) {
+    JMPENV_PUSH(ret);
+    switch (ret) {
     case 0:
        break;
     case 1:
@@ -2246,7 +2278,7 @@ register char **env;
        HV *hv;
        GvMULTI_on(envgv);
        hv = GvHVn(envgv);
-       hv_clear(hv);
+       hv_magic(hv, envgv, 'E');
 #ifndef VMS  /* VMS doesn't have environ array */
        /* Note that if the supplied env parameter is actually a copy
           of the global environ then it may now point to free'd memory
@@ -2255,16 +2287,13 @@ register char **env;
        */
        if (!env)
            env = environ;
-       if (env != environ) {
+       if (env != environ)
            environ[0] = Nullch;
-           hv_magic(hv, envgv, 'E');
-       }
        for (; *env; env++) {
            if (!(s = strchr(*env,'=')))
                continue;
            *s++ = '\0';
            sv = newSVpv(s--,0);
-           sv_magic(sv, sv, 'e', *env, s - *env);
            (void)hv_store(hv, *env, s - *env, sv, 0);
            *s = '=';
        }
@@ -2272,7 +2301,6 @@ register char **env;
 #ifdef DYNAMIC_ENV_FETCH
        HvNAME(hv) = savepv(ENV_HV_NAME);
 #endif
-       hv_magic(hv, envgv, 'E');
     }
     TAINT_NOT;
     if (tmpgv = gv_fetchpv("$",TRUE, SVt_PV))
@@ -2443,16 +2471,18 @@ call_list(oldscope, list)
 I32 oldscope;
 AV* list;
 {
-    dJMPENV;
-    STRLEN len;
     line_t oldline = curcop->cop_line;
+    STRLEN len;
+    dJMPENV;
+    int ret;
 
     while (AvFILL(list) >= 0) {
        CV *cv = (CV*)av_shift(list);
 
        SAVEFREESV(cv);
 
-       switch (JMPENV_PUSH) {
+       JMPENV_PUSH(ret);
+       switch (ret) {
        case 0: {
                SV* atsv = GvSV(errgv);
                PUSHMARK(stack_sp);