remove prohibition against L<text|href>

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

diff --git a/perl.c b/perl.c
index be11625..e5039f9 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -1,3 +1,4 @@
+#line 2 "perl.c"
 /*    perl.c
  *
  *    Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001
@@ -391,6 +392,8 @@ perl_construct(pTHXx)
     PL_timesbase.tms_cstime = 0;
 #endif
 
+    PL_osname = Perl_savepvn(aTHX_ STR_WITH_LEN(OSNAME));
+
     PL_registered_mros = newHV();
     /* Start with 1 bucket, for DFS.  It's unlikely we'll need more.  */
     HvMAX(PL_registered_mros) = 0;
@@ -537,6 +540,8 @@ perl_destruct(pTHXx)
     PERL_UNUSED_ARG(my_perl);
 #endif
 
+    assert(PL_scopestack_ix == 1);
+
     /* wait for all pseudo-forked children to finish */
     PERL_WAIT_FOR_CHILDREN;
 
@@ -564,6 +569,7 @@ perl_destruct(pTHXx)
     }
     LEAVE;
     FREETMPS;
+    assert(PL_scopestack_ix == 0);
 
     /* Need to flush since END blocks can produce output */
     my_fflush_all();
@@ -1047,21 +1053,21 @@ perl_destruct(pTHXx)
     SvREFCNT_dec(PL_isarev);
 
     FREETMPS;
-    if (destruct_level >= 2 && ckWARN_d(WARN_INTERNAL)) {
+    if (destruct_level >= 2) {
        if (PL_scopestack_ix != 0)
-           Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
-                "Unbalanced scopes: %ld more ENTERs than LEAVEs\n",
-                (long)PL_scopestack_ix);
+           Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL),
+                            "Unbalanced scopes: %ld more ENTERs than LEAVEs\n",
+                            (long)PL_scopestack_ix);
        if (PL_savestack_ix != 0)
-           Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
-                "Unbalanced saves: %ld more saves than restores\n",
-                (long)PL_savestack_ix);
+           Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL),
+                            "Unbalanced saves: %ld more saves than restores\n",
+                            (long)PL_savestack_ix);
        if (PL_tmps_floor != -1)
-           Perl_warner(aTHX_ packWARN(WARN_INTERNAL),"Unbalanced tmps: %ld more allocs than frees\n",
-                (long)PL_tmps_floor + 1);
+           Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL),"Unbalanced tmps: %ld more allocs than frees\n",
+                            (long)PL_tmps_floor + 1);
        if (cxstack_ix != -1)
-           Perl_warner(aTHX_ packWARN(WARN_INTERNAL),"Unbalanced context: %ld more PUSHes than POPs\n",
-                (long)cxstack_ix + 1);
+           Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL),"Unbalanced context: %ld more PUSHes than POPs\n",
+                            (long)cxstack_ix + 1);
     }
 
     /* Now absolutely destruct everything, somehow or other, loops or no. */
@@ -1641,7 +1647,7 @@ S_Internals_V(pTHX_ CV *cv)
 #else
     const int local_patch_count = 0;
 #endif
-    const int entries = 4 + local_patch_count;
+    const int entries = 3 + local_patch_count;
     int i;
     static char non_bincompat_options[] = 
 #  ifdef DEBUGGING
@@ -1703,8 +1709,6 @@ S_Internals_V(pTHX_ CV *cv)
     PUSHs(&PL_sv_undef);
 #endif
 
-    PUSHs(Perl_newSVpvn_flags(aTHX_ STR_WITH_LEN(OSNAME), SVs_TEMP));
-
     for (i = 1; i <= local_patch_count; i++) {
        /* This will be an undef, if PL_localpatches[i] is NULL.  */
        PUSHs(sv_2mortal(newSVpv(PL_localpatches[i], 0)));
@@ -1996,9 +2000,8 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 #  endif
            Sighandler_t sigstate = rsignal_state(SIGCHLD);
            if (sigstate == (Sighandler_t) SIG_IGN) {
-               if (ckWARN(WARN_SIGNAL))
-                   Perl_warner(aTHX_ packWARN(WARN_SIGNAL),
-                               "Can't ignore signal CHLD, forcing to default");
+               Perl_ck_warner(aTHX_ packWARN(WARN_SIGNAL),
+                              "Can't ignore signal CHLD, forcing to default");
                (void)rsignal(SIGCHLD, (Sighandler_t)SIG_DFL);
            }
        }
@@ -2607,8 +2610,6 @@ Perl_call_sv(pTHX_ SV *sv, VOL I32 flags)
            PL_curstash = PL_defstash;
            FREETMPS;
            JMPENV_POP;
-           if (PL_statusvalue && !(PL_exit_flags & PERL_EXIT_EXPECTED))
-               Perl_croak(aTHX_ "Callback called exit");
            my_exit_jump();
            /* NOTREACHED */
        case 3:
@@ -2709,8 +2710,6 @@ Perl_eval_sv(pTHX_ SV *sv, I32 flags)
        PL_curstash = PL_defstash;
        FREETMPS;
        JMPENV_POP;
-       if (PL_statusvalue && !(PL_exit_flags & PERL_EXIT_EXPECTED))
-           Perl_croak(aTHX_ "Callback called exit");
        my_exit_jump();
        /* NOTREACHED */
     case 3:
@@ -3223,10 +3222,11 @@ Perl_moreswitches(pTHX_ const char *s)
            }
  #endif
            PerlIO_printf(PerlIO_stdout(),
-               "\nThis is perl, %"SVf
-               " built for %s",
-               level,
-               ARCHNAME);
+               "\nThis is perl "       STRINGIFY(PERL_REVISION)
+               ", version "            STRINGIFY(PERL_VERSION)
+               ", subversion "         STRINGIFY(PERL_SUBVERSION)
+               " (%"SVf") built for "  ARCHNAME, level
+               );
            SvREFCNT_dec(level);
        }
 #else /* DGUX */
@@ -3815,6 +3815,9 @@ Perl_init_stacks(pTHX)
     SET_MARK_OFFSET;
 
     Newx(PL_scopestack,REASONABLE(32),I32);
+#ifdef DEBUGGING
+    Newx(PL_scopestack_name,REASONABLE(32),const char*);
+#endif
     PL_scopestack_ix = 0;
     PL_scopestack_max = REASONABLE(32);
 
@@ -3884,9 +3887,6 @@ S_init_predump_symbols(pTHX)
     GvIOp(tmpgv) = MUTABLE_IO(SvREFCNT_inc_simple(io));
 
     PL_statname = newSV(0);            /* last filename we did stat on */
-
-    Safefree(PL_osname);
-    PL_osname = savepv(OSNAME);
 }
 
 void
@@ -4024,7 +4024,7 @@ S_init_perllib(pTHX)
     const char *perl5lib = NULL;
 #endif
     const char *s;
-#ifdef WIN32
+#if defined(WIN32) && !defined(PERL_IS_MINIPERL)
     STRLEN len;
 #endif
 
@@ -4586,16 +4586,6 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
            PL_curcop = &PL_compiling;
            CopLINE_set(PL_curcop, oldline);
            JMPENV_POP;
-           if (PL_statusvalue && !(PL_exit_flags & PERL_EXIT_EXPECTED)) {
-               if (paramList == PL_beginav)
-                   Perl_croak(aTHX_ "BEGIN failed--compilation aborted");
-               else
-                   Perl_croak(aTHX_ "%s failed--call queue aborted",
-                              paramList == PL_checkav ? "CHECK"
-                              : paramList == PL_initav ? "INIT"
-                              : paramList == PL_unitcheckav ? "UNITCHECK"
-                              : "END");
-           }
            my_exit_jump();
            /* NOTREACHED */
        case 3: