The same problem with To{Lower,Title,Upper}
[p5sagit/p5-mst-13.2.git] / perl.c
diff --git a/perl.c b/perl.c
index a27620a..e7f7ad6 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>.
@@ -1099,10 +1101,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 +1289,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) {
@@ -1297,7 +1307,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
                d = s;
                if (!*s)
                    break;
-               if (!strchr("DIMUdmw", *s))
+               if (!strchr("DIMUdmtw", *s))
                    Perl_croak(aTHX_ "Illegal switch in PERL5OPT: -%c", *s);
                while (++s && *s) {
                    if (isSPACE(*s)) {
@@ -1310,11 +1320,22 @@ print \"  \\@INC:\\n    @INC\\n\";");
                        break;
                    }
                }
-               moreswitches(d);
+               if (*d == 't') {
+                   if( !PL_tainting ) {
+                       PL_taint_warn = TRUE;
+                       PL_tainting = TRUE;
+                   }
+               } else {
+                   moreswitches(d);
+               }
            }
        }
     }
 
+    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) {
@@ -1603,6 +1624,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
@@ -1630,6 +1653,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
@@ -1651,6 +1676,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
@@ -1672,6 +1699,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
@@ -1703,6 +1732,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>.
@@ -2084,6 +2116,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
@@ -2502,11 +2536,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;