Simplify return handling for tied handle OPEN/PRINTF/READ/WRITE.

[perl5.git] / pp_sys.c

diff --git a/pp_sys.c b/pp_sys.c
index f47395b..3f43e49 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -527,8 +527,7 @@ PP(pp_open)
            ENTER_with_name("call_OPEN");
            call_method("OPEN", G_SCALAR);
            LEAVE_with_name("call_OPEN");
-           SPAGAIN;
-           RETURN;
+           return NORMAL;
        }
     }
 
@@ -827,6 +826,10 @@ PP(pp_tie)
        case SVt_PVGV:
        case SVt_PVLV:
            if (isGV_with_GP(varsv)) {
+               if (SvFAKE(varsv) && !(GvFLAGS(varsv) & GVf_TIEWARNED)) {
+                   deprecate("tie on a handle without *");
+                   GvFLAGS(varsv) |= GVf_TIEWARNED;
+               }
                methname = "TIEHANDLE";
                how = PERL_MAGIC_tiedscalar;
                /* For tied filehandles, we apply tiedscalar magic to the IO
@@ -903,8 +906,14 @@ PP(pp_untie)
     const char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
                ? PERL_MAGIC_tied : PERL_MAGIC_tiedscalar;
 
-    if (isGV_with_GP(sv) && !(sv = MUTABLE_SV(GvIOp(sv))))
+    if (isGV_with_GP(sv)) {
+      if (SvFAKE(sv) && !(GvFLAGS(sv) & GVf_TIEWARNED)) {
+       deprecate("untie on a handle without *");
+       GvFLAGS(sv) |= GVf_TIEWARNED;
+      }
+      if (!(sv = MUTABLE_SV(GvIOp(sv))))
        RETPUSHYES;
+    }
 
     if ((mg = SvTIED_mg(sv, how))) {
        SV * const obj = SvRV(SvTIED_obj(sv, mg));
@@ -941,8 +950,14 @@ PP(pp_tied)
     const char how = (SvTYPE(sv) == SVt_PVHV || SvTYPE(sv) == SVt_PVAV)
                ? PERL_MAGIC_tied : PERL_MAGIC_tiedscalar;
 
-    if (isGV_with_GP(sv) && !SvFAKE(sv) && !(sv = MUTABLE_SV(GvIOp(sv))))
+    if (isGV_with_GP(sv)) {
+      if (SvFAKE(sv) && !(GvFLAGS(sv) & GVf_TIEWARNED)) {
+       deprecate("tied on a handle without *");
+       GvFLAGS(sv) |= GVf_TIEWARNED;
+      }
+      if (!(sv = MUTABLE_SV(GvIOp(sv))))
        RETPUSHUNDEF;
+    }
 
     if ((mg = SvTIED_mg(sv, how))) {
        SV *osv = SvTIED_obj(sv, mg);
@@ -1490,11 +1505,7 @@ PP(pp_prtf)
            ENTER;
            call_method("PRINTF", G_SCALAR);
            LEAVE;
-           SPAGAIN;
-           MARK = ORIGMARK + 1;
-           *MARK = *SP;
-           SP = MARK;
-           RETURN;
+           return NORMAL;
        }
     }
 
@@ -1587,17 +1598,12 @@ PP(pp_sysread)
     {
        const MAGIC * mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
        if (mg) {
-           SV *sv;
            PUSHMARK(MARK-1);
            *MARK = SvTIED_obj(MUTABLE_SV(io), mg);
            ENTER;
            call_method("READ", G_SCALAR);
            LEAVE;
-           SPAGAIN;
-           sv = POPs;
-           SP = ORIGMARK;
-           PUSHs(sv);
-           RETURN;
+           return NORMAL;
        }
     }
 
@@ -1655,6 +1661,9 @@ PP(pp_sysread)
                                  (struct sockaddr *)namebuf, &bufsize);
        if (count < 0)
            RETPUSHUNDEF;
+       /* MSG_TRUNC can give oversized count; quietly lose it */
+       if (count > length)
+           count = length;
 #ifdef EPOC
         /* Bogus return without padding */
        bufsize = sizeof (struct sockaddr_in);
@@ -1832,11 +1841,8 @@ PP(pp_send)
        && gv && (io = GvIO(gv))) {
        MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
        if (mg) {
-           SV *sv;
-
            if (MARK == SP - 1) {
-               sv = *SP;
-               mXPUSHi(sv_len(sv));
+               mXPUSHi(sv_len(*SP));
                PUTBACK;
            }
 
@@ -1845,11 +1851,7 @@ PP(pp_send)
            ENTER;
            call_method("WRITE", G_SCALAR);
            LEAVE;
-           SPAGAIN;
-           sv = POPs;
-           SP = ORIGMARK;
-           PUSHs(sv);
-           RETURN;
+           return NORMAL;
        }
     }
     if (!gv)
@@ -3040,7 +3042,7 @@ PP(pp_ftrread)
        conditional compiling below much clearer.  */
     I32 use_access = 0;
 #endif
-    int stat_mode = S_IRUSR;
+    Mode_t stat_mode = S_IRUSR;
 
     bool effective = FALSE;
     char opchar = '?';
@@ -4454,7 +4456,7 @@ PP(pp_setpgrp)
 #endif
 }
 
-#ifdef __GLIBC__
+#if defined(__GLIBC__) && ((__GLIBC__ == 2 && __GLIBC_MINOR__ >= 3) || (__GLIBC__ > 2))
 #  define PRIORITY_WHICH_T(which) (__priority_which_t)which
 #else
 #  define PRIORITY_WHICH_T(which) which