[win32] merge change#985 from maintbranch

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

diff --git a/pp_sys.c b/pp_sys.c
index ce32fc5..d00d162 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -290,10 +290,11 @@ PP(pp_warn)
        tmps = SvPV(TOPs, na);
     }
     if (!tmps || !*tmps) {
-       (void)SvUPGRADE(ERRSV, SVt_PV);
-       if (SvPOK(ERRSV) && SvCUR(ERRSV))
-           sv_catpv(ERRSV, "\t...caught");
-       tmps = SvPV(ERRSV, na);
+       SV *error = ERRSV;
+       (void)SvUPGRADE(error, SVt_PV);
+       if (SvPOK(error) && SvCUR(error))
+           sv_catpv(error, "\t...caught");
+       tmps = SvPV(error, na);
     }
     if (!tmps || !*tmps)
        tmps = "Warning: something's wrong";
@@ -305,6 +306,8 @@ PP(pp_die)
 {
     djSP; dMARK;
     char *tmps;
+    SV *tmpsv = Nullsv;
+    char *pat = "%s";
     if (SP - MARK != 1) {
        dTARGET;
        do_join(TARG, &sv_no, MARK, SP);
@@ -312,17 +315,26 @@ PP(pp_die)
        SP = MARK + 1;
     }
     else {
-       tmps = SvPV(TOPs, na);
+       tmpsv = TOPs;
+       tmps = SvROK(tmpsv) ? Nullch : SvPV(tmpsv, na);
     }
     if (!tmps || !*tmps) {
-       (void)SvUPGRADE(ERRSV, SVt_PV);
-       if (SvPOK(ERRSV) && SvCUR(ERRSV))
-           sv_catpv(ERRSV, "\t...propagated");
-       tmps = SvPV(ERRSV, na);
+       SV *error = ERRSV;
+       (void)SvUPGRADE(error, SVt_PV);
+       if(tmpsv ? SvROK(tmpsv) : SvROK(error)) {
+           if(tmpsv)
+               SvSetSV(error,tmpsv);
+           pat = Nullch;
+       }
+       else {
+           if (SvPOK(error) && SvCUR(error))
+               sv_catpv(error, "\t...propagated");
+           tmps = SvPV(error, na);
+       }
     }
     if (!tmps || !*tmps)
        tmps = "Died";
-    DIE("%s", tmps);
+    DIE(pat, tmps);
 }
 
 /* I/O. */
@@ -464,7 +476,7 @@ PP(pp_umask)
     TAINT_PROPER("umask");
     XPUSHi(anum);
 #else
-    DIE(no_func, "Unsupported function umask");
+    XPUSHs(&sv_undef)
 #endif
     RETURN;
 }
@@ -485,40 +497,10 @@ PP(pp_binmode)
     if (!(io = GvIO(gv)) || !(fp = IoIFP(io)))
        RETPUSHUNDEF;
 
-#ifdef DOSISH
-#ifdef atarist
-    if (!PerlIO_flush(fp) && (fp->_flag |= _IOBIN))
-       RETPUSHYES;
-    else
-       RETPUSHUNDEF;
-#else
-    if (PerlLIO_setmode(PerlIO_fileno(fp), OP_BINARY) != -1) {
-#if defined(WIN32) && defined(__BORLANDC__)
-       /* The translation mode of the stream is maintained independent
-        * of the translation mode of the fd in the Borland RTL (heavy
-        * digging through their runtime sources reveal).  User has to
-        * set the mode explicitly for the stream (though they don't
-        * document this anywhere). GSAR 97-5-24
-        */
-       PerlIO_seek(fp,0L,0);
-       fp->flags |= _F_BIN;
-#endif
+    if (do_binmode(fp,IoTYPE(io),TRUE)) 
        RETPUSHYES;
-    }
     else
        RETPUSHUNDEF;
-#endif
-#else
-#if defined(USEMYBINMODE)
-    if (my_binmode(fp,IoTYPE(io)) != NULL)
-       RETPUSHYES;
-       else
-       RETPUSHUNDEF;
-#else
-    RETPUSHYES;
-#endif
-#endif
-
 }
 
 
@@ -2603,6 +2585,13 @@ PP(pp_chdir)
        if (svp)
            tmps = SvPV(*svp, na);
     }
+#ifdef VMS
+    if (!tmps || !*tmps) {
+       svp = hv_fetch(GvHVn(envgv), "SYS$LOGIN", 9, FALSE);
+       if (svp)
+           tmps = SvPV(*svp, na);
+    }
+#endif
     TAINT_PROPER("chdir");
     PUSHi( PerlDir_chdir(tmps) >= 0 );
 #ifdef VMS
@@ -4124,41 +4113,55 @@ PP(pp_gpwent)
     if (pwent) {
        PUSHs(sv = sv_mortalcopy(&sv_no));
        sv_setpv(sv, pwent->pw_name);
+
        PUSHs(sv = sv_mortalcopy(&sv_no));
        sv_setpv(sv, pwent->pw_passwd);
+
        PUSHs(sv = sv_mortalcopy(&sv_no));
        sv_setiv(sv, (IV)pwent->pw_uid);
+
        PUSHs(sv = sv_mortalcopy(&sv_no));
        sv_setiv(sv, (IV)pwent->pw_gid);
+
+       /* pw_change, pw_quota, and pw_age are mutually exclusive. */
        PUSHs(sv = sv_mortalcopy(&sv_no));
 #ifdef PWCHANGE
        sv_setiv(sv, (IV)pwent->pw_change);
 #else
-#ifdef PWQUOTA
+#   ifdef PWQUOTA
        sv_setiv(sv, (IV)pwent->pw_quota);
-#else
-#ifdef PWAGE
+#   else
+#       ifdef PWAGE
        sv_setpv(sv, pwent->pw_age);
+#       endif
+#   endif
 #endif
-#endif
-#endif
+
+       /* pw_class and pw_comment are mutually exclusive. */
        PUSHs(sv = sv_mortalcopy(&sv_no));
 #ifdef PWCLASS
        sv_setpv(sv, pwent->pw_class);
 #else
-#ifdef PWCOMMENT
+#   ifdef PWCOMMENT
        sv_setpv(sv, pwent->pw_comment);
+#   endif
 #endif
-#endif
+
        PUSHs(sv = sv_mortalcopy(&sv_no));
+#ifdef PWGECOS
        sv_setpv(sv, pwent->pw_gecos);
+#endif
 #ifndef INCOMPLETE_TAINTS
+       /* pw_gecos is tainted. */
        SvTAINTED_on(sv);
 #endif
+
        PUSHs(sv = sv_mortalcopy(&sv_no));
        sv_setpv(sv, pwent->pw_dir);
+
        PUSHs(sv = sv_mortalcopy(&sv_no));
        sv_setpv(sv, pwent->pw_shell);
+
 #ifdef PWEXPIRE
        PUSHs(sv = sv_mortalcopy(&sv_no));
        sv_setiv(sv, (IV)pwent->pw_expire);