This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
hexfp: Use Perl_fp_class_nzero unconditionally.
[perl5.git] / pp_sys.c
index c8c84b3..15b4d8b 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -533,6 +533,7 @@ Perl_tied_method(pTHX_ SV *methname, SV **sp, SV *const sv,
 {
     SV **orig_sp = sp;
     I32 ret_args;
+    SSize_t extend_size;
 
     PERL_ARGS_ASSERT_TIED_METHOD;
 
@@ -543,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);
-    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) {
@@ -681,8 +695,6 @@ PP(pp_pipe_op)
     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);
@@ -3720,17 +3732,20 @@ PP(pp_rename)
 {
     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
-    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 (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);
@@ -3892,7 +3907,8 @@ S_dooneliner(pTHX_ const char *cmd, const char *filename)
            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)
@@ -4321,7 +4337,7 @@ PP(pp_system)
     PERL_FLUSHALL_FOR_CHILD;
 #if (defined(HAS_FORK) || defined(__amigaos4__)) && !defined(VMS) && !defined(OS2) || defined(PERL_MICRO)
     {
-#if defined(__amigaos4__)
+#ifdef __amigaos4__
         struct UserData userdata;
         pthread_t proc;
 #else
@@ -4336,7 +4352,7 @@ PP(pp_system)
 
        if (PerlProc_pipe(pp) >= 0)
            did_pipes = 1;
-#if defined(__amigaos4__)
+#ifdef __amigaos4__
         amigaos_fork_set_userdata(aTHX_
                                   &userdata,
                                   did_pipes,
@@ -4416,7 +4432,7 @@ PP(pp_system)
                    if (n != sizeof(int))
                        DIE(aTHX_ "panic: kid popen errno read, n=%u", n);
                    errno = errkid;             /* Propagate errno from kid */
-#if defined(__amigaos4__)
+#ifdef __amigaos4__
                     /* The pipe always has something in it
                      * so n alone is not enough. */
                     if (errno > 0)
@@ -4488,9 +4504,6 @@ PP(pp_exec)
 {
     dSP; dMARK; dORIGMARK; dTARGET;
     I32 value;
-#if defined(__amigaos4__)
-    StdioStore store;
-#endif
 
     if (TAINTING_get) {
        TAINT_ENV();
@@ -4502,12 +4515,7 @@ PP(pp_exec)
        MARK = ORIGMARK;
        TAINT_PROPER("exec");
     }
-#if defined(__amigaos4__)
-    /* Make sure redirection behaves after exec.  Yes, in AmigaOS the
-     * original process continues after exec, since processes are more
-     * like threads. */
-    amigaos_stdio_save(aTHX_ &store);
-#endif
+
     PERL_FLUSHALL_FOR_CHILD;
     if (PL_op->op_flags & OPf_STACKED) {
        SV * const really = *++MARK;
@@ -4526,13 +4534,6 @@ PP(pp_exec)
        value = (I32)do_exec(SvPVx_nolen(sv_mortalcopy(*SP)));
 #endif
     }
-
-#if defined(__amigaos4__)
-    amigaos_stdio_restore(aTHX_ &store);
-    STATUS_NATIVE_CHILD_SET(value);
-    PL_exit_flags |= PERL_EXIT_EXPECTED;
-    if (value != -1) my_exit(value);
-#endif
     SP = ORIGMARK;
     XPUSHi(value);
     RETURN;