more testsuite smarts (many of them courtesy Ilya)

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

diff --git a/pp_sys.c b/pp_sys.c
index 3f4a112..1d1c849 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -17,6 +17,11 @@
 #include "EXTERN.h"
 #include "perl.h"
 
+#ifdef HAS_GETSPENT
+/* Shadow password support for solaris - pdo@cs.umd.edu*/
+#include <shadow.h>
+#endif
+
 /* XXX If this causes problems, set i_unistd=undef in the hint file.  */
 #ifdef I_UNISTD
 # include <unistd.h>
@@ -494,6 +499,7 @@ PP(pp_open)
     SV *sv;
     char *tmps;
     STRLEN len;
+    MAGIC *mg;
 
     if (MAXARG > 1)
        sv = POPs;
@@ -506,6 +512,8 @@ PP(pp_open)
        DIE(PL_no_usym, "filehandle");
     if (GvIOp(gv))
        IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT;
+
+#if 0 /* no undef means tmpfile() yet */
     if (sv == &PL_sv_undef) {
 #ifdef PerlIO
        PerlIO *fp = PerlIO_tmpfile();
@@ -518,6 +526,21 @@ PP(pp_open)
            RETPUSHUNDEF;
        RETURN;
     }   
+#endif /* no undef means tmpfile() yet */
+
+
+    if (mg = SvTIED_mg((SV*)gv, 'q')) {
+       PUSHMARK(SP);
+       XPUSHs(SvTIED_obj((SV*)gv, mg));
+       XPUSHs(sv);
+       PUTBACK;
+       ENTER;
+       perl_call_method("OPEN", G_SCALAR);
+       LEAVE;
+       SPAGAIN;
+       RETURN;
+    }
+
     tmps = SvPV(sv, len);
     if (do_open(gv, tmps, len, FALSE, O_RDONLY, 0, Nullfp))
        PUSHi( (I32)PL_forkprocess );
@@ -615,9 +638,23 @@ PP(pp_fileno)
     GV *gv;
     IO *io;
     PerlIO *fp;
+    MAGIC  *mg;
+
     if (MAXARG < 1)
        RETPUSHUNDEF;
     gv = (GV*)POPs;
+
+    if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) {
+       PUSHMARK(SP);
+       XPUSHs(SvTIED_obj((SV*)gv, mg));
+       PUTBACK;
+       ENTER;
+       perl_call_method("FILENO", G_SCALAR);
+       LEAVE;
+       SPAGAIN;
+       RETURN;
+    }
+
     if (!gv || !(io = GvIO(gv)) || !(fp = IoIFP(io)))
        RETPUSHUNDEF;
     PUSHi(PerlIO_fileno(fp));
@@ -655,11 +692,23 @@ PP(pp_binmode)
     GV *gv;
     IO *io;
     PerlIO *fp;
+    MAGIC *mg;
 
     if (MAXARG < 1)
        RETPUSHUNDEF;
 
-    gv = (GV*)POPs;
+    gv = (GV*)POPs; 
+
+    if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) {
+       PUSHMARK(SP);
+       XPUSHs(SvTIED_obj((SV*)gv, mg));
+       PUTBACK;
+       ENTER;
+       perl_call_method("BINMODE", G_SCALAR);
+       LEAVE;
+       SPAGAIN;
+       RETURN;
+    }
 
     EXTEND(SP, 1);
     if (!(io = GvIO(gv)) || !(fp = IoIFP(io)))
@@ -1349,6 +1398,8 @@ PP(pp_sysopen)
     sv = POPs;
     gv = (GV *)POPs;
 
+    /* Need TIEHANDLE method ? */
+
     tmps = SvPV(sv, len);
     if (do_open(gv, tmps, len, TRUE, mode, perm, Nullfp)) {
        IoLINES(GvIOp(gv)) = 0;
@@ -1618,11 +1669,24 @@ PP(pp_eof)
 {
     djSP;
     GV *gv;
+    MAGIC *mg;
 
     if (MAXARG <= 0)
        gv = PL_last_in_gv;
     else
        gv = PL_last_in_gv = (GV*)POPs;
+
+    if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) {
+       PUSHMARK(SP);
+       XPUSHs(SvTIED_obj((SV*)gv, mg));
+       PUTBACK;
+       ENTER;
+       perl_call_method("EOF", G_SCALAR);
+       LEAVE;
+       SPAGAIN;
+       RETURN;
+    }
+
     PUSHs(boolSV(!gv || do_eof(gv)));
     RETURN;
 }
@@ -1630,12 +1694,25 @@ PP(pp_eof)
 PP(pp_tell)
 {
     djSP; dTARGET;
-    GV *gv;
+    GV *gv;     
+    MAGIC *mg;
 
     if (MAXARG <= 0)
        gv = PL_last_in_gv;
     else
        gv = PL_last_in_gv = (GV*)POPs;
+
+    if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) {
+       PUSHMARK(SP);
+       XPUSHs(SvTIED_obj((SV*)gv, mg));
+       PUTBACK;
+       ENTER;
+       perl_call_method("TELL", G_SCALAR);
+       LEAVE;
+       SPAGAIN;
+       RETURN;
+    }
+
     PUSHi( do_tell(gv) );
     RETURN;
 }
@@ -1651,8 +1728,23 @@ PP(pp_sysseek)
     GV *gv;
     int whence = POPi;
     Off_t offset = POPl;
+    MAGIC *mg;
 
     gv = PL_last_in_gv = (GV*)POPs;
+
+    if (gv && (mg = SvTIED_mg((SV*)gv, 'q'))) {
+       PUSHMARK(SP);
+       XPUSHs(SvTIED_obj((SV*)gv, mg));
+       XPUSHs(sv_2mortal(newSViv((IV) offset)));
+       XPUSHs(sv_2mortal(newSViv((IV) whence)));
+       PUTBACK;
+       ENTER;
+       perl_call_method("SEEK", G_SCALAR);
+       LEAVE;
+       SPAGAIN;
+       RETURN;
+    }
+
     if (PL_op->op_type == OP_SEEK)
        PUSHs(boolSV(do_seek(gv, offset, whence)));
     else {
@@ -3404,6 +3496,7 @@ PP(pp_fork)
     GV *tmpgv;
 
     EXTEND(SP, 1);
+    PERL_FLUSHALL_FOR_CHILD;
     childpid = fork();
     if (childpid < 0)
        RETSETUNDEF;
@@ -3422,7 +3515,7 @@ PP(pp_fork)
 
 PP(pp_wait)
 {
-#if !defined(DOSISH) || defined(OS2) || defined(WIN32)
+#if !defined(DOSISH) || defined(OS2) || defined(WIN32) || defined(CYGWIN32)
     djSP; dTARGET;
     Pid_t childpid;
     int argflags;
@@ -3438,7 +3531,7 @@ PP(pp_wait)
 
 PP(pp_waitpid)
 {
-#if !defined(DOSISH) || defined(OS2) || defined(WIN32)
+#if !defined(DOSISH) || defined(OS2) || defined(WIN32) || defined(CYGWIN32)
     djSP; dTARGET;
     Pid_t childpid;
     int optype;
@@ -3472,6 +3565,7 @@ PP(pp_system)
            TAINT_PROPER("system");
        }
     }
+    PERL_FLUSHALL_FOR_CHILD;
 #if (defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(OS2)
     while ((childpid = vfork()) == -1) {
        if (errno != EAGAIN) {
@@ -3530,6 +3624,7 @@ PP(pp_exec)
     I32 value;
     STRLEN n_a;
 
+    PERL_FLUSHALL_FOR_CHILD;
     if (PL_op->op_flags & OPf_STACKED) {
        SV *really = *++MARK;
        value = (I32)do_aexec(really, MARK, SP);
@@ -4458,6 +4553,9 @@ PP(pp_gpwent)
     register SV *sv;
     struct passwd *pwent;
     STRLEN n_a;
+#ifdef HAS_GETSPENT
+    struct spwd *spwent;
+#endif
 
     if (which == OP_GPWNAM)
        pwent = getpwnam(POPpx);
@@ -4466,6 +4564,15 @@ PP(pp_gpwent)
     else
        pwent = (struct passwd *)getpwent();
 
+#ifdef HAS_GETSPENT
+   if (which == OP_GPWNAM)
+      spwent = getspnam(pwent->pw_name);
+   else if (which == OP_GPWUID)
+      spwent = getspnam(pwent->pw_name);
+   else
+      spwent = (struct spwd *)getspent();
+#endif
+
     EXTEND(SP, 10);
     if (GIMME != G_ARRAY) {
        PUSHs(sv = sv_newmortal());
@@ -4484,8 +4591,15 @@ PP(pp_gpwent)
 
        PUSHs(sv = sv_mortalcopy(&PL_sv_no));
 #ifdef PWPASSWD
+#ifdef HAS_GETSPENT
+      if (spwent)
+              sv_setpv(sv, spwent->sp_pwdp);
+      else
+              sv_setpv(sv, pwent->pw_passwd);
+#else
        sv_setpv(sv, pwent->pw_passwd);
 #endif
+#endif
 
        PUSHs(sv = sv_mortalcopy(&PL_sv_no));
        sv_setiv(sv, (IV)pwent->pw_uid);
@@ -4548,6 +4662,9 @@ PP(pp_spwent)
     djSP;
 #if defined(HAS_PASSWD) && defined(HAS_SETPWENT) && !defined(CYGWIN32)
     setpwent();
+#ifdef HAS_GETSPENT
+    setspent();
+#endif
     RETPUSHYES;
 #else
     DIE(PL_no_func, "setpwent");
@@ -4559,6 +4676,9 @@ PP(pp_epwent)
     djSP;
 #if defined(HAS_PASSWD) && defined(HAS_ENDPWENT)
     endpwent();
+#ifdef HAS_GETSPENT
+    endspent();
+#endif
     RETPUSHYES;
 #else
     DIE(PL_no_func, "endpwent");