Clean up and document API for hashes

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

diff --git a/util.c b/util.c
index 99c6f41..c93663c 100644 (file)
--- a/util.c
+++ b/util.c
@@ -1099,7 +1099,7 @@ mess(pat, args)
     if (usermess) {
        tmpstr = sv_newmortal();
        sv_setpv(tmpstr, va_arg(*args, char *));
-       *s++ = SvPVX(tmpstr)[SvCUR(tmpstr)-1];
+       *s++ = SvCUR(tmpstr) ? SvPVX(tmpstr)[SvCUR(tmpstr)-1] : ' ';
     }
     else {
        (void) vsprintf(s,pat,*args);
@@ -1181,18 +1181,30 @@ die(pat, va_alist)
     message = mess(pat, &args);
     va_end(args);
 
-    if (diehook && (cv = sv_2cv(diehook, &stash, &gv, 0)) && !CvDEPTH(cv)) {
-       dSP;
-       SV *msg = sv_2mortal(newSVpv(message, 0));
+    if (diehook) {
+       /* sv_2cv might call croak() */
+       SV *olddiehook = diehook;
+       ENTER;
+       SAVESPTR(diehook);
+       diehook = Nullsv;
+       cv = sv_2cv(olddiehook, &stash, &gv, 0);
+       LEAVE;
+       if (cv && !CvDEPTH(cv) && (CvROOT(cv) || CvXSUB(cv))) {
+           dSP;
+           SV *msg;
 
-       PUSHMARK(sp);
-       EXTEND(sp, 1);
-       PUSHs(msg);
-       PUTBACK;
-       perl_call_sv((SV*)cv, G_DISCARD);
+           ENTER;
+           msg = newSVpv(message, 0);
+           SvREADONLY_on(msg);
+           SAVEFREESV(msg);
 
-       /* It's okay for the __DIE__ hook to modify the message. */
-       message = SvPV(msg, na);
+           PUSHMARK(sp);
+           XPUSHs(msg);
+           PUTBACK;
+           perl_call_sv((SV*)cv, G_DISCARD);
+
+           LEAVE;
+       }
     }
 
     restartop = die_where(message);
@@ -1226,22 +1238,28 @@ croak(pat, va_alist)
     message = mess(pat, &args);
     va_end(args);
     if (diehook) {
+       /* sv_2cv might call croak() */
        SV *olddiehook = diehook;
-       diehook = Nullsv;                 /* sv_2cv might call croak() */
+       ENTER;
+       SAVESPTR(diehook);
+       diehook = Nullsv;
        cv = sv_2cv(olddiehook, &stash, &gv, 0);
-       diehook = olddiehook;
-       if (cv && !CvDEPTH(cv)) {
+       LEAVE;
+       if (cv && !CvDEPTH(cv) && (CvROOT(cv) || CvXSUB(cv))) {
            dSP;
-           SV *msg = sv_2mortal(newSVpv(message, 0));
+           SV *msg;
+
+           ENTER;
+           msg = newSVpv(message, 0);
+           SvREADONLY_on(msg);
+           SAVEFREESV(msg);
 
            PUSHMARK(sp);
-           EXTEND(sp, 1);
-           PUSHs(msg);
+           XPUSHs(msg);
            PUTBACK;
            perl_call_sv((SV*)cv, G_DISCARD);
 
-           /* It's okay for the __DIE__ hook to modify the message. */
-           message = SvPV(msg, na);
+           LEAVE;
        }
     }
     if (in_eval) {
@@ -1250,21 +1268,7 @@ croak(pat, va_alist)
     }
     PerlIO_puts(PerlIO_stderr(),message);
     (void)PerlIO_flush(PerlIO_stderr());
-    if (e_tmpname) {
-       if (e_fp) {
-           PerlIO_close(e_fp);
-           e_fp = Nullfp;
-       }
-       (void)UNLINK(e_tmpname);
-       Safefree(e_tmpname);
-       e_tmpname = Nullch;
-    }
-    statusvalue = SHIFTSTATUS(statusvalue);
-#ifdef VMS
-    my_exit((U32)(vaxc$errno?vaxc$errno:(statusvalue?statusvalue:44)));
-#else
-    my_exit((U32)((errno&255)?errno:((statusvalue&255)?statusvalue:255)));
-#endif
+    my_failure_exit();
 }
 
 void
@@ -1292,18 +1296,28 @@ warn(pat,va_alist)
     va_end(args);
 
     if (warnhook) {
+       /* sv_2cv might call warn() */
        SV *oldwarnhook = warnhook;
-       warnhook = Nullsv;      /* sv_2cv might end up calling warn() */
+       ENTER;
+       SAVESPTR(warnhook);
+       warnhook = Nullsv;
        cv = sv_2cv(oldwarnhook, &stash, &gv, 0);
-       warnhook = oldwarnhook;
-       if (cv && !CvDEPTH(cv)) {
+       LEAVE;
+       if (cv && !CvDEPTH(cv) && (CvROOT(cv) || CvXSUB(cv))) {
            dSP;
+           SV *msg;
+
+           ENTER;
+           msg = newSVpv(message, 0);
+           SvREADONLY_on(msg);
+           SAVEFREESV(msg);
 
            PUSHMARK(sp);
-           EXTEND(sp, 1);
-           PUSHs(sv_2mortal(newSVpv(message,0)));
+           XPUSHs(msg);
            PUTBACK;
            perl_call_sv((SV*)cv, G_DISCARD);
+
+           LEAVE;
            return;
        }
     }
@@ -1637,12 +1651,7 @@ char     *mode;
     register I32 this, that;
     register I32 pid;
     SV *sv;
-    I32 doexec =
-#ifdef AMIGAOS
-       1;
-#else
-       strNE(cmd,"-");
-#endif
+    I32 doexec = strNE(cmd,"-");
 
 #ifdef OS2
     if (doexec) {