Integrate with Sarathy.
[p5sagit/p5-mst-13.2.git] / perl.c
diff --git a/perl.c b/perl.c
index 062b334..b654404 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -448,18 +448,20 @@ perl_destruct(pTHXx)
     SvREFCNT_dec(hv);
 
     FREETMPS;
-    if (destruct_level >= 2) {
+    if (destruct_level >= 2 && ckWARN_d(WARN_INTERNAL)) {
        if (PL_scopestack_ix != 0)
-           Perl_warn(aTHX_ "Unbalanced scopes: %ld more ENTERs than LEAVEs\n",
+           Perl_warner(aTHX_ WARN_INTERNAL,
+                "Unbalanced scopes: %ld more ENTERs than LEAVEs\n",
                 (long)PL_scopestack_ix);
        if (PL_savestack_ix != 0)
-           Perl_warn(aTHX_ "Unbalanced saves: %ld more saves than restores\n",
+           Perl_warner(aTHX_ WARN_INTERNAL,
+                "Unbalanced saves: %ld more saves than restores\n",
                 (long)PL_savestack_ix);
        if (PL_tmps_floor != -1)
-           Perl_warn(aTHX_ "Unbalanced tmps: %ld more allocs than frees\n",
+           Perl_warner(aTHX_ WARN_INTERNAL,"Unbalanced tmps: %ld more allocs than frees\n",
                 (long)PL_tmps_floor + 1);
        if (cxstack_ix != -1)
-           Perl_warn(aTHX_ "Unbalanced context: %ld more PUSHes than POPs\n",
+           Perl_warner(aTHX_ WARN_INTERNAL,"Unbalanced context: %ld more PUSHes than POPs\n",
                 (long)cxstack_ix + 1);
     }
 
@@ -488,8 +490,9 @@ perl_destruct(pTHXx)
        array = HvARRAY(PL_strtab);
        hent = array[0];
        for (;;) {
-           if (hent) {
-               Perl_warn(aTHX_ "Unbalanced string table refcount: (%d) for \"%s\"",
+           if (hent && ckWARN_d(WARN_INTERNAL)) {
+               Perl_warner(aTHX_ WARN_INTERNAL,
+                    "Unbalanced string table refcount: (%d) for \"%s\"",
                     HeVAL(hent) - Nullsv, HeKEY(hent));
                HeVAL(hent) = Nullsv;
                hent = HeNEXT(hent);
@@ -503,8 +506,8 @@ perl_destruct(pTHXx)
     }
     SvREFCNT_dec(PL_strtab);
 
-    if (PL_sv_count != 0)
-       Perl_warn(aTHX_ "Scalars leaked: %ld\n", (long)PL_sv_count);
+    if (PL_sv_count != 0 && ckWARN_d(WARN_INTERNAL))
+       Perl_warner(aTHX_ WARN_INTERNAL,"Scalars leaked: %ld\n", (long)PL_sv_count);
 
     sv_free_arenas();
 
@@ -988,7 +991,7 @@ print \"  \\@INC:\\n    @INC\\n\";");
     if (PL_do_undump)
        my_unexec();
 
-    if (ckWARN(WARN_ONCE))
+    if (isWARN_ONCE)
        gv_check(PL_defstash);
 
     LEAVE;
@@ -1582,6 +1585,7 @@ Perl_moreswitches(pTHX_ char *s)
        }
        return s;
     case 'D':
+    {  
 #ifdef DEBUGGING
        forbid_setid("-D");
        if (isALPHA(s[1])) {
@@ -1597,11 +1601,15 @@ Perl_moreswitches(pTHX_ char *s)
        }
        PL_debug |= 0x80000000;
 #else
-       Perl_warn(aTHX_ "Recompile perl with -DDEBUGGING to use -D switch\n");
+       dTHR;
+       if (ckWARN_d(WARN_DEBUGGING))
+           Perl_warner(aTHX_ WARN_DEBUGGING,
+                  "Recompile perl with -DDEBUGGING to use -D switch\n");
        for (s++; isALNUM(*s); s++) ;
 #endif
        /*SUPPRESS 530*/
        return s;
+    }  
     case 'h':
        usage(PL_origargv[0]);    
        PerlProc_exit(0);
@@ -1894,6 +1902,7 @@ S_init_interp(pTHX)
 #else
 #  ifdef MULTIPLICITY
 #    define PERLVAR(var,type)
+#    define PERLVARA(var,n,type)
 #    if defined(PERL_IMPLICIT_CONTEXT)
 #      define PERLVARI(var,type,init)  my_perl->var = init;
 #      define PERLVARIC(var,type,init) my_perl->var = init;
@@ -1906,10 +1915,12 @@ S_init_interp(pTHX)
 #      include "thrdvar.h"
 #    endif
 #    undef PERLVAR
+#    undef PERLVARA
 #    undef PERLVARI
 #    undef PERLVARIC
 #  else
 #    define PERLVAR(var,type)
+#    define PERLVARA(var,n,type)
 #    define PERLVARI(var,type,init)    PL_##var = init;
 #    define PERLVARIC(var,type,init)   PL_##var = init;
 #    include "intrpvar.h"
@@ -1917,6 +1928,7 @@ S_init_interp(pTHX)
 #      include "thrdvar.h"
 #    endif
 #    undef PERLVAR
+#    undef PERLVARA
 #    undef PERLVARI
 #    undef PERLVARIC
 #  endif
@@ -2604,29 +2616,33 @@ S_init_predump_symbols(pTHX)
     dTHR;
     GV *tmpgv;
     GV *othergv;
+    IO *io;
 
     sv_setpvn(get_sv("\"", TRUE), " ", 1);
     PL_stdingv = gv_fetchpv("STDIN",TRUE, SVt_PVIO);
     GvMULTI_on(PL_stdingv);
-    IoIFP(GvIOp(PL_stdingv)) = PerlIO_stdin();
+    io = GvIOp(PL_stdingv);
+    IoIFP(io) = PerlIO_stdin();
     tmpgv = gv_fetchpv("stdin",TRUE, SVt_PV);
     GvMULTI_on(tmpgv);
-    GvIOp(tmpgv) = (IO*)SvREFCNT_inc(GvIOp(PL_stdingv));
+    GvIOp(tmpgv) = (IO*)SvREFCNT_inc(io);
 
     tmpgv = gv_fetchpv("STDOUT",TRUE, SVt_PVIO);
     GvMULTI_on(tmpgv);
-    IoOFP(GvIOp(tmpgv)) = IoIFP(GvIOp(tmpgv)) = PerlIO_stdout();
+    io = GvIOp(tmpgv);
+    IoOFP(io) = IoIFP(io) = PerlIO_stdout();
     setdefout(tmpgv);
     tmpgv = gv_fetchpv("stdout",TRUE, SVt_PV);
     GvMULTI_on(tmpgv);
-    GvIOp(tmpgv) = (IO*)SvREFCNT_inc(GvIOp(PL_defoutgv));
+    GvIOp(tmpgv) = (IO*)SvREFCNT_inc(io);
 
     othergv = gv_fetchpv("STDERR",TRUE, SVt_PVIO);
     GvMULTI_on(othergv);
-    IoOFP(GvIOp(othergv)) = IoIFP(GvIOp(othergv)) = PerlIO_stderr();
+    io = GvIOp(othergv);
+    IoOFP(io) = IoIFP(io) = PerlIO_stderr();
     tmpgv = gv_fetchpv("stderr",TRUE, SVt_PV);
     GvMULTI_on(tmpgv);
-    GvIOp(tmpgv) = (IO*)SvREFCNT_inc(GvIOp(othergv));
+    GvIOp(tmpgv) = (IO*)SvREFCNT_inc(io);
 
     PL_statname = NEWSV(66,0);         /* last filename we did stat on */
 
@@ -3107,9 +3123,8 @@ S_my_exit_jump(pTHX)
 
 #ifdef PERL_OBJECT
 #define NO_XSLOCKS
-#endif  /* PERL_OBJECT */
-
 #include "XSUB.h"
+#endif
 
 static I32
 read_e_script(pTHXo_ int idx, SV *buf_sv, int maxlen)