add verbose stack display option, -Dvs

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

diff --git a/perl.c b/perl.c
index 8566e5f..224cc9c 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -431,18 +431,19 @@ perl_destruct(pTHXx)
     FREETMPS;
 
     /* Need to flush since END blocks can produce output */
-    PerlIO_flush((PerlIO*)NULL);
+    my_fflush_all();
 
     if (CALL_FPTR(PL_threadhook)(aTHX)) {
         /* Threads hook has vetoed further cleanup */
-        return STATUS_NATIVE_EXPORT;;
+        return STATUS_NATIVE_EXPORT;
     }
 
     /* We must account for everything.  */
 
     /* Destroy the main CV and syntax tree */
     if (PL_main_root) {
-       PL_curpad = AvARRAY(PL_comppad);
+        /* If running under -d may not have PL_comppad. */
+        PL_curpad = PL_comppad ? AvARRAY(PL_comppad) : NULL;
        op_free(PL_main_root);
        PL_main_root = Nullop;
     }
@@ -490,7 +491,7 @@ perl_destruct(pTHXx)
 #endif
 
        /* The exit() function will do everything that needs doing. */
-        return STATUS_NATIVE_EXPORT;;
+        return STATUS_NATIVE_EXPORT;
     }
 
     /* jettison our possibly duplicated environment */
@@ -1157,7 +1158,7 @@ S_parse_body(pTHX_ char **env, XSINIT_t xsinit)
 #ifdef MACOS_TRADITIONAL
            /* ignore -e for Dev:Pseudo argument */
            if (argv[1] && !strcmp(argv[1], "Dev:Pseudo"))
-               break;
+               break;
 #endif
            if (PL_euid != PL_uid || PL_egid != PL_gid)
                Perl_croak(aTHX_ "No -e allowed in setuid scripts");
@@ -2337,7 +2338,7 @@ Perl_moreswitches(pTHX_ char *s)
        forbid_setid("-D");
        if (isALPHA(s[1])) {
            /* if adding extra options, remember to update DEBUG_MASK */
-           static char debopts[] = "psltocPmfrxuLHXDSTRJ";
+           static char debopts[] = "psltocPmfrxuLHXDSTRJv";
            char *d;
 
            for (s++; *s && (d = strchr(debopts,*s)); s++)
@@ -3273,6 +3274,9 @@ STATIC void
 S_find_beginning(pTHX)
 {
     register char *s, *s2;
+#ifdef MACOS_TRADITIONAL
+    int maclines = 0;
+#endif
 
     /* skip forward in input to the real script? */
 
@@ -3284,16 +3288,16 @@ S_find_beginning(pTHX)
        if ((s = sv_gets(PL_linestr, PL_rsfp, 0)) == Nullch) {
            if (!gMacPerl_AlwaysExtract)
                Perl_croak(aTHX_ "No Perl script found in input\n");
-               
+
            if (PL_doextract)                   /* require explicit override ? */
                if (!OverrideExtract(PL_origfilename))
                    Perl_croak(aTHX_ "User aborted script\n");
                else
                    PL_doextract = FALSE;
-               
+
            /* Pater peccavi, file does not have #! */
            PerlIO_rewind(PL_rsfp);
-       
+
            break;
        }
 #else
@@ -3316,7 +3320,18 @@ S_find_beginning(pTHX)
                        ;
            }
 #ifdef MACOS_TRADITIONAL
+           /* We are always searching for the #!perl line in MacPerl,
+            * so if we find it, still keep the line count correct
+            * by counting lines we already skipped over
+            */
+           for (; maclines > 0 ; maclines--)
+               PerlIO_ungetc(PL_rsfp, '\n');
+
            break;
+
+       /* gMacPerl_AlwaysExtract is false in MPW tool */
+       } else if (gMacPerl_AlwaysExtract) {
+           ++maclines;
 #endif
        }
     }
@@ -3528,6 +3543,17 @@ S_procself_val(pTHX_ SV *sv, char *arg0)
 {
     char buf[MAXPATHLEN];
     int len = readlink(PROCSELFEXE_PATH, buf, sizeof(buf) - 1);
+
+    /* On Playstation2 Linux V1.0 (kernel 2.2.1) readlink(/proc/self/exe)
+       includes a spurious NUL which will cause $^X to fail in system
+       or backticks (this will prevent extensions from being built and
+       many tests from working). readlink is not meant to add a NUL.
+       Normal readlink works fine.
+     */
+    if (len > 0 && buf[len-1] == '\0') {
+      len--;
+    }
+
     /* FreeBSD's implementation is acknowledged to be imperfect, sometimes
        returning the text "unknown" from the readlink rather than the path
        to the executable (or returning an error from the readlink).  Any valid