Turn taint warnings (-t) into severe warnings, so they're

[perl5.git] / pp_ctl.c

diff --git a/pp_ctl.c b/pp_ctl.c
index 7a8da0d..8506daa 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1,7 +1,7 @@
 /*    pp_ctl.c
  *
  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007 by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -295,7 +295,7 @@ PP(pp_substcont)
            SvUPGRADE(sv, SVt_PVMG);
        if (!(mg = mg_find(sv, PERL_MAGIC_regex_global))) {
 #ifdef PERL_OLD_COPY_ON_WRITE
-           if (SvIsCOW(lsv))
+           if (SvIsCOW(sv))
                sv_force_normal_flags(sv, 0);
 #endif
            mg = sv_magicext(sv, NULL, PERL_MAGIC_regex_global, &PL_vtbl_mglob,
@@ -1466,7 +1466,7 @@ Perl_qerror(pTHX_ SV *err)
     else if (PL_errors)
        sv_catsv(PL_errors, err);
     else
-       Perl_warn(aTHX_ "%"SVf, (void*)err);
+       Perl_warn(aTHX_ "%"SVf, SVfARG(err));
     ++PL_error_count;
 }
 
@@ -2028,7 +2028,7 @@ PP(pp_return)
            /* Unassume the success we assumed earlier. */
            SV * const nsv = cx->blk_eval.old_namesv;
            (void)hv_delete(GvHVn(PL_incgv), SvPVX_const(nsv), SvCUR(nsv), G_DISCARD);
-           DIE(aTHX_ "%"SVf" did not return a true value", (void*)nsv);
+           DIE(aTHX_ "%"SVf" did not return a true value", SVfARG(nsv));
        }
        break;
     case CXt_FORMAT:
@@ -2336,7 +2336,7 @@ PP(pp_goto)
                        goto retry;
                    tmpstr = sv_newmortal();
                    gv_efullname3(tmpstr, gv, NULL);
-                   DIE(aTHX_ "Goto undefined subroutine &%"SVf"",(void*)tmpstr);
+                   DIE(aTHX_ "Goto undefined subroutine &%"SVf"", SVfARG(tmpstr));
                }
                DIE(aTHX_ "Goto undefined subroutine");
            }
@@ -2450,13 +2450,13 @@ PP(pp_goto)
                        SV **ary = AvALLOC(av);
                        if (AvARRAY(av) != ary) {
                            AvMAX(av) += AvARRAY(av) - AvALLOC(av);
-                           SvPV_set(av, (char*)ary);
+                           AvARRAY(av) = ary;
                        }
                        if (items >= AvMAX(av) + 1) {
                            AvMAX(av) = items - 1;
                            Renew(ary,items+1,SV*);
                            AvALLOC(av) = ary;
-                           SvPV_set(av, (char*)ary);
+                           AvARRAY(av) = ary;
                        }
                    }
                    ++mark;
@@ -2475,21 +2475,7 @@ PP(pp_goto)
                    }
                }
                if (PERLDB_SUB) {       /* Checking curstash breaks DProf. */
-                   /*
-                    * We do not care about using sv to call CV;
-                    * it's for informational purposes only.
-                    */
-                   SV * const sv = GvSV(PL_DBsub);
-                   save_item(sv);
-                   if (PERLDB_SUB_NN) {
-                       const int type = SvTYPE(sv);
-                       if (type < SVt_PVIV && type != SVt_IV)
-                           sv_upgrade(sv, SVt_PVIV);
-                       (void)SvIOK_on(sv);
-                       SvIV_set(sv, PTR2IV(cv)); /* Do it the quickest way */
-                   } else {
-                       gv_efullname3(sv, CvGV(cv), NULL);
-                   }
+                   Perl_get_db_sub(aTHX_ NULL, cv);
                    if (PERLDB_GOTO) {
                        CV * const gotocv = get_cv("DB::goto", FALSE);
                        if (gotocv) {
@@ -3111,12 +3097,12 @@ PP(pp_require)
        if (cUNOP->op_first->op_type == OP_CONST && cUNOP->op_first->op_private & OPpCONST_NOVER) {
            if ( vcmp(sv,PL_patchlevel) <= 0 )
                DIE(aTHX_ "Perls since %"SVf" too modern--this is %"SVf", stopped",
-                   (void*)vnormal(sv), (void*)vnormal(PL_patchlevel));
+                   SVfARG(vnormal(sv)), SVfARG(vnormal(PL_patchlevel)));
        }
        else {
            if ( vcmp(sv,PL_patchlevel) > 0 )
                DIE(aTHX_ "Perl %"SVf" required--this is only %"SVf", stopped",
-                   (void*)vnormal(sv), (void*)vnormal(PL_patchlevel));
+                   SVfARG(vnormal(sv)), SVfARG(vnormal(PL_patchlevel)));
        }
 
            RETPUSHYES;
@@ -3164,6 +3150,8 @@ PP(pp_require)
            for (i = 0; i <= AvFILL(ar); i++) {
                SV * const dirsv = *av_fetch(ar, i, TRUE);
 
+               if (SvTIED_mg((SV*)ar, PERL_MAGIC_tied))
+                   mg_get(dirsv);
                if (SvROK(dirsv)) {
                    int count;
                    SV **svp;
@@ -3389,7 +3377,7 @@ PP(pp_require)
 
     ENTER;
     SAVETMPS;
-    lex_start(sv_2mortal(newSVpvs("")));
+    lex_start(NULL);
     SAVEGENERICSV(PL_rsfp_filters);
     PL_rsfp_filters = NULL;
 
@@ -3401,10 +3389,6 @@ PP(pp_require)
         PL_compiling.cop_warnings = pWARN_ALL ;
     else if (PL_dowarn & G_WARN_ALL_OFF)
         PL_compiling.cop_warnings = pWARN_NONE ;
-    else if (PL_taint_warn) {
-        PL_compiling.cop_warnings
-           = Perl_new_warnings_bitfield(aTHX_ NULL, WARN_TAINTstring, WARNsize);
-    }
     else
         PL_compiling.cop_warnings = pWARN_STD ;
 
@@ -3586,7 +3570,7 @@ PP(pp_leaveeval)
        /* Unassume the success we assumed earlier. */
        SV * const nsv = cx->blk_eval.old_namesv;
        (void)hv_delete(GvHVn(PL_incgv), SvPVX_const(nsv), SvCUR(nsv), G_DISCARD);
-       retop = Perl_die(aTHX_ "%"SVf" did not return a true value", (void*)nsv);
+       retop = Perl_die(aTHX_ "%"SVf" did not return a true value", SVfARG(nsv));
        /* die_where() did LEAVE, or we won't be here */
     }
     else {