Most platforms don't actually need PL_pidstatus, or the associated

[perl5.git] / pp_sys.c

diff --git a/pp_sys.c b/pp_sys.c
index f082b4c..19a735a 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -87,7 +87,7 @@ extern int h_errno;
 #ifndef getpwent
   struct passwd *getpwent (void);
 #elif defined (VMS) && defined (my_getpwent)
-  struct passwd *Perl_my_getpwent (void);
+  struct passwd *Perl_my_getpwent (pTHX);
 #endif
 # endif
 #endif
@@ -382,7 +382,7 @@ PP(pp_backtick)
        TAINT;          /* "I believe that this is not gratuitous!" */
     }
     else {
-       STATUS_NATIVE_SET(-1);
+       STATUS_NATIVE_CHILD_SET(-1);
        if (gimme == G_SCALAR)
            RETPUSHUNDEF;
     }
@@ -1031,14 +1031,19 @@ PP(pp_sselect)
     SP -= 4;
     for (i = 1; i <= 3; i++) {
        SV *sv = SP[i];
-       if (SvOK(sv) && SvREADONLY(sv)) {
+       if (!SvOK(sv))
+           continue;
+       if (SvREADONLY(sv)) {
            if (SvIsCOW(sv))
                sv_force_normal_flags(sv, 0);
-           if (SvREADONLY(sv))
+           if (SvREADONLY(sv) && !(SvPOK(sv) && SvCUR(sv) == 0))
                DIE(aTHX_ PL_no_modify);
        }
-       if (!SvPOK(sv))
-           continue;
+       if (!SvPOK(sv)) {
+           if (ckWARN(WARN_MISC))
+                Perl_warner(aTHX_ packWARN(WARN_MISC), "Non-string passed as bitmask");
+           SvPV_force_nolen(sv);       /* force string conversion */
+       }
        j = SvCUR(sv);
        if (maxlen < j)
            maxlen = j;
@@ -1088,12 +1093,11 @@ PP(pp_sselect)
 
     for (i = 1; i <= 3; i++) {
        sv = SP[i];
-       if (!SvOK(sv)) {
+       if (!SvOK(sv) || SvCUR(sv) == 0) {
            fd_sets[i] = 0;
            continue;
        }
-       else if (!SvPOK(sv))
-           SvPV_force_nolen(sv);       /* force string conversion */
+       assert(SvPOK(sv));
        j = SvLEN(sv);
        if (j < growsize) {
            Sv_Grow(sv, growsize);
@@ -1148,10 +1152,7 @@ PP(pp_sselect)
        }
     }
 
-    if (nfound == -1)
-       PUSHs(&PL_sv_undef);
-    else
-       PUSHi(nfound);
+    PUSHi(nfound);
     if (GIMME == G_ARRAY && tbuf) {
        value = (NV)(timebuf.tv_sec) +
                (NV)(timebuf.tv_usec) / 1000000.0;
@@ -2686,16 +2687,30 @@ PP(pp_ssockopt)
        PUSHs(sv);
        break;
     case OP_SSOCKOPT: {
-           const char *buf;
+#if defined(__SYMBIAN32__)
+# define SETSOCKOPT_OPTION_VALUE_T void *
+#else
+# define SETSOCKOPT_OPTION_VALUE_T const char *
+#endif
+       /* XXX TODO: We need to have a proper type (a Configure probe,
+        * etc.) for what the C headers think of the third argument of
+        * setsockopt(), the option_value read-only buffer: is it
+        * a "char *", or a "void *", const or not.  Some compilers
+        * don't take kindly to e.g. assuming that "char *" implicitly
+        * promotes to a "void *", or to explicitly promoting/demoting
+        * consts to non/vice versa.  The "const void *" is the SUS
+        * definition, but that does not fly everywhere for the above
+        * reasons. */
+           SETSOCKOPT_OPTION_VALUE_T buf;
            int aint;
            if (SvPOKp(sv)) {
                STRLEN l;
-               buf = SvPV_const(sv, l);
+               buf = (SETSOCKOPT_OPTION_VALUE_T) SvPV_const(sv, l);
                len = l;
            }
            else {
                aint = (int)SvIV(sv);
-               buf = (const char*)&aint;
+               buf = (SETSOCKOPT_OPTION_VALUE_T) &aint;
                len = sizeof(int);
            }
            if (PerlSock_setsockopt(fd, lvl, optname, buf, len) < 0)
@@ -4113,7 +4128,9 @@ PP(pp_fork)
 #ifdef THREADS_HAVE_PIDS
        PL_ppid = (IV)getppid();
 #endif
+#ifdef PERL_USES_PL_PIDSTATUS
        hv_clear(PL_pidstatus); /* no kids, so don't wait for 'em */
+#endif
     }
     PUSHi(childpid);
     RETURN;
@@ -4250,7 +4267,7 @@ PP(pp_system)
            (void)rsignal_restore(SIGINT, &ihand);
            (void)rsignal_restore(SIGQUIT, &qhand);
 #endif
-           STATUS_NATIVE_SET(result == -1 ? -1 : status);
+           STATUS_NATIVE_CHILD_SET(result == -1 ? -1 : status);
            do_execfree();      /* free any memory child malloced on fork */
            SP = ORIGMARK;
            if (did_pipes) {
@@ -4270,7 +4287,7 @@ PP(pp_system)
                    if (n != sizeof(int))
                        DIE(aTHX_ "panic: kid popen errno read");
                    errno = errkid;             /* Propagate errno from kid */
-                   STATUS_CURRENT = -1;
+                   STATUS_NATIVE_CHILD_SET(-1);
                }
            }
            PUSHi(STATUS_CURRENT);
@@ -4298,14 +4315,14 @@ PP(pp_system)
     result = 0;
     if (PL_op->op_flags & OPf_STACKED) {
        SV *really = *++MARK;
-#  if defined(WIN32) || defined(OS2) || defined(SYMBIAN)
+#  if defined(WIN32) || defined(OS2) || defined(__SYMBIAN32__)
        value = (I32)do_aspawn(really, MARK, SP);
 #  else
        value = (I32)do_aspawn(really, (void **)MARK, (void **)SP);
 #  endif
     }
     else if (SP - MARK != 1) {
-#  if defined(WIN32) || defined(OS2) || defined(SYMBIAN)
+#  if defined(WIN32) || defined(OS2) || defined(__SYMBIAN32__)
        value = (I32)do_aspawn(Nullsv, MARK, SP);
 #  else
        value = (I32)do_aspawn(Nullsv, (void **)MARK, (void **)SP);
@@ -4872,7 +4889,7 @@ PP(pp_ghostent)
            h_errno = PL_reentrant_buffer->_gethostent_errno;
 #   endif
 #endif
-           STATUS_NATIVE_SET(h_errno);
+           STATUS_UNIX_SET(h_errno);
        }
 #endif
 
@@ -4983,7 +5000,7 @@ PP(pp_gnetent)
             h_errno = PL_reentrant_buffer->_getnetent_errno;
 #   endif
 #endif
-           STATUS_NATIVE_SET(h_errno);
+           STATUS_UNIX_SET(h_errno);
        }
 #endif