Making strict et al propagate into autoloaded subroutines seems a

[perl5.git] / pp_sys.c

diff --git a/pp_sys.c b/pp_sys.c
index 690bc9d..6754c3e 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -197,11 +197,6 @@ void setservent(int);
 void endservent(void);
 #endif
 
-#if defined(__osf__) && defined(__cplusplus) && !defined(_XOPEN_SOURCE_EXTENDED)
-extern int readlink(const char *, char *, size_t);
-extern int fchdir(int);
-#endif
-
 #undef PERL_EFF_ACCESS /* EFFective uid/gid ACCESS */
 
 /* AIX 5.2 and below use mktime for localtime, and defines the edge case
@@ -771,22 +766,23 @@ PP(pp_binmode)
     }
 
     PUTBACK;
-    if (PerlIO_binmode(aTHX_ fp,IoTYPE(io),mode_from_discipline(discp),
-                       (discp) ? SvPV_nolen_const(discp) : NULL)) {
-       if (IoOFP(io) && IoOFP(io) != IoIFP(io)) {
-            if (!PerlIO_binmode(aTHX_ IoOFP(io),IoTYPE(io),
-                       mode_from_discipline(discp),
-                       (discp) ? SvPV_nolen_const(discp) : NULL)) {
-               SPAGAIN;
-               RETPUSHUNDEF;
-            }
+    {
+       const int mode = mode_from_discipline(discp);
+       const char *const d = (discp ? SvPV_nolen_const(discp) : NULL);
+       if (PerlIO_binmode(aTHX_ fp, IoTYPE(io), mode, d)) {
+           if (IoOFP(io) && IoOFP(io) != IoIFP(io)) {
+               if (!PerlIO_binmode(aTHX_ IoOFP(io), IoTYPE(io), mode, d)) {
+                   SPAGAIN;
+                   RETPUSHUNDEF;
+               }
+           }
+           SPAGAIN;
+           RETPUSHYES;
+       }
+       else {
+           SPAGAIN;
+           RETPUSHUNDEF;
        }
-       SPAGAIN;
-       RETPUSHYES;
-    }
-    else {
-       SPAGAIN;
-       RETPUSHUNDEF;
     }
 }
 
@@ -1270,6 +1266,7 @@ PP(pp_enterwrite)
     register IO *io;
     GV *fgv;
     CV *cv;
+    SV * tmpsv = NULL;
 
     if (MAXARG == 0)
        gv = PL_defoutgv;
@@ -1293,8 +1290,8 @@ PP(pp_enterwrite)
 
     cv = GvFORM(fgv);
     if (!cv) {
-       SV * const tmpsv = sv_newmortal();
        const char *name;
+       tmpsv = sv_newmortal();
        gv_efullname4(tmpsv, fgv, NULL, FALSE);
        name = SvPV_nolen_const(tmpsv);
        if (name && *name)
@@ -1488,6 +1485,8 @@ PP(pp_prtf)
        goto just_say_no;
     }
     else {
+       if (SvTAINTED(MARK[1]))
+           TAINT_PROPER("printf");
        do_sprintf(sv, SP - MARK, MARK + 1);
        if (!do_print(sv, fp))
            goto just_say_no;
@@ -1622,7 +1621,7 @@ PP(pp_sysread)
        buffer = SvGROW(bufsv, (STRLEN)(length+1));
        /* 'offset' means 'flags' here */
        count = PerlSock_recvfrom(PerlIO_fileno(IoIFP(io)), buffer, length, offset,
-                         (struct sockaddr *)namebuf, &bufsize);
+                                 (struct sockaddr *)namebuf, &bufsize);
        if (count < 0)
            RETPUSHUNDEF;
 #ifdef EPOC
@@ -2785,7 +2784,7 @@ PP(pp_stat)
 {
     dVAR;
     dSP;
-    GV *gv;
+    GV *gv = NULL;
     IO *io;
     I32 gimme;
     I32 max = 13;
@@ -2797,7 +2796,7 @@ PP(pp_stat)
            do_fstat_warning_check:
                if (ckWARN(WARN_IO))
                    Perl_warner(aTHX_ packWARN(WARN_IO),
-                       "lstat() on filehandle %s", GvENAME(gv));
+                       "lstat() on filehandle %s", gv ? GvENAME(gv) : "");
            } else if (PL_laststype != OP_LSTAT)
                Perl_croak(aTHX_ "The stat preceding lstat() wasn't an lstat");
        }
@@ -2911,9 +2910,9 @@ PP(pp_stat)
        PUSHs(sv_2mortal(newSVnv(PL_statcache.st_mtime)));
        PUSHs(sv_2mortal(newSVnv(PL_statcache.st_ctime)));
 #else
-       PUSHs(sv_2mortal(newSViv(PL_statcache.st_atime)));
-       PUSHs(sv_2mortal(newSViv(PL_statcache.st_mtime)));
-       PUSHs(sv_2mortal(newSViv(PL_statcache.st_ctime)));
+       PUSHs(sv_2mortal(newSViv((IV)PL_statcache.st_atime)));
+       PUSHs(sv_2mortal(newSViv((IV)PL_statcache.st_mtime)));
+       PUSHs(sv_2mortal(newSViv((IV)PL_statcache.st_ctime)));
 #endif
 #ifdef USE_STAT_BLOCKS
        PUSHs(sv_2mortal(newSVuv(PL_statcache.st_blksize)));
@@ -3014,7 +3013,7 @@ PP(pp_ftrread)
 
     if (use_access) {
 #if defined(HAS_ACCESS) || defined (PERL_EFF_ACCESS)
-       const char *const name = POPpx;
+       const char *name = POPpx;
        if (effective) {
 #  ifdef PERL_EFF_ACCESS
            result = PERL_EFF_ACCESS(name, access_mode);
@@ -4650,7 +4649,7 @@ PP(pp_ghostent)
        STRLEN addrlen;
        Netdb_host_t addr = (Netdb_host_t) SvPVbyte(addrsv, addrlen);
 
-       hent = PerlSock_gethostbyaddr(addr, (Netdb_hlen_t) addrlen, addrtype);
+       hent = PerlSock_gethostbyaddr((const char*)addr, (Netdb_hlen_t) addrlen, addrtype);
 #else
        DIE(aTHX_ PL_no_sock_func, "gethostbyaddr");
 #endif