Tidy up EXE_EXT patches to MM_Unix.pm
[p5sagit/p5-mst-13.2.git] / perl.c
diff --git a/perl.c b/perl.c
index d75b20d..d7e3ace 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -102,6 +102,8 @@ perl_alloc_using(struct IPerlMem* ipM, struct IPerlMem* ipMS,
 #else
 
 /*
+=head1 Embedding Functions
+
 =for apidoc perl_alloc
 
 Allocates a new Perl interpreter.  See L<perlembed>.
@@ -694,15 +696,8 @@ perl_destruct(pTHXx)
     if (!specialCopIO(PL_compiling.cop_io))
        SvREFCNT_dec(PL_compiling.cop_io);
     PL_compiling.cop_io = Nullsv;
-#ifdef USE_ITHREADS
-    Safefree(CopFILE(&PL_compiling));
-    CopFILE(&PL_compiling) = Nullch;
-    Safefree(CopSTASHPV(&PL_compiling));
-#else
-    SvREFCNT_dec(CopFILEGV(&PL_compiling));
-    CopFILEGV(&PL_compiling) = Nullgv;
-    /* cop_stash is not refcounted */
-#endif
+    CopFILE_free(&PL_compiling);
+    CopSTASH_free(&PL_compiling);
 
     /* Prepare to destruct main symbol table.  */
 
@@ -1099,10 +1094,16 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
                goto reswitch;
            break;
 
-    case 't':
-        PL_taint_warn = TRUE;
+       case 't':
+           if( !PL_tainting ) {
+                PL_taint_warn = TRUE;
+                PL_tainting = TRUE;
+           }
+           s++;
+           goto reswitch;
        case 'T':
            PL_tainting = TRUE;
+           PL_taint_warn = FALSE;
            s++;
            goto reswitch;
 
@@ -1281,8 +1282,10 @@ print \"  \\@INC:\\n    @INC\\n\";");
        char *popt = s;
        while (isSPACE(*s))
            s++;
-       if (*s == '-' && *(s+1) == 'T')
+       if (*s == '-' && *(s+1) == 'T') {
            PL_tainting = TRUE;
+            PL_taint_warn = FALSE;
+       }
        else {
            char *popt_copy = Nullch;
            while (s && *s) {
@@ -1311,8 +1314,10 @@ print \"  \\@INC:\\n    @INC\\n\";");
                    }
                }
                if (*d == 't') {
-                   PL_tainting = TRUE;
-                   PL_taint_warn = TRUE;
+                   if( !PL_tainting ) {
+                       PL_taint_warn = TRUE;
+                       PL_tainting = TRUE;
+                   }
                } else {
                    moreswitches(d);
                }
@@ -1320,6 +1325,10 @@ print \"  \\@INC:\\n    @INC\\n\";");
        }
     }
 
+    if (PL_taint_warn && PL_dowarn != G_WARN_ALL_OFF) {
+       PL_compiling.cop_warnings = newSVpvn(WARN_TAINTstring, WARNsize);
+    }
+
     if (!scriptname)
        scriptname = argv[0];
     if (PL_e_script) {
@@ -1608,6 +1617,8 @@ S_run_body(pTHX_ I32 oldscope)
 }
 
 /*
+=head1 SV Manipulation Functions
+
 =for apidoc p||get_sv
 
 Returns the SV of the specified Perl scalar.  If C<create> is set and the
@@ -1635,6 +1646,8 @@ Perl_get_sv(pTHX_ const char *name, I32 create)
 }
 
 /*
+=head1 Array Manipulation Functions
+
 =for apidoc p||get_av
 
 Returns the AV of the specified Perl array.  If C<create> is set and the
@@ -1656,6 +1669,8 @@ Perl_get_av(pTHX_ const char *name, I32 create)
 }
 
 /*
+=head1 Hash Manipulation Functions
+
 =for apidoc p||get_hv
 
 Returns the HV of the specified Perl hash.  If C<create> is set and the
@@ -1677,6 +1692,8 @@ Perl_get_hv(pTHX_ const char *name, I32 create)
 }
 
 /*
+=head1 CV Manipulation Functions
+
 =for apidoc p||get_cv
 
 Returns the CV of the specified Perl subroutine.  If C<create> is set and
@@ -1708,6 +1725,9 @@ Perl_get_cv(pTHX_ const char *name, I32 create)
 /* Be sure to refetch the stack pointer after calling these routines. */
 
 /*
+
+=head1 Callback Functions
+
 =for apidoc p||call_argv
 
 Performs a callback to the specified Perl sub.  See L<perlcall>.
@@ -2089,6 +2109,8 @@ Perl_eval_pv(pTHX_ const char *p, I32 croak_on_error)
 /* Require a module. */
 
 /*
+=head1 Embedding Functions
+
 =for apidoc p||require_pv
 
 Tells Perl to C<require> the file named by the string argument.  It is
@@ -2507,11 +2529,15 @@ Internet, point your browser at http://www.perl.com/, the Perl Home Page.\n\n");
        return s;
     case 'W':
        PL_dowarn = G_WARN_ALL_ON|G_WARN_ON;
+        if (!specialWARN(PL_compiling.cop_warnings))
+            SvREFCNT_dec(PL_compiling.cop_warnings);
        PL_compiling.cop_warnings = pWARN_ALL ;
        s++;
        return s;
     case 'X':
        PL_dowarn = G_WARN_ALL_OFF;
+        if (!specialWARN(PL_compiling.cop_warnings))
+            SvREFCNT_dec(PL_compiling.cop_warnings);
        PL_compiling.cop_warnings = pWARN_NONE ;
        s++;
        return s;
@@ -2684,11 +2710,7 @@ S_open_script(pTHX_ char *scriptname, bool dosearch, SV *sv, int *fdscript)
        }
     }
 
-#   ifdef USE_ITHREADS
-        Safefree(CopFILE(PL_curcop));
-#   else
-        SvREFCNT_dec(CopFILEGV(PL_curcop));
-#   endif
+    CopFILE_free(PL_curcop);
     CopFILE_set(PL_curcop, PL_origfilename);
     if (strEQ(PL_origfilename,"-"))
        scriptname = "";