This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Perl_sv_vcatpvfn_flags: calc (width - elen) once
[perl5.git] / pp_sys.c
diff --git a/pp_sys.c b/pp_sys.c
index 4f337f0..74c8900 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -30,7 +30,6 @@
 #define PERL_IN_PP_SYS_C
 #include "perl.h"
 #include "time64.h"
 #define PERL_IN_PP_SYS_C
 #include "perl.h"
 #include "time64.h"
-#include "time64.c"
 
 #ifdef I_SHADOW
 /* Shadow password support for solaris - pdo@cs.umd.edu
 
 #ifdef I_SHADOW
 /* Shadow password support for solaris - pdo@cs.umd.edu
@@ -193,6 +192,10 @@ void setservent(int);
 void endservent(void);
 #endif
 
 void endservent(void);
 #endif
 
+#ifdef __amigaos4__
+#  include "amigaos4/amigaio.h"
+#endif
+
 #undef PERL_EFF_ACCESS /* EFFective uid/gid ACCESS */
 
 /* F_OK unused: if stat() cannot find it... */
 #undef PERL_EFF_ACCESS /* EFFective uid/gid ACCESS */
 
 /* F_OK unused: if stat() cannot find it... */
@@ -294,7 +297,7 @@ PP(pp_backtick)
     dSP; dTARGET;
     PerlIO *fp;
     const char * const tmps = POPpconstx;
     dSP; dTARGET;
     PerlIO *fp;
     const char * const tmps = POPpconstx;
-    const I32 gimme = GIMME_V;
+    const U8 gimme = GIMME_V;
     const char *mode = "r";
 
     TAINT_PROPER("``");
     const char *mode = "r";
 
     TAINT_PROPER("``");
@@ -317,7 +320,7 @@ PP(pp_backtick)
            ENTER_with_name("backtick");
            SAVESPTR(PL_rs);
            PL_rs = &PL_sv_undef;
            ENTER_with_name("backtick");
            SAVESPTR(PL_rs);
            PL_rs = &PL_sv_undef;
-           sv_setpvs(TARG, "");        /* note that this preserves previous buffer */
+            SvPVCLEAR(TARG);        /* note that this preserves previous buffer */
            while (sv_gets(TARG, fp, SvCUR(TARG)) != NULL)
                NOOP;
            LEAVE_with_name("backtick");
            while (sv_gets(TARG, fp, SvCUR(TARG)) != NULL)
                NOOP;
            LEAVE_with_name("backtick");
@@ -459,7 +462,7 @@ PP(pp_warn)
       }
     }
     if (SvROK(exsv) && !PL_warnhook)
       }
     }
     if (SvROK(exsv) && !PL_warnhook)
-        Perl_warn(aTHX_ "%"SVf, SVfARG(exsv));
+        Perl_warn(aTHX_ "%" SVf, SVfARG(exsv));
     else warn_sv(exsv);
     RETSETYES;
 }
     else warn_sv(exsv);
     RETSETYES;
 }
@@ -530,6 +533,7 @@ Perl_tied_method(pTHX_ SV *methname, SV **sp, SV *const sv,
 {
     SV **orig_sp = sp;
     I32 ret_args;
 {
     SV **orig_sp = sp;
     I32 ret_args;
+    SSize_t extend_size;
 
     PERL_ARGS_ASSERT_TIED_METHOD;
 
 
     PERL_ARGS_ASSERT_TIED_METHOD;
 
@@ -540,7 +544,20 @@ Perl_tied_method(pTHX_ SV *methname, SV **sp, SV *const sv,
 
     PUTBACK; /* sp is at *foot* of args, so this pops args from old stack */
     PUSHSTACKi(PERLSI_MAGIC);
 
     PUTBACK; /* sp is at *foot* of args, so this pops args from old stack */
     PUSHSTACKi(PERLSI_MAGIC);
-    EXTEND(SP, argc+1); /* object + args */
+    /* extend for object + args. If argc might wrap/truncate when cast
+     * to SSize_t and incremented, set to -1, which will trigger a panic in
+     * EXTEND().
+     * The weird way this is written is because g++ is dumb enough to
+     * warn "comparison is always false" on something like:
+     *
+     * sizeof(a) >= sizeof(b) && a >= B_t_MAX -1
+     *
+     * (where the LH condition is false)
+     */
+    extend_size =
+        (argc > (sizeof(argc) >= sizeof(SSize_t) ? SSize_t_MAX - 1 : argc))
+            ? -1 : (SSize_t)argc + 1;
+    EXTEND(SP, extend_size);
     PUSHMARK(sp);
     PUSHs(SvTIED_obj(sv, mg));
     if (flags & TIED_METHOD_ARGUMENTS_ON_STACK) {
     PUSHMARK(sp);
     PUSHs(SvTIED_obj(sv, mg));
     if (flags & TIED_METHOD_ARGUMENTS_ON_STACK) {
@@ -612,8 +629,7 @@ PP(pp_open)
        IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT;
 
        if (IoDIRP(io))
        IoFLAGS(GvIOp(gv)) &= ~IOf_UNTAINT;
 
        if (IoDIRP(io))
-           Perl_ck_warner_d(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED),
-                            "Opening dirhandle %"HEKf" also as a file",
+           Perl_croak(aTHX_ "Cannot open %" HEKf " as a filehandle: it is already open as a dirhandle",
                             HEKfARG(GvENAME_HEK(gv)));
 
        mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
                             HEKfARG(GvENAME_HEK(gv)));
 
        mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
@@ -678,8 +694,6 @@ PP(pp_pipe_op)
     GV * const wgv = MUTABLE_GV(POPs);
     GV * const rgv = MUTABLE_GV(POPs);
 
     GV * const wgv = MUTABLE_GV(POPs);
     GV * const rgv = MUTABLE_GV(POPs);
 
-    assert (isGV_with_GP(rgv));
-    assert (isGV_with_GP(wgv));
     rstio = GvIOn(rgv);
     if (IoIFP(rstio))
        do_close(rgv, FALSE);
     rstio = GvIOn(rgv);
     if (IoIFP(rstio))
        do_close(rgv, FALSE);
@@ -691,8 +705,8 @@ PP(pp_pipe_op)
     if (PerlProc_pipe(fd) < 0)
        goto badexit;
 
     if (PerlProc_pipe(fd) < 0)
        goto badexit;
 
-    IoIFP(rstio) = PerlIO_fdopen(fd[0], "r"PIPE_OPEN_MODE);
-    IoOFP(wstio) = PerlIO_fdopen(fd[1], "w"PIPE_OPEN_MODE);
+    IoIFP(rstio) = PerlIO_fdopen(fd[0], "r" PIPE_OPEN_MODE);
+    IoOFP(wstio) = PerlIO_fdopen(fd[1], "w" PIPE_OPEN_MODE);
     IoOFP(rstio) = IoIFP(rstio);
     IoIFP(wstio) = IoOFP(wstio);
     IoTYPE(rstio) = IoTYPE_RDONLY;
     IoOFP(rstio) = IoIFP(rstio);
     IoIFP(wstio) = IoOFP(wstio);
     IoTYPE(rstio) = IoTYPE_RDONLY;
@@ -709,10 +723,10 @@ PP(pp_pipe_op)
            PerlLIO_close(fd[1]);
        goto badexit;
     }
            PerlLIO_close(fd[1]);
        goto badexit;
     }
-#if defined(HAS_FCNTL) && defined(F_SETFD)
+#if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC)
     /* ensure close-on-exec */
     /* ensure close-on-exec */
-    if ((fcntl(fd[0], F_SETFD,fd[0] > PL_maxsysfd) < 0) ||
-        (fcntl(fd[1], F_SETFD,fd[1] > PL_maxsysfd) < 0))
+    if ((fd[0] > PL_maxsysfd && fcntl(fd[0], F_SETFD, FD_CLOEXEC) < 0) ||
+        (fd[1] > PL_maxsysfd && fcntl(fd[1], F_SETFD, FD_CLOEXEC) < 0))
         goto badexit;
 #endif
     RETPUSHYES;
         goto badexit;
 #endif
     RETPUSHYES;
@@ -937,10 +951,36 @@ PP(pp_tie)
         * (Sorry obfuscation writers. You're not going to be given this one.)
         */
        stash = gv_stashsv(*MARK, 0);
         * (Sorry obfuscation writers. You're not going to be given this one.)
         */
        stash = gv_stashsv(*MARK, 0);
-       if (!stash || !(gv = gv_fetchmethod(stash, methname))) {
-           DIE(aTHX_ "Can't locate object method \"%s\" via package \"%"SVf"\"",
-                methname, SVfARG(SvOK(*MARK) ? *MARK : &PL_sv_no));
-       }
+       if (!stash) {
+           if (SvROK(*MARK))
+               DIE(aTHX_ "Can't locate object method \"%s\" via package \"%" SVf "\"",
+                   methname, SVfARG(*MARK));
+           else if (isGV(*MARK)) {
+               /* If the glob doesn't name an existing package, using
+                * SVfARG(*MARK) would yield "*Foo::Bar" or *main::Foo. So
+                * generate the name for the error message explicitly. */
+               SV *stashname = sv_2mortal(newSV(0));
+               gv_fullname4(stashname, (GV *) *MARK, NULL, FALSE);
+               DIE(aTHX_ "Can't locate object method \"%s\" via package \"%" SVf "\"",
+                   methname, SVfARG(stashname));
+           }
+           else {
+               SV *stashname = !SvPOK(*MARK) ? &PL_sv_no
+                             : SvCUR(*MARK)  ? *MARK
+                             :                 sv_2mortal(newSVpvs("main"));
+               DIE(aTHX_ "Can't locate object method \"%s\" via package \"%" SVf "\""
+                   " (perhaps you forgot to load \"%" SVf "\"?)",
+                   methname, SVfARG(stashname), SVfARG(stashname));
+           }
+       }
+       else if (!(gv = gv_fetchmethod(stash, methname))) {
+           /* The effective name can only be NULL for stashes that have
+            * been deleted from the symbol table, which this one can't
+            * be, since we just looked it up by name.
+            */
+           DIE(aTHX_ "Can't locate object method \"%s\" via package \"%" HEKf "\"",
+               methname, HvENAME_HEK_NN(stash));
+       }
        ENTER_with_name("call_TIE");
        PUSHSTACKi(PERLSI_MAGIC);
        PUSHMARK(SP);
        ENTER_with_name("call_TIE");
        PUSHSTACKi(PERLSI_MAGIC);
        PUSHMARK(SP);
@@ -1004,7 +1044,7 @@ PP(pp_untie)
             }
            else if (mg && SvREFCNT(obj) > 1) {
                Perl_ck_warner(aTHX_ packWARN(WARN_UNTIE),
             }
            else if (mg && SvREFCNT(obj) > 1) {
                Perl_ck_warner(aTHX_ packWARN(WARN_UNTIE),
-                              "untie attempted while %"UVuf" inner references still exist",
+                              "untie attempted while %" UVuf " inner references still exist",
                               (UV)SvREFCNT(obj) - 1 ) ;
            }
         }
                               (UV)SvREFCNT(obj) - 1 ) ;
            }
         }
@@ -1266,10 +1306,10 @@ PP(pp_sselect)
 
 =for apidoc setdefout
 
 
 =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
+Sets C<PL_defoutgv>, the default file handle for output, to the passed in
+typeglob.  As C<PL_defoutgv> "owns" a reference on its typeglob, the reference
 count of the passed in typeglob is increased by one, and the reference count
 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.
+of the typeglob that C<PL_defoutgv> points to is decreased by one.
 
 =cut
 */
 
 =cut
 */
@@ -1277,10 +1317,13 @@ of the typeglob that PL_defoutgv points to is decreased by one.
 void
 Perl_setdefout(pTHX_ GV *gv)
 {
 void
 Perl_setdefout(pTHX_ GV *gv)
 {
+    GV *oldgv = PL_defoutgv;
+
     PERL_ARGS_ASSERT_SETDEFOUT;
     PERL_ARGS_ASSERT_SETDEFOUT;
+
     SvREFCNT_inc_simple_void_NN(gv);
     SvREFCNT_inc_simple_void_NN(gv);
-    SvREFCNT_dec(PL_defoutgv);
     PL_defoutgv = gv;
     PL_defoutgv = gv;
+    SvREFCNT_dec(oldgv);
 }
 
 PP(pp_select)
 }
 
 PP(pp_select)
@@ -1327,7 +1370,7 @@ PP(pp_getc)
     if (io) {
        const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
        if (mg) {
     if (io) {
        const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar);
        if (mg) {
-           const U32 gimme = GIMME_V;
+           const U8 gimme = GIMME_V;
            Perl_tied_method(aTHX_ SV_CONST(GETC), SP, MUTABLE_SV(io), mg, gimme, 0);
            if (gimme == G_SCALAR) {
                SPAGAIN;
            Perl_tied_method(aTHX_ SV_CONST(GETC), SP, MUTABLE_SV(io), mg, gimme, 0);
            if (gimme == G_SCALAR) {
                SPAGAIN;
@@ -1364,23 +1407,17 @@ STATIC OP *
 S_doform(pTHX_ CV *cv, GV *gv, OP *retop)
 {
     PERL_CONTEXT *cx;
 S_doform(pTHX_ CV *cv, GV *gv, OP *retop)
 {
     PERL_CONTEXT *cx;
-    const I32 gimme = GIMME_V;
+    const U8 gimme = GIMME_V;
 
     PERL_ARGS_ASSERT_DOFORM;
 
     if (CvCLONE(cv))
        cv = MUTABLE_CV(sv_2mortal(MUTABLE_SV(cv_clone(cv))));
 
 
     PERL_ARGS_ASSERT_DOFORM;
 
     if (CvCLONE(cv))
        cv = MUTABLE_CV(sv_2mortal(MUTABLE_SV(cv_clone(cv))));
 
-    ENTER;
-    SAVETMPS;
-
-    PUSHBLOCK(cx, CXt_FORMAT, PL_stack_sp);
-    PUSHFORMAT(cx, retop);
-    if (CvDEPTH(cv) >= 2) {
-       PERL_STACK_OVERFLOW_CHECK();
+    cx = cx_pushblock(CXt_FORMAT, gimme, PL_stack_sp, PL_savestack_ix);
+    cx_pushformat(cx, cv, retop, gv);
+    if (CvDEPTH(cv) >= 2)
        pad_push(CvPADLIST(cv), CvDEPTH(cv));
        pad_push(CvPADLIST(cv), CvDEPTH(cv));
-    }
-    SAVECOMPPAD();
     PAD_SET_CUR_NOSAVE(CvPADLIST(cv), CvDEPTH(cv));
 
     setdefout(gv);         /* locally select filehandle so $% et al work */
     PAD_SET_CUR_NOSAVE(CvPADLIST(cv), CvDEPTH(cv));
 
     setdefout(gv);         /* locally select filehandle so $% et al work */
@@ -1394,7 +1431,6 @@ PP(pp_enterwrite)
     IO *io;
     GV *fgv;
     CV *cv = NULL;
     IO *io;
     GV *fgv;
     CV *cv = NULL;
-    SV *tmpsv = NULL;
 
     if (MAXARG == 0) {
        EXTEND(SP, 1);
 
     if (MAXARG == 0) {
        EXTEND(SP, 1);
@@ -1418,9 +1454,9 @@ PP(pp_enterwrite)
 
     cv = GvFORM(fgv);
     if (!cv) {
 
     cv = GvFORM(fgv);
     if (!cv) {
-       tmpsv = sv_newmortal();
+        SV * const tmpsv = sv_newmortal();
        gv_efullname4(tmpsv, fgv, NULL, FALSE);
        gv_efullname4(tmpsv, fgv, NULL, FALSE);
-       DIE(aTHX_ "Undefined format \"%"SVf"\" called", SVfARG(tmpsv));
+       DIE(aTHX_ "Undefined format \"%" SVf "\" called", SVfARG(tmpsv));
     }
     IoFLAGS(io) &= ~IOf_DIDTOP;
     RETURNOP(doform(cv,gv,PL_op->op_next));
     }
     IoFLAGS(io) &= ~IOf_DIDTOP;
     RETURNOP(doform(cv,gv,PL_op->op_next));
@@ -1429,12 +1465,10 @@ PP(pp_enterwrite)
 PP(pp_leavewrite)
 {
     dSP;
 PP(pp_leavewrite)
 {
     dSP;
-    GV * const gv = cxstack[cxstack_ix].blk_format.gv;
+    GV * const gv = CX_CUR()->blk_format.gv;
     IO * const io = GvIOp(gv);
     PerlIO *ofp;
     PerlIO *fp;
     IO * const io = GvIOp(gv);
     PerlIO *ofp;
     PerlIO *fp;
-    SV **newsp;
-    I32 gimme;
     PERL_CONTEXT *cx;
     OP *retop;
     bool is_return = cBOOL(PL_op->op_type == OP_RETURN);
     PERL_CONTEXT *cx;
     OP *retop;
     bool is_return = cBOOL(PL_op->op_type == OP_RETURN);
@@ -1457,7 +1491,7 @@ PP(pp_leavewrite)
                SV *topname;
                if (!IoFMT_NAME(io))
                    IoFMT_NAME(io) = savepv(GvNAME(gv));
                SV *topname;
                if (!IoFMT_NAME(io))
                    IoFMT_NAME(io) = savepv(GvNAME(gv));
-               topname = sv_2mortal(Perl_newSVpvf(aTHX_ "%"HEKf"_TOP",
+               topname = sv_2mortal(Perl_newSVpvf(aTHX_ "%" HEKf "_TOP",
                                         HEKfARG(GvNAME_HEK(gv))));
                topgv = gv_fetchsv(topname, 0, SVt_PVFM);
                if ((topgv && GvFORM(topgv)) ||
                                         HEKfARG(GvNAME_HEK(gv))));
                topgv = gv_fetchsv(topname, 0, SVt_PVFM);
                if ((topgv && GvFORM(topgv)) ||
@@ -1505,17 +1539,20 @@ PP(pp_leavewrite)
        if (!cv) {
            SV * const sv = sv_newmortal();
            gv_efullname4(sv, fgv, NULL, FALSE);
        if (!cv) {
            SV * const sv = sv_newmortal();
            gv_efullname4(sv, fgv, NULL, FALSE);
-           DIE(aTHX_ "Undefined top format \"%"SVf"\" called", SVfARG(sv));
+           DIE(aTHX_ "Undefined top format \"%" SVf "\" called", SVfARG(sv));
        }
        return doform(cv, gv, PL_op);
     }
 
   forget_top:
        }
        return doform(cv, gv, PL_op);
     }
 
   forget_top:
-    POPBLOCK(cx,PL_curpm);
+    cx = CX_CUR();
+    assert(CxTYPE(cx) == CXt_FORMAT);
+    SP = PL_stack_base + cx->blk_oldsp; /* ignore retval of formline */
+    CX_LEAVE_SCOPE(cx);
+    cx_popformat(cx);
+    cx_popblock(cx);
     retop = cx->blk_sub.retop;
     retop = cx->blk_sub.retop;
-    POPFORMAT(cx);
-    SP = newsp; /* ignore retval of formline */
-    LEAVE;
+    CX_POP(cx);
 
     if (is_return)
         /* XXX the semantics of doing 'return' in a format aren't documented.
 
     if (is_return)
         /* XXX the semantics of doing 'return' in a format aren't documented.
@@ -1546,7 +1583,6 @@ PP(pp_leavewrite)
        }
     }
     PL_formtarget = PL_bodytarget;
        }
     }
     PL_formtarget = PL_bodytarget;
-    PERL_UNUSED_VAR(gimme);
     RETURNOP(retop);
 }
 
     RETURNOP(retop);
 }
 
@@ -1622,7 +1658,7 @@ PP(pp_sysopen)
 
     /* Need TIEHANDLE method ? */
     const char * const tmps = SvPV_const(sv, len);
 
     /* Need TIEHANDLE method ? */
     const char * const tmps = SvPV_const(sv, len);
-    if (do_open_raw(gv, tmps, len, mode, perm)) {
+    if (do_open_raw(gv, tmps, len, mode, perm, NULL)) {
        IoLINES(GvIOp(gv)) = 0;
        PUSHs(&PL_sv_yes);
     }
        IoLINES(GvIOp(gv)) = 0;
        PUSHs(&PL_sv_yes);
     }
@@ -1672,7 +1708,7 @@ PP(pp_sysread)
        goto say_undef;
     bufsv = *++MARK;
     if (! SvOK(bufsv))
        goto say_undef;
     bufsv = *++MARK;
     if (! SvOK(bufsv))
-       sv_setpvs(bufsv, "");
+        SvPVCLEAR(bufsv);
     length = SvIVx(*++MARK);
     if (length < 0)
        DIE(aTHX_ "Negative length");
     length = SvIVx(*++MARK);
     if (length < 0)
        DIE(aTHX_ "Negative length");
@@ -1692,6 +1728,12 @@ PP(pp_sysread)
     fd = PerlIO_fileno(IoIFP(io));
 
     if ((fp_utf8 = PerlIO_isutf8(IoIFP(io))) && !IN_BYTES) {
     fd = PerlIO_fileno(IoIFP(io));
 
     if ((fp_utf8 = PerlIO_isutf8(IoIFP(io))) && !IN_BYTES) {
+        if (PL_op->op_type == OP_SYSREAD || PL_op->op_type == OP_RECV) {
+            Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
+                             "%s() is deprecated on :utf8 handles. "
+                             "This will be a fatal error in Perl 5.30",
+                             OP_DESC(PL_op));
+        }
        buffer = SvPVutf8_force(bufsv, blen);
        /* UTF-8 may not have been set if they are all low bytes */
        SvUTF8_on(bufsv);
        buffer = SvPVutf8_force(bufsv, blen);
        /* UTF-8 may not have been set if they are all low bytes */
        SvUTF8_on(bufsv);
@@ -1951,6 +1993,10 @@ PP(pp_syswrite)
     doing_utf8 = DO_UTF8(bufsv);
 
     if (PerlIO_isutf8(IoIFP(io))) {
     doing_utf8 = DO_UTF8(bufsv);
 
     if (PerlIO_isutf8(IoIFP(io))) {
+        Perl_ck_warner_d(aTHX_ packWARN(WARN_DEPRECATED),
+                         "%s() is deprecated on :utf8 handles. "
+                         "This will be a fatal error in Perl 5.30",
+                         OP_DESC(PL_op));
        if (!SvUTF8(bufsv)) {
            /* We don't modify the original scalar.  */
            tmpbuf = bytes_to_utf8((const U8*) buffer, &blen);
        if (!SvUTF8(bufsv)) {
            /* We don't modify the original scalar.  */
            tmpbuf = bytes_to_utf8((const U8*) buffer, &blen);
@@ -2290,13 +2336,18 @@ PP(pp_truncate)
                         SETERRNO(EBADF,RMS_IFI);
                         result = 0;
                     } else {
                         SETERRNO(EBADF,RMS_IFI);
                         result = 0;
                     } else {
-                        PerlIO_flush(fp);
+                        if (len < 0) {
+                            SETERRNO(EINVAL, LIB_INVARG);
+                            result = 0;
+                        } else {
+                           PerlIO_flush(fp);
 #ifdef HAS_TRUNCATE
 #ifdef HAS_TRUNCATE
-                        if (ftruncate(fd, len) < 0)
+                           if (ftruncate(fd, len) < 0)
 #else
 #else
-                        if (my_chsize(fd, len) < 0)
+                           if (my_chsize(fd, len) < 0)
 #endif
 #endif
-                            result = 0;
+                               result = 0;
+                        }
                     }
                }
            }
                     }
                }
            }
@@ -2472,11 +2523,10 @@ PP(pp_socket)
     TAINT_PROPER("socket");
     fd = PerlSock_socket(domain, type, protocol);
     if (fd < 0) {
     TAINT_PROPER("socket");
     fd = PerlSock_socket(domain, type, protocol);
     if (fd < 0) {
-        SETERRNO(EBADF,RMS_IFI);
        RETPUSHUNDEF;
     }
        RETPUSHUNDEF;
     }
-    IoIFP(io) = PerlIO_fdopen(fd, "r"SOCKET_OPEN_MODE);        /* stdio gets confused about sockets */
-    IoOFP(io) = PerlIO_fdopen(fd, "w"SOCKET_OPEN_MODE);
+    IoIFP(io) = PerlIO_fdopen(fd, "r" SOCKET_OPEN_MODE); /* stdio gets confused about sockets */
+    IoOFP(io) = PerlIO_fdopen(fd, "w" SOCKET_OPEN_MODE);
     IoTYPE(io) = IoTYPE_SOCKET;
     if (!IoIFP(io) || !IoOFP(io)) {
        if (IoIFP(io)) PerlIO_close(IoIFP(io));
     IoTYPE(io) = IoTYPE_SOCKET;
     if (!IoIFP(io) || !IoOFP(io)) {
        if (IoIFP(io)) PerlIO_close(IoIFP(io));
@@ -2484,8 +2534,9 @@ PP(pp_socket)
        if (!IoIFP(io) && !IoOFP(io)) PerlLIO_close(fd);
        RETPUSHUNDEF;
     }
        if (!IoIFP(io) && !IoOFP(io)) PerlLIO_close(fd);
        RETPUSHUNDEF;
     }
-#if defined(HAS_FCNTL) && defined(F_SETFD)
-    if (fcntl(fd, F_SETFD, fd > PL_maxsysfd) < 0)      /* ensure close-on-exec */
+#if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC)
+    /* ensure close-on-exec */
+    if (fd > PL_maxsysfd && fcntl(fd, F_SETFD, FD_CLOEXEC) < 0)
        RETPUSHUNDEF;
 #endif
 
        RETPUSHUNDEF;
 #endif
 
@@ -2515,11 +2566,11 @@ PP(pp_sockpair)
     TAINT_PROPER("socketpair");
     if (PerlSock_socketpair(domain, type, protocol, fd) < 0)
        RETPUSHUNDEF;
     TAINT_PROPER("socketpair");
     if (PerlSock_socketpair(domain, type, protocol, fd) < 0)
        RETPUSHUNDEF;
-    IoIFP(io1) = PerlIO_fdopen(fd[0], "r"SOCKET_OPEN_MODE);
-    IoOFP(io1) = PerlIO_fdopen(fd[0], "w"SOCKET_OPEN_MODE);
+    IoIFP(io1) = PerlIO_fdopen(fd[0], "r" SOCKET_OPEN_MODE);
+    IoOFP(io1) = PerlIO_fdopen(fd[0], "w" SOCKET_OPEN_MODE);
     IoTYPE(io1) = IoTYPE_SOCKET;
     IoTYPE(io1) = IoTYPE_SOCKET;
-    IoIFP(io2) = PerlIO_fdopen(fd[1], "r"SOCKET_OPEN_MODE);
-    IoOFP(io2) = PerlIO_fdopen(fd[1], "w"SOCKET_OPEN_MODE);
+    IoIFP(io2) = PerlIO_fdopen(fd[1], "r" SOCKET_OPEN_MODE);
+    IoOFP(io2) = PerlIO_fdopen(fd[1], "w" SOCKET_OPEN_MODE);
     IoTYPE(io2) = IoTYPE_SOCKET;
     if (!IoIFP(io1) || !IoOFP(io1) || !IoIFP(io2) || !IoOFP(io2)) {
        if (IoIFP(io1)) PerlIO_close(IoIFP(io1));
     IoTYPE(io2) = IoTYPE_SOCKET;
     if (!IoIFP(io1) || !IoOFP(io1) || !IoIFP(io2) || !IoOFP(io2)) {
        if (IoIFP(io1)) PerlIO_close(IoIFP(io1));
@@ -2530,10 +2581,10 @@ PP(pp_sockpair)
        if (!IoIFP(io2) && !IoOFP(io2)) PerlLIO_close(fd[1]);
        RETPUSHUNDEF;
     }
        if (!IoIFP(io2) && !IoOFP(io2)) PerlLIO_close(fd[1]);
        RETPUSHUNDEF;
     }
-#if defined(HAS_FCNTL) && defined(F_SETFD)
+#if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC)
     /* ensure close-on-exec */
     /* ensure close-on-exec */
-    if ((fcntl(fd[0],F_SETFD,fd[0] > PL_maxsysfd) < 0) ||
-        (fcntl(fd[1],F_SETFD,fd[1] > PL_maxsysfd) < 0))
+    if ((fd[0] > PL_maxsysfd && fcntl(fd[0], F_SETFD, FD_CLOEXEC) < 0) ||
+        (fd[1] > PL_maxsysfd && fcntl(fd[1], F_SETFD, FD_CLOEXEC) < 0))
        RETPUSHUNDEF;
 #endif
 
        RETPUSHUNDEF;
 #endif
 
@@ -2638,8 +2689,8 @@ PP(pp_accept)
        goto badexit;
     if (IoIFP(nstio))
        do_close(ngv, FALSE);
        goto badexit;
     if (IoIFP(nstio))
        do_close(ngv, FALSE);
-    IoIFP(nstio) = PerlIO_fdopen(fd, "r"SOCKET_OPEN_MODE);
-    IoOFP(nstio) = PerlIO_fdopen(fd, "w"SOCKET_OPEN_MODE);
+    IoIFP(nstio) = PerlIO_fdopen(fd, "r" SOCKET_OPEN_MODE);
+    IoOFP(nstio) = PerlIO_fdopen(fd, "w" SOCKET_OPEN_MODE);
     IoTYPE(nstio) = IoTYPE_SOCKET;
     if (!IoIFP(nstio) || !IoOFP(nstio)) {
        if (IoIFP(nstio)) PerlIO_close(IoIFP(nstio));
     IoTYPE(nstio) = IoTYPE_SOCKET;
     if (!IoIFP(nstio) || !IoOFP(nstio)) {
        if (IoIFP(nstio)) PerlIO_close(IoIFP(nstio));
@@ -2647,8 +2698,9 @@ PP(pp_accept)
        if (!IoIFP(nstio) && !IoOFP(nstio)) PerlLIO_close(fd);
        goto badexit;
     }
        if (!IoIFP(nstio) && !IoOFP(nstio)) PerlLIO_close(fd);
        goto badexit;
     }
-#if defined(HAS_FCNTL) && defined(F_SETFD)
-    if (fcntl(fd, F_SETFD, fd > PL_maxsysfd) < 0)      /* ensure close-on-exec */
+#if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC)
+    /* ensure close-on-exec */
+    if (fd > PL_maxsysfd && fcntl(fd, F_SETFD, FD_CLOEXEC) < 0)
         goto badexit;
 #endif
 
         goto badexit;
 #endif
 
@@ -2843,7 +2895,7 @@ PP(pp_stat)
     dSP;
     GV *gv = NULL;
     IO *io = NULL;
     dSP;
     GV *gv = NULL;
     IO *io = NULL;
-    I32 gimme;
+    U8 gimme;
     I32 max = 13;
     SV* sv;
 
     I32 max = 13;
     SV* sv;
 
@@ -2853,7 +2905,7 @@ PP(pp_stat)
            if (gv != PL_defgv) {
            do_fstat_warning_check:
                Perl_ck_warner(aTHX_ packWARN(WARN_IO),
            if (gv != PL_defgv) {
            do_fstat_warning_check:
                Perl_ck_warner(aTHX_ packWARN(WARN_IO),
-                              "lstat() on filehandle%s%"SVf,
+                              "lstat() on filehandle%s%" SVf,
                                gv ? " " : "",
                                SVfARG(gv
                                         ? sv_2mortal(newSVhek(GvENAME_HEK(gv)))
                                gv ? " " : "",
                                SVfARG(gv
                                         ? sv_2mortal(newSVhek(GvENAME_HEK(gv)))
@@ -2869,7 +2921,7 @@ PP(pp_stat)
            havefp = FALSE;
            PL_laststype = OP_STAT;
            PL_statgv = gv ? gv : (GV *)io;
            havefp = FALSE;
            PL_laststype = OP_STAT;
            PL_statgv = gv ? gv : (GV *)io;
-           sv_setpvs(PL_statname, "");
+            SvPVCLEAR(PL_statname);
             if(gv) {
                 io = GvIO(gv);
            }
             if(gv) {
                 io = GvIO(gv);
            }
@@ -3429,7 +3481,7 @@ PP(pp_fttext)
        }
        else {
            PL_statgv = gv;
        }
        else {
            PL_statgv = gv;
-           sv_setpvs(PL_statname, "");
+            SvPVCLEAR(PL_statname);
            io = GvIO(PL_statgv);
        }
        PL_laststatval = -1;
            io = GvIO(PL_statgv);
        }
        PL_laststatval = -1;
@@ -3504,8 +3556,9 @@ PP(pp_fttext)
         }
        PL_laststatval = PerlLIO_fstat(fd, &PL_statcache);
        if (PL_laststatval < 0) {
         }
        PL_laststatval = PerlLIO_fstat(fd, &PL_statcache);
        if (PL_laststatval < 0) {
+            dSAVE_ERRNO;
            (void)PerlIO_close(fp);
            (void)PerlIO_close(fp);
-            SETERRNO(EBADF,RMS_IFI);
+            RESTORE_ERRNO;
            FT_RETURNUNDEF;
        }
        PerlIO_binmode(aTHX_ fp, '<', O_BINARY, NULL);
            FT_RETURNUNDEF;
        }
        PerlIO_binmode(aTHX_ fp, '<', O_BINARY, NULL);
@@ -3528,15 +3581,11 @@ PP(pp_fttext)
 #endif
 
     assert(len);
 #endif
 
     assert(len);
-    if (! is_invariant_string((U8 *) s, len)) {
-        const U8 *ep;
+    if (! is_utf8_invariant_string((U8 *) s, len)) {
 
         /* Here contains a variant under UTF-8 .  See if the entire string is
 
         /* Here contains a variant under UTF-8 .  See if the entire string is
-         * UTF-8.  But the buffer may end in a partial character, so consider
-         * it UTF-8 if the first non-UTF8 char is an ending partial */
-        if (is_utf8_string_loc((U8 *) s, len, &ep)
-            || ep + UTF8SKIP(ep)  > (U8 *) (s + len))
-        {
+         * UTF-8. */
+        if (is_utf8_fixed_width_buf_flags((U8 *) s, len, 0)) {
             if (PL_op->op_type == OP_FTTEXT) {
                 FT_RETURNYES;
             }
             if (PL_op->op_type == OP_FTTEXT) {
                 FT_RETURNYES;
             }
@@ -3562,14 +3611,14 @@ PP(pp_fttext)
         }
         else
 #endif
         }
         else
 #endif
-        if (isPRINT_A(*s)
-                   /* VT occurs so rarely in text, that we consider it odd */
-                || (isSPACE_A(*s) && *s != VT_NATIVE)
+             if (  isPRINT_A(*s)
+                    /* VT occurs so rarely in text, that we consider it odd */
+                 || (isSPACE_A(*s) && *s != VT_NATIVE)
 
                     /* But there is a fair amount of backspaces and escapes in
                      * some text */
 
                     /* But there is a fair amount of backspaces and escapes in
                      * some text */
-                || *s == '\b'
-                || *s == ESC_NATIVE)
+                 || *s == '\b'
+                 || *s == ESC_NATIVE)
         {
             continue;
         }
         {
             continue;
         }
@@ -3594,6 +3643,16 @@ PP(pp_chdir)
        SV * const sv = POPs;
        if (PL_op->op_flags & OPf_SPECIAL) {
            gv = gv_fetchsv(sv, 0, SVt_PVIO);
        SV * const sv = POPs;
        if (PL_op->op_flags & OPf_SPECIAL) {
            gv = gv_fetchsv(sv, 0, SVt_PVIO);
+            if (!gv) {
+                if (ckWARN(WARN_UNOPENED)) {
+                    Perl_warner(aTHX_ packWARN(WARN_UNOPENED),
+                                "chdir() on unopened filehandle %" SVf, sv);
+                }
+                SETERRNO(EBADF,RMS_IFI);
+                PUSHi(0);
+                TAINT_PROPER("chdir");
+                RETURN;
+            }
        }
         else if (!(gv = MAYBE_DEREF_GV(sv)))
                tmps = SvPV_nomg_const_nolen(sv);
        }
         else if (!(gv = MAYBE_DEREF_GV(sv)))
                tmps = SvPV_nomg_const_nolen(sv);
@@ -3602,6 +3661,7 @@ PP(pp_chdir)
        HV * const table = GvHVn(PL_envgv);
        SV **svp;
 
        HV * const table = GvHVn(PL_envgv);
        SV **svp;
 
+        EXTEND(SP, 1);
         if (    (svp = hv_fetchs(table, "HOME", FALSE))
              || (svp = hv_fetchs(table, "LOGDIR", FALSE))
 #ifdef VMS
         if (    (svp = hv_fetchs(table, "HOME", FALSE))
              || (svp = hv_fetchs(table, "LOGDIR", FALSE))
 #ifdef VMS
@@ -3613,6 +3673,7 @@ PP(pp_chdir)
         }
         else {
             PUSHi(0);
         }
         else {
             PUSHi(0);
+            SETERRNO(EINVAL, LIB_INVARG);
             TAINT_PROPER("chdir");
             RETURN;
         }
             TAINT_PROPER("chdir");
             RETURN;
         }
@@ -3691,17 +3752,20 @@ PP(pp_rename)
 {
     dSP; dTARGET;
     int anum;
 {
     dSP; dTARGET;
     int anum;
+#ifndef HAS_RENAME
+    Stat_t statbuf;
+#endif
     const char * const tmps2 = POPpconstx;
     const char * const tmps = SvPV_nolen_const(TOPs);
     TAINT_PROPER("rename");
 #ifdef HAS_RENAME
     anum = PerlLIO_rename(tmps, tmps2);
 #else
     const char * const tmps2 = POPpconstx;
     const char * const tmps = SvPV_nolen_const(TOPs);
     TAINT_PROPER("rename");
 #ifdef HAS_RENAME
     anum = PerlLIO_rename(tmps, tmps2);
 #else
-    if (!(anum = PerlLIO_stat(tmps, &PL_statbuf))) {
+    if (!(anum = PerlLIO_stat(tmps, &statbuf))) {
        if (same_dirent(tmps2, tmps))   /* can always rename to same name */
            anum = 1;
        else {
        if (same_dirent(tmps2, tmps))   /* can always rename to same name */
            anum = 1;
        else {
-           if (PerlProc_geteuid() || PerlLIO_stat(tmps2, &PL_statbuf) < 0 || !S_ISDIR(PL_statbuf.st_mode))
+           if (PerlProc_geteuid() || PerlLIO_stat(tmps2, &statbuf) < 0 || !S_ISDIR(statbuf.st_mode))
                (void)UNLINK(tmps2);
            if (!(anum = link(tmps, tmps2)))
                anum = UNLINK(tmps);
                (void)UNLINK(tmps2);
            if (!(anum = link(tmps, tmps2)))
                anum = UNLINK(tmps);
@@ -3863,7 +3927,8 @@ S_dooneliner(pTHX_ const char *cmd, const char *filename)
            return 0;
        }
        else {  /* some mkdirs return no failure indication */
            return 0;
        }
        else {  /* some mkdirs return no failure indication */
-           anum = (PerlLIO_stat(save_filename, &PL_statbuf) >= 0);
+           Stat_t statbuf;
+           anum = (PerlLIO_stat(save_filename, &statbuf) >= 0);
            if (PL_op->op_type == OP_RMDIR)
                anum = !anum;
            if (anum)
            if (PL_op->op_type == OP_RMDIR)
                anum = !anum;
            if (anum)
@@ -3904,7 +3969,7 @@ PP(pp_mkdir)
     STRLEN len;
     const char *tmps;
     bool copy = FALSE;
     STRLEN len;
     const char *tmps;
     bool copy = FALSE;
-    const int mode = (MAXARG > 1 && (TOPs||((void)POPs,0))) ? POPi : 0777;
+    const unsigned int mode = (MAXARG > 1 && (TOPs||((void)POPs,0))) ? POPu : 0777;
 
     TRIMSLASHES(tmps,len,copy);
 
 
     TRIMSLASHES(tmps,len,copy);
 
@@ -3955,9 +4020,8 @@ PP(pp_open_dir)
     IO * const io = GvIOn(gv);
 
     if ((IoIFP(io) || IoOFP(io)))
     IO * const io = GvIOn(gv);
 
     if ((IoIFP(io) || IoOFP(io)))
-       Perl_ck_warner_d(aTHX_ packWARN2(WARN_IO, WARN_DEPRECATED),
-                        "Opening filehandle %"HEKf" also as a directory",
-                            HEKfARG(GvENAME_HEK(gv)) );
+       Perl_croak(aTHX_ "Cannot open %" HEKf " as a dirhandle: it is already open as a filehandle",
+                        HEKfARG(GvENAME_HEK(gv)));
     if (IoDIRP(io))
        PerlDir_close(IoDIRP(io));
     if (!(IoDIRP(io) = PerlDir_open(dirname)))
     if (IoDIRP(io))
        PerlDir_close(IoDIRP(io));
     if (!(IoDIRP(io) = PerlDir_open(dirname)))
@@ -3984,14 +4048,14 @@ PP(pp_readdir)
     dSP;
 
     SV *sv;
     dSP;
 
     SV *sv;
-    const I32 gimme = GIMME_V;
+    const U8 gimme = GIMME_V;
     GV * const gv = MUTABLE_GV(POPs);
     const Direntry_t *dp;
     IO * const io = GvIOn(gv);
 
     if (!IoDIRP(io)) {
        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
     GV * const gv = MUTABLE_GV(POPs);
     const Direntry_t *dp;
     IO * const io = GvIOn(gv);
 
     if (!IoDIRP(io)) {
        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
-                      "readdir() attempted on invalid dirhandle %"HEKf,
+                      "readdir() attempted on invalid dirhandle %" HEKf,
                             HEKfARG(GvENAME_HEK(gv)));
         goto nope;
     }
                             HEKfARG(GvENAME_HEK(gv)));
         goto nope;
     }
@@ -4041,7 +4105,7 @@ PP(pp_telldir)
 
     if (!IoDIRP(io)) {
        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
 
     if (!IoDIRP(io)) {
        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
-                      "telldir() attempted on invalid dirhandle %"HEKf,
+                      "telldir() attempted on invalid dirhandle %" HEKf,
                             HEKfARG(GvENAME_HEK(gv)));
         goto nope;
     }
                             HEKfARG(GvENAME_HEK(gv)));
         goto nope;
     }
@@ -4067,7 +4131,7 @@ PP(pp_seekdir)
 
     if (!IoDIRP(io)) {
        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
 
     if (!IoDIRP(io)) {
        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
-                      "seekdir() attempted on invalid dirhandle %"HEKf,
+                      "seekdir() attempted on invalid dirhandle %" HEKf,
                                 HEKfARG(GvENAME_HEK(gv)));
         goto nope;
     }
                                 HEKfARG(GvENAME_HEK(gv)));
         goto nope;
     }
@@ -4092,7 +4156,7 @@ PP(pp_rewinddir)
 
     if (!IoDIRP(io)) {
        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
 
     if (!IoDIRP(io)) {
        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
-                      "rewinddir() attempted on invalid dirhandle %"HEKf,
+                      "rewinddir() attempted on invalid dirhandle %" HEKf,
                                 HEKfARG(GvENAME_HEK(gv)));
        goto nope;
     }
                                 HEKfARG(GvENAME_HEK(gv)));
        goto nope;
     }
@@ -4116,7 +4180,7 @@ PP(pp_closedir)
 
     if (!IoDIRP(io)) {
        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
 
     if (!IoDIRP(io)) {
        Perl_ck_warner(aTHX_ packWARN(WARN_IO),
-                      "closedir() attempted on invalid dirhandle %"HEKf,
+                      "closedir() attempted on invalid dirhandle %" HEKf,
                                 HEKfARG(GvENAME_HEK(gv)));
         goto nope;
     }
                                 HEKfARG(GvENAME_HEK(gv)));
         goto nope;
     }
@@ -4182,7 +4246,7 @@ PP(pp_fork)
     PUSHi(childpid);
     RETURN;
 #else
     PUSHi(childpid);
     RETURN;
 #else
-#  if defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)
+#  if (defined(USE_ITHREADS) && defined(PERL_IMPLICIT_SYS)) || defined(__amigaos4__)
     dSP; dTARGET;
     Pid_t childpid;
 
     dSP; dTARGET;
     Pid_t childpid;
 
@@ -4234,6 +4298,12 @@ PP(pp_waitpid)
     const int optype = POPi;
     const Pid_t pid = TOPi;
     Pid_t result;
     const int optype = POPi;
     const Pid_t pid = TOPi;
     Pid_t result;
+#ifdef __amigaos4__
+    int argflags = 0;
+    result = amigaos_waitpid(aTHX_ optype, pid, &argflags);
+    STATUS_NATIVE_CHILD_SET((result >= 0) ? argflags : -1);
+    result = result == 0 ? pid : -1;
+#else
     int argflags;
 
     if (PL_signals & PERL_SIGNALS_UNSAFE_FLAG)
     int argflags;
 
     if (PL_signals & PERL_SIGNALS_UNSAFE_FLAG)
@@ -4250,6 +4320,7 @@ PP(pp_waitpid)
 #  else
     STATUS_NATIVE_CHILD_SET((result > 0) ? argflags : -1);
 #  endif
 #  else
     STATUS_NATIVE_CHILD_SET((result > 0) ? argflags : -1);
 #  endif
+# endif /* __amigaos4__ */
     SETi(result);
     RETURN;
 #else
     SETi(result);
     RETURN;
 #else
@@ -4266,7 +4337,11 @@ PP(pp_system)
     XPUSHi(-1);
 #else
     I32 value;
     XPUSHi(-1);
 #else
     I32 value;
+# ifdef __amigaos4__
+    void * result;
+# else
     int result;
     int result;
+# endif
 
     if (TAINTING_get) {
        TAINT_ENV();
 
     if (TAINTING_get) {
        TAINT_ENV();
@@ -4279,17 +4354,33 @@ PP(pp_system)
        TAINT_PROPER("system");
     }
     PERL_FLUSHALL_FOR_CHILD;
        TAINT_PROPER("system");
     }
     PERL_FLUSHALL_FOR_CHILD;
-#if (defined(HAS_FORK) || defined(AMIGAOS)) && !defined(VMS) && !defined(OS2) || defined(PERL_MICRO)
+#if (defined(HAS_FORK) || defined(__amigaos4__)) && !defined(VMS) && !defined(OS2) || defined(PERL_MICRO)
     {
     {
+#ifdef __amigaos4__
+        struct UserData userdata;
+        pthread_t proc;
+#else
        Pid_t childpid;
        Pid_t childpid;
+#endif
        int pp[2];
        I32 did_pipes = 0;
        int pp[2];
        I32 did_pipes = 0;
+        bool child_success = FALSE;
 #ifdef HAS_SIGPROCMASK
        sigset_t newset, oldset;
 #endif
 
        if (PerlProc_pipe(pp) >= 0)
            did_pipes = 1;
 #ifdef HAS_SIGPROCMASK
        sigset_t newset, oldset;
 #endif
 
        if (PerlProc_pipe(pp) >= 0)
            did_pipes = 1;
+#ifdef __amigaos4__
+        amigaos_fork_set_userdata(aTHX_
+                                  &userdata,
+                                  did_pipes,
+                                  pp[1],
+                                  SP,
+                                  mark);
+        pthread_create(&proc,NULL,amigaos_system_child,(void *)&userdata);
+        child_success = proc > 0;
+#else
 #ifdef HAS_SIGPROCMASK
        sigemptyset(&newset);
        sigaddset(&newset, SIGCHLD);
 #ifdef HAS_SIGPROCMASK
        sigemptyset(&newset);
        sigaddset(&newset, SIGCHLD);
@@ -4311,19 +4402,27 @@ PP(pp_system)
            }
            sleep(5);
        }
            }
            sleep(5);
        }
-       if (childpid > 0) {
+        child_success = childpid > 0;
+#endif
+       if (child_success) {
            Sigsave_t ihand,qhand; /* place to save signals during system() */
            int status;
 
            Sigsave_t ihand,qhand; /* place to save signals during system() */
            int status;
 
+#ifndef __amigaos4__
            if (did_pipes)
                PerlLIO_close(pp[1]);
            if (did_pipes)
                PerlLIO_close(pp[1]);
+#endif
 #ifndef PERL_MICRO
            rsignal_save(SIGINT,  (Sighandler_t) SIG_IGN, &ihand);
            rsignal_save(SIGQUIT, (Sighandler_t) SIG_IGN, &qhand);
 #endif
 #ifndef PERL_MICRO
            rsignal_save(SIGINT,  (Sighandler_t) SIG_IGN, &ihand);
            rsignal_save(SIGQUIT, (Sighandler_t) SIG_IGN, &qhand);
 #endif
+#ifdef __amigaos4__
+            result = pthread_join(proc, (void **)&status);
+#else
            do {
                result = wait4pid(childpid, &status, 0);
            } while (result == -1 && errno == EINTR);
            do {
                result = wait4pid(childpid, &status, 0);
            } while (result == -1 && errno == EINTR);
+#endif
 #ifndef PERL_MICRO
 #ifdef HAS_SIGPROCMASK
            sigprocmask(SIG_SETMASK, &oldset, NULL);
 #ifndef PERL_MICRO
 #ifdef HAS_SIGPROCMASK
            sigprocmask(SIG_SETMASK, &oldset, NULL);
@@ -4337,10 +4436,9 @@ PP(pp_system)
            if (did_pipes) {
                int errkid;
                unsigned n = 0;
            if (did_pipes) {
                int errkid;
                unsigned n = 0;
-               SSize_t n1;
 
                while (n < sizeof(int)) {
 
                while (n < sizeof(int)) {
-                   n1 = PerlLIO_read(pp[0],
+                    const SSize_t n1 = PerlLIO_read(pp[0],
                                      (void*)(((char*)&errkid)+n),
                                      (sizeof(int)) - n);
                    if (n1 <= 0)
                                      (void*)(((char*)&errkid)+n),
                                      (sizeof(int)) - n);
                    if (n1 <= 0)
@@ -4352,18 +4450,26 @@ PP(pp_system)
                    if (n != sizeof(int))
                        DIE(aTHX_ "panic: kid popen errno read, n=%u", n);
                    errno = errkid;             /* Propagate errno from kid */
                    if (n != sizeof(int))
                        DIE(aTHX_ "panic: kid popen errno read, n=%u", n);
                    errno = errkid;             /* Propagate errno from kid */
-                   STATUS_NATIVE_CHILD_SET(-1);
+#ifdef __amigaos4__
+                    /* The pipe always has something in it
+                     * so n alone is not enough. */
+                    if (errno > 0)
+#endif
+                    {
+                        STATUS_NATIVE_CHILD_SET(-1);
+                    }
                }
            }
            XPUSHi(STATUS_CURRENT);
            RETURN;
        }
                }
            }
            XPUSHi(STATUS_CURRENT);
            RETURN;
        }
+#ifndef __amigaos4__
 #ifdef HAS_SIGPROCMASK
        sigprocmask(SIG_SETMASK, &oldset, NULL);
 #endif
        if (did_pipes) {
            PerlLIO_close(pp[0]);
 #ifdef HAS_SIGPROCMASK
        sigprocmask(SIG_SETMASK, &oldset, NULL);
 #endif
        if (did_pipes) {
            PerlLIO_close(pp[0]);
-#if defined(HAS_FCNTL) && defined(F_SETFD)
+#if defined(HAS_FCNTL) && defined(F_SETFD) && defined(FD_CLOEXEC)
            if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0)
                 RETPUSHUNDEF;
 #endif
            if (fcntl(pp[1], F_SETFD, FD_CLOEXEC) < 0)
                 RETPUSHUNDEF;
 #endif
@@ -4377,6 +4483,7 @@ PP(pp_system)
        else {
            value = (I32)do_exec3(SvPVx_nolen(sv_mortalcopy(*SP)), pp[1], did_pipes);
        }
        else {
            value = (I32)do_exec3(SvPVx_nolen(sv_mortalcopy(*SP)), pp[1], did_pipes);
        }
+#endif /* __amigaos4__ */
        PerlProc__exit(-1);
     }
 #else /* ! FORK or VMS or OS/2 */
        PerlProc__exit(-1);
     }
 #else /* ! FORK or VMS or OS/2 */
@@ -4426,6 +4533,7 @@ PP(pp_exec)
        MARK = ORIGMARK;
        TAINT_PROPER("exec");
     }
        MARK = ORIGMARK;
        TAINT_PROPER("exec");
     }
+
     PERL_FLUSHALL_FOR_CHILD;
     if (PL_op->op_flags & OPf_STACKED) {
        SV * const really = *++MARK;
     PERL_FLUSHALL_FOR_CHILD;
     if (PL_op->op_flags & OPf_STACKED) {
        SV * const really = *++MARK;
@@ -4444,7 +4552,6 @@ PP(pp_exec)
        value = (I32)do_exec(SvPVx_nolen(sv_mortalcopy(*SP)));
 #endif
     }
        value = (I32)do_exec(SvPVx_nolen(sv_mortalcopy(*SP)));
 #endif
     }
-
     SP = ORIGMARK;
     XPUSHi(value);
     RETURN;
     SP = ORIGMARK;
     XPUSHi(value);
     RETURN;
@@ -4655,9 +4762,9 @@ PP(pp_gmtime)
     }
     else {
        if (PL_op->op_type == OP_LOCALTIME)
     }
     else {
        if (PL_op->op_type == OP_LOCALTIME)
-           err = S_localtime64_r(&when, &tmbuf);
+           err = Perl_localtime64_r(&when, &tmbuf);
        else
        else
-           err = S_gmtime64_r(&when, &tmbuf);
+           err = Perl_gmtime64_r(&when, &tmbuf);
     }
 
     if (err == NULL) {
     }
 
     if (err == NULL) {
@@ -4675,7 +4782,7 @@ PP(pp_gmtime)
        else {
            dTARGET;
            PUSHs(TARG);
        else {
            dTARGET;
            PUSHs(TARG);
-           Perl_sv_setpvf_mg(aTHX_ TARG, "%s %s %2d %02d:%02d:%02d %"IVdf,
+           Perl_sv_setpvf_mg(aTHX_ TARG, "%s %s %2d %02d:%02d:%02d %" IVdf,
                                 dayname[tmbuf.tm_wday],
                                 monname[tmbuf.tm_mon],
                                 tmbuf.tm_mday,
                                 dayname[tmbuf.tm_wday],
                                 monname[tmbuf.tm_mon],
                                 tmbuf.tm_mday,
@@ -4740,7 +4847,6 @@ PP(pp_alarm)
 PP(pp_sleep)
 {
     dSP; dTARGET;
 PP(pp_sleep)
 {
     dSP; dTARGET;
-    I32 duration;
     Time_t lasttime;
     Time_t when;
 
     Time_t lasttime;
     Time_t when;
 
@@ -4748,7 +4854,7 @@ PP(pp_sleep)
     if (MAXARG < 1 || (!TOPs && !POPs))
        PerlProc_pause();
     else {
     if (MAXARG < 1 || (!TOPs && !POPs))
        PerlProc_pause();
     else {
-       duration = POPi;
+        const I32 duration = POPi;
         if (duration < 0) {
           /* diag_listed_as: %s() with negative argument */
           Perl_ck_warner_d(aTHX_ packWARN(WARN_MISC),
         if (duration < 0) {
           /* diag_listed_as: %s() with negative argument */
           Perl_ck_warner_d(aTHX_ packWARN(WARN_MISC),
@@ -4848,9 +4954,7 @@ S_space_join_names_mortal(pTHX_ char *const *array)
 {
     SV *target;
 
 {
     SV *target;
 
-    PERL_ARGS_ASSERT_SPACE_JOIN_NAMES_MORTAL;
-
-    if (*array) {
+    if (array && *array) {
        target = newSVpvs_flags("", SVs_TEMP);
        while (1) {
            sv_catpv(target, *array);
        target = newSVpvs_flags("", SVs_TEMP);
        while (1) {
            sv_catpv(target, *array);
Unnamed repository; edit this file 'description' to name the repository.