This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
hek_dup can now store the HEK rather than the HE, as there is now a
[perl5.git] / pp_sys.c
index a0aa747..4e2b412 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1009,7 +1009,6 @@ PP(pp_sselect)
     struct timeval *tbuf = &timebuf;
     I32 growsize;
     char *fd_sets[4];
-    STRLEN n_a;
 #if BYTEORDER != 0x1234 && BYTEORDER != 0x12345678
        I32 masksize;
        I32 offset;
@@ -1025,9 +1024,16 @@ PP(pp_sselect)
 
     SP -= 4;
     for (i = 1; i <= 3; i++) {
-       if (!SvPOK(SP[i]))
+       SV *sv = SP[i];
+       if (SvOK(sv) && SvREADONLY(sv)) {
+           if (SvIsCOW(sv))
+               sv_force_normal_flags(sv, 0);
+           if (SvREADONLY(sv))
+               DIE(aTHX_ PL_no_modify);
+       }
+       if (!SvPOK(sv))
            continue;
-       j = SvCUR(SP[i]);
+       j = SvCUR(sv);
        if (maxlen < j)
            maxlen = j;
     }
@@ -1081,7 +1087,7 @@ PP(pp_sselect)
            continue;
        }
        else if (!SvPOK(sv))
-           SvPV_force(sv,n_a); /* force string conversion */
+           SvPV_force_nolen(sv);       /* force string conversion */
        j = SvLEN(sv);
        if (j < growsize) {
            Sv_Grow(sv, growsize);
@@ -2431,7 +2437,8 @@ PP(pp_bind)
     extern void GETUSERMODE();
 #endif
     SV *addrsv = POPs;
-    char *addr;
+    /* OK, so on what platform does bind modify addr?  */
+    const char *addr;
     GV *gv = (GV*)POPs;
     register IO *io = GvIOn(gv);
     STRLEN len;
@@ -2443,7 +2450,7 @@ PP(pp_bind)
     if (!io || !IoIFP(io))
        goto nuts;
 
-    addr = SvPV(addrsv, len);
+    addr = SvPV_const(addrsv, len);
     TAINT_PROPER("bind");
 #ifdef MPE /* Deal with MPE bind() peculiarities */
     if (((struct sockaddr *)addr)->sa_family == AF_INET) {
@@ -2486,7 +2493,7 @@ PP(pp_connect)
 #ifdef HAS_SOCKET
     dSP;
     SV *addrsv = POPs;
-    char *addr;
+    const char *addr;
     GV *gv = (GV*)POPs;
     register IO *io = GvIOn(gv);
     STRLEN len;
@@ -2494,7 +2501,7 @@ PP(pp_connect)
     if (!io || !IoIFP(io))
        goto nuts;
 
-    addr = SvPV(addrsv, len);
+    addr = SvPV_const(addrsv, len);
     TAINT_PROPER("connect");
     if (PerlSock_connect(PerlIO_fileno(IoIFP(io)), (struct sockaddr *)addr, len) >= 0)
        RETPUSHYES;
@@ -2681,16 +2688,16 @@ PP(pp_ssockopt)
        PUSHs(sv);
        break;
     case OP_SSOCKOPT: {
-           char *buf;
+           const char *buf;
            int aint;
            if (SvPOKp(sv)) {
                STRLEN l;
-               buf = SvPV(sv, l);
+               buf = SvPV_const(sv, l);
                len = l;
            }
            else {
                aint = (int)SvIV(sv);
-               buf = (char*)&aint;
+               buf = (const char*)&aint;
                len = sizeof(int);
            }
            if (PerlSock_setsockopt(fd, lvl, optname, buf, len) < 0)
@@ -2754,8 +2761,8 @@ PP(pp_getpeername)
        {
            static const char nowhere[] = "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0";
            /* If the call succeeded, make sure we don't have a zeroed port/addr */
-           if (((struct sockaddr *)SvPVX(sv))->sa_family == AF_INET &&
-               !memcmp((char *)SvPVX(sv) + sizeof(u_short), nowhere,
+           if (((struct sockaddr *)SvPVX_const(sv))->sa_family == AF_INET &&
+               !memcmp((char *)SvPVX_const(sv) + sizeof(u_short), nowhere,
                        sizeof(u_short) + sizeof(struct in_addr))) {
                goto nuts2;     
            }
@@ -2799,7 +2806,6 @@ PP(pp_stat)
     GV *gv;
     I32 gimme;
     I32 max = 13;
-    STRLEN n_a;
 
     if (PL_op->op_flags & OPf_REF) {
        gv = cGVOP_gv;
@@ -2839,15 +2845,15 @@ PP(pp_stat)
                        "lstat() on filehandle %s", GvENAME(gv));
            goto do_fstat;
        }
-       sv_setpv(PL_statname, SvPV_const(sv,n_a));
+       sv_setpv(PL_statname, SvPV_nolen_const(sv));
        PL_statgv = Nullgv;
        PL_laststype = PL_op->op_type;
        if (PL_op->op_type == OP_LSTAT)
-           PL_laststatval = PerlLIO_lstat(SvPV(PL_statname, n_a), &PL_statcache);
+           PL_laststatval = PerlLIO_lstat(SvPV_nolen_const(PL_statname), &PL_statcache);
        else
-           PL_laststatval = PerlLIO_stat(SvPV(PL_statname, n_a), &PL_statcache);
+           PL_laststatval = PerlLIO_stat(SvPV_nolen_const(PL_statname), &PL_statcache);
        if (PL_laststatval < 0) {
-           if (ckWARN(WARN_NEWLINE) && strchr(SvPV(PL_statname, n_a), '\n'))
+           if (ckWARN(WARN_NEWLINE) && strchr(SvPV_nolen_const(PL_statname), '\n'))
                Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "stat");
            max = 0;
        }
@@ -3011,7 +3017,6 @@ PP(pp_fteread)
     STACKED_FTEST_CHECK;
 #ifdef PERL_EFF_ACCESS_R_OK
     if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
-       STRLEN n_a;
        result = PERL_EFF_ACCESS_R_OK(POPpx);
        if (result == 0)
            RETPUSHYES;
@@ -3039,7 +3044,6 @@ PP(pp_ftewrite)
     STACKED_FTEST_CHECK;
 #ifdef PERL_EFF_ACCESS_W_OK
     if ((PL_op->op_private & OPpFT_ACCESS) && SvPOK(TOPs)) {
-       STRLEN n_a;
        result = PERL_EFF_ACCESS_W_OK(POPpx);
        if (result == 0)
            RETPUSHYES;
@@ -3353,7 +3357,7 @@ PP(pp_fttty)
     if (GvIO(gv) && IoIFP(GvIOp(gv)))
        fd = PerlIO_fileno(IoIFP(GvIOp(gv)));
     else if (tmpsv && SvOK(tmpsv)) {
-       char *tmps = SvPV_nolen(tmpsv);
+       const char *tmps = SvPV_nolen_const(tmpsv);
        if (isDIGIT(*tmps))
            fd = atoi(tmps);
        else 
@@ -3453,9 +3457,10 @@ PP(pp_fttext)
       really_filename:
        PL_statgv = Nullgv;
        PL_laststype = OP_STAT;
-       sv_setpv(PL_statname, SvPV_nolen(sv));
+       sv_setpv(PL_statname, SvPV_nolen_const(sv));
        if (!(fp = PerlIO_open(SvPVX_const(PL_statname), "r"))) {
-           if (ckWARN(WARN_NEWLINE) && strchr(SvPV_nolen(PL_statname), '\n'))
+           if (ckWARN(WARN_NEWLINE) && strchr(SvPV_nolen_const(PL_statname),
+                                              '\n'))
                Perl_warner(aTHX_ packWARN(WARN_NEWLINE), PL_warn_nl, "open");
            RETPUSHUNDEF;
        }
@@ -5638,7 +5643,6 @@ PP(pp_syscall)
     unsigned long a[20];
     register I32 i = 0;
     I32 retval = -1;
-    STRLEN n_a;
 
     if (PL_tainting) {
        while (++MARK <= SP) {
@@ -5661,7 +5665,7 @@ PP(pp_syscall)
        else if (*MARK == &PL_sv_undef)
            a[i++] = 0;
        else
-           a[i++] = (unsigned long)SvPV_force(*MARK, n_a);
+           a[i++] = (unsigned long)SvPV_force_nolen(*MARK);
        if (i > 15)
            break;
     }