Add a new test for overloading.pm

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

diff --git a/pp_sys.c b/pp_sys.c
index de4d692..ec49cbe 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -13,6 +13,8 @@
  * cloven by a great fissure, out of which the red glare came, now leaping
  * up, now dying down into darkness; and all the while far below there was
  * a rumour and a trouble as of great engines throbbing and labouring.
+ *
+ *     [p.945 of _The Lord of the Rings_, VI/iii: "Mount Doom"]
  */
 
 /* This file contains system pp ("push/pop") functions that
@@ -1027,7 +1029,7 @@ PP(pp_sselect)
            if (SvIsCOW(sv))
                sv_force_normal_flags(sv, 0);
            if (SvREADONLY(sv) && !(SvPOK(sv) && SvCUR(sv) == 0))
-               DIE(aTHX_ PL_no_modify);
+               DIE(aTHX_ "%s", PL_no_modify);
        }
        if (!SvPOK(sv)) {
            if (ckWARN(WARN_MISC))
@@ -1154,6 +1156,17 @@ PP(pp_sselect)
 #endif
 }
 
+/*
+=for apidoc setdefout
+
+Sets PL_defoutgv, the default file handle for output, to the passed in
+typeglob. As PL_defoutgv "owns" a reference on its typeglob, the reference
+count of the passed in typeglob is increased by one, and the reference count
+of the typeglob that PL_defoutgv points to is decreased by one.
+
+=cut
+*/
+
 void
 Perl_setdefout(pTHX_ GV *gv)
 {
@@ -2012,51 +2025,60 @@ PP(pp_eof)
 {
     dVAR; dSP;
     GV *gv;
+    IO *io;
+    MAGIC *mg;
 
-    if (MAXARG == 0) {
-       if (PL_op->op_flags & OPf_SPECIAL) {    /* eof() */
-           IO *io;
-           gv = PL_last_in_gv = GvEGV(PL_argvgv);
-           io = GvIO(gv);
-           if (io && !IoIFP(io)) {
-               if ((IoFLAGS(io) & IOf_START) && av_len(GvAVn(gv)) < 0) {
-                   IoLINES(io) = 0;
-                   IoFLAGS(io) &= ~IOf_START;
-                   do_open(gv, "-", 1, FALSE, O_RDONLY, 0, NULL);
-                   if ( GvSV(gv) ) {
-                       sv_setpvs(GvSV(gv), "-");
-                   }
-                   else {
-                       GvSV(gv) = newSVpvs("-");
-                   }
-                   SvSETMAGIC(GvSV(gv));
-               }
-               else if (!nextargv(gv))
-                   RETPUSHYES;
-           }
-       }
+    if (MAXARG)
+       gv = PL_last_in_gv = MUTABLE_GV(POPs);  /* eof(FH) */
+    else if (PL_op->op_flags & OPf_SPECIAL)
+       gv = PL_last_in_gv = GvEGV(PL_argvgv);  /* eof() - ARGV magic */
+    else
+       gv = PL_last_in_gv;                     /* eof */
+
+    if (!gv)
+       RETPUSHNO;
+
+    if ((io = GvIO(gv)) && (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar))) {
+       PUSHMARK(SP);
+       XPUSHs(SvTIED_obj(MUTABLE_SV(io), mg));
+       /*
+        * in Perl 5.12 and later, the additional paramter is a bitmask:
+        * 0 = eof
+        * 1 = eof(FH)
+        * 2 = eof()  <- ARGV magic
+        */
+       if (MAXARG)
+           mPUSHi(1);          /* 1 = eof(FH) - simple, explicit FH */
+       else if (PL_op->op_flags & OPf_SPECIAL)
+           mPUSHi(2);          /* 2 = eof()   - ARGV magic */
        else
-           gv = PL_last_in_gv;                 /* eof */
+           mPUSHi(0);          /* 0 = eof     - simple, implicit FH */
+       PUTBACK;
+       ENTER;
+       call_method("EOF", G_SCALAR);
+       LEAVE;
+       SPAGAIN;
+       RETURN;
     }
-    else
-       gv = PL_last_in_gv = MUTABLE_GV(POPs);  /* eof(FH) */
 
-    if (gv) {
-       IO * const io = GvIO(gv);
-       MAGIC * mg;
-       if (io && (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar))) {
-           PUSHMARK(SP);
-           XPUSHs(SvTIED_obj(MUTABLE_SV(io), mg));
-           PUTBACK;
-           ENTER;
-           call_method("EOF", G_SCALAR);
-           LEAVE;
-           SPAGAIN;
-           RETURN;
+    if (!MAXARG && (PL_op->op_flags & OPf_SPECIAL)) {  /* eof() */
+       if (io && !IoIFP(io)) {
+           if ((IoFLAGS(io) & IOf_START) && av_len(GvAVn(gv)) < 0) {
+               IoLINES(io) = 0;
+               IoFLAGS(io) &= ~IOf_START;
+               do_open(gv, "-", 1, FALSE, O_RDONLY, 0, NULL);
+               if (GvSV(gv))
+                   sv_setpvs(GvSV(gv), "-");
+               else
+                   GvSV(gv) = newSVpvs("-");
+               SvSETMAGIC(GvSV(gv));
+           }
+           else if (!nextargv(gv))
+               RETPUSHYES;
        }
     }
 
-    PUSHs(boolSV(!gv || do_eof(gv)));
+    PUSHs(boolSV(do_eof(gv)));
     RETURN;
 }
 
@@ -5165,13 +5187,13 @@ PP(pp_gpwent)
         * has a different API than the Solaris/IRIX one. */
 #   if defined(HAS_GETSPNAM) && !defined(_AIX)
        {
-           const int saverrno = errno;
+           dSAVE_ERRNO;
            const struct spwd * const spwent = getspnam(pwent->pw_name);
                          /* Save and restore errno so that
                           * underprivileged attempts seem
                           * to have never made the unsccessful
                           * attempt to retrieve the shadow password. */
-           errno = saverrno;
+           RESTORE_ERRNO;
            if (spwent && spwent->sp_pwdp)
                sv_setpv(sv, spwent->sp_pwdp);
        }
@@ -5549,15 +5571,15 @@ static int
 lockf_emulate_flock(int fd, int operation)
 {
     int i;
-    const int save_errno = errno;
     Off_t pos;
+    dSAVE_ERRNO;
 
     /* flock locks entire file so for lockf we need to do the same     */
     pos = PerlLIO_lseek(fd, (Off_t)0, SEEK_CUR);    /* get pos to restore later */
     if (pos > 0)       /* is seekable and needs to be repositioned     */
        if (PerlLIO_lseek(fd, (Off_t)0, SEEK_SET) < 0)
            pos = -1;   /* seek failed, so don't seek back afterwards   */
-    errno = save_errno;
+    RESTORE_ERRNO;
 
     switch (operation) {