Fix a dependency problem.

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

diff --git a/perl.c b/perl.c
index cbe966c..197e737 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -659,6 +659,10 @@ perl_destruct(pTHXx)
     SvREFCNT_dec(PL_fdpid);            /* needed in io_close() */
     PL_fdpid = Nullav;
 
+#ifdef HAVE_INTERP_INTERN
+    sys_intern_clear();
+#endif
+
     /* Destruct the global string table. */
     {
        /* Yell and reset the HeVAL() slots that are still holding refcounts,
@@ -708,9 +712,6 @@ perl_destruct(pTHXx)
     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();
-
-    /* No SVs have survived, need to clean out */
     Safefree(PL_origfilename);
     Safefree(PL_reg_start_tmp);
     if (PL_reg_curpm)
@@ -718,6 +719,8 @@ perl_destruct(pTHXx)
     Safefree(PL_reg_poscache);
     Safefree(HeKEY_hek(&PL_hv_fetch_ent_mh));
     Safefree(PL_op_mask);
+    Safefree(PL_psig_ptr);
+    Safefree(PL_psig_name);
     nuke_stacks();
     PL_hints = 0;              /* Reset hints. Should hints be per-interpreter ? */
     
@@ -740,6 +743,8 @@ perl_destruct(pTHXx)
     PL_thrsv = Nullsv;
 #endif /* USE_THREADS */
 
+    sv_free_arenas();
+
     /* As the absolutely last thing, free the non-arena SV for mess() */
 
     if (PL_mess_sv) {
@@ -2055,9 +2060,25 @@ Perl_moreswitches(pTHX_ char *s)
     case 'd':
        forbid_setid("-d");
        s++;
-       if (*s == ':' || *s == '=')  {
-           my_setenv("PERL5DB", Perl_form(aTHX_ "use Devel::%s;", ++s));
+       /* The following permits -d:Mod to accepts arguments following an =
+          in the fashion that -MSome::Mod does. */
+       if (*s == ':' || *s == '=') {
+           char *start;
+           SV *sv;
+           sv = newSVpv("use Devel::", 0);
+           start = ++s;
+           /* We now allow -d:Module=Foo,Bar */
+           while(isALNUM(*s) || *s==':') ++s;
+           if (*s != '=')
+               sv_catpv(sv, start);
+           else {
+               sv_catpvn(sv, start, s-start);
+               sv_catpv(sv, " split(/,/,q{");
+               sv_catpv(sv, ++s);
+               sv_catpv(sv,    "})");
+           }
            s += strlen(s);
+           my_setenv("PERL5DB", SvPV(sv, PL_na));
        }
        if (!PL_perldb) {
            PL_perldb = PERLDB_ALL;
@@ -2236,6 +2257,10 @@ Perl_moreswitches(pTHX_ char *s)
 
        PerlIO_printf(PerlIO_stdout(),
                      "\n\nCopyright 1987-2000, Larry Wall\n");
+#ifdef MACOS_TRADITIONAL
+       PerlIO_printf(PerlIO_stdout(),
+                     "\nMacOS port Copyright (c) 1991-2000, Matthias Neeracher\n");
+#endif
 #ifdef MSDOS
        PerlIO_printf(PerlIO_stdout(),
                      "\nMS-DOS port Copyright (c) 1989, 1990, Diomidis Spinellis\n");
@@ -2842,16 +2867,6 @@ S_validate_suid(pTHX_ char *validarg, char *scriptname, int fdscript)
            if (tmpstatbuf.st_dev != PL_statbuf.st_dev ||
                tmpstatbuf.st_ino != PL_statbuf.st_ino) {
                (void)PerlIO_close(PL_rsfp);
-               if (PL_rsfp = PerlProc_popen("/bin/mail root","w")) {   /* heh, heh */
-                   PerlIO_printf(PL_rsfp,
-"User %"Uid_t_f" tried to run dev %ld ino %ld in place of dev %ld ino %ld!\n\
-(Filename of set-id script was %s, uid %"Uid_t_f" gid %"Gid_t_f".)\n\nSincerely,\nperl\n",
-                       PL_uid,(long)tmpstatbuf.st_dev, (long)tmpstatbuf.st_ino,
-                       (long)PL_statbuf.st_dev, (long)PL_statbuf.st_ino,
-                       CopFILE(PL_curcop),
-                       PL_statbuf.st_uid, PL_statbuf.st_gid);
-                   (void)PerlProc_pclose(PL_rsfp);
-               }
                Perl_croak(aTHX_ "Permission denied\n");
            }
            if (
@@ -3670,14 +3685,7 @@ Perl_call_list(pTHX_ I32 oldscope, AV *paramList)
 
     while (AvFILL(paramList) >= 0) {
        cv = (CV*)av_shift(paramList);
-       if ((PL_minus_c & 0x10) && (paramList == PL_beginav)) {
-               /* save PL_beginav for compiler */
-           if (! PL_beginav_save)
-               PL_beginav_save = newAV();
-           av_push(PL_beginav_save, (SV*)cv);
-       } else {
-           SAVEFREESV(cv);
-       }
+       SAVEFREESV(cv);
 #ifdef PERL_FLEXIBLE_EXCEPTIONS
        CALLPROTECT(aTHX_ pcur_env, &ret, MEMBER_TO_FPTR(S_vcall_list_body), cv);
 #else