Upgrade to Pod-Simple-3.04

[p5sagit/p5-mst-13.2.git] / mg.c

diff --git a/mg.c b/mg.c
index db0d4de..a85cc46 100644 (file)
--- a/mg.c
+++ b/mg.c
@@ -409,7 +409,7 @@ Perl_mg_localize(pTHX_ SV *sv, SV *nsv)
     dVAR;
     MAGIC *mg;
     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
-       const MGVTBL* const vtbl = mg->mg_virtual;
+       MGVTBL* const vtbl = mg->mg_virtual;
        switch (mg->mg_type) {
        /* value magic types: don't copy */
        case PERL_MAGIC_bm:
@@ -643,9 +643,11 @@ Perl_magic_len(pTHX_ SV *sv, MAGIC *mg)
 
 #define SvRTRIM(sv) STMT_START { \
     STRLEN len = SvCUR(sv); \
-    while (len > 0 && isSPACE(SvPVX(sv)[len-1])) \
+    char * const p = SvPVX(sv); \
+    while (len > 0 && isSPACE(p[len-1])) \
        --len; \
     SvCUR_set(sv, len); \
+    p[len] = '\0'; \
 } STMT_END
 
 int
@@ -816,7 +818,7 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
                 * it could have been extended by warnings::register */
                SV **bits_all;
                HV * const bits=get_hv("warnings::Bits", FALSE);
-               if (bits && (bits_all=hv_fetch(bits, "all", 3, FALSE))) {
+               if (bits && (bits_all=hv_fetchs(bits, "all", FALSE))) {
                    sv_setsv(sv, *bits_all);
                }
                else {
@@ -1002,29 +1004,22 @@ Perl_magic_get(pTHX_ SV *sv, MAGIC *mg)
        break;
     case '(':
        sv_setiv(sv, (IV)PL_gid);
-#ifdef HAS_GETGROUPS
-       Perl_sv_setpvf(aTHX_ sv, "%"Gid_t_f, PL_gid);
-#endif
        goto add_groups;
     case ')':
        sv_setiv(sv, (IV)PL_egid);
-#ifdef HAS_GETGROUPS
-       Perl_sv_setpvf(aTHX_ sv, "%"Gid_t_f, PL_egid);
-#endif
       add_groups:
 #ifdef HAS_GETGROUPS
        {
            Groups_t *gary = NULL;
-           I32 num_groups = getgroups(0, gary);
+           I32 i, num_groups = getgroups(0, gary);
             Newx(gary, num_groups, Groups_t);
             num_groups = getgroups(num_groups, gary);
-           while (--num_groups >= 0)
-               Perl_sv_catpvf(aTHX_ sv, " %"Gid_t_f,
-                              gary[num_groups]);
+           for (i = 0; i < num_groups; i++)
+               Perl_sv_catpvf(aTHX_ sv, " %"IVdf, (IV)gary[i]);
             Safefree(gary);
        }
-#endif
        (void)SvIOK_on(sv);     /* what a wonderful hack! */
+#endif
        break;
 #ifndef MACOS_TRADITIONAL
     case '0':
@@ -1257,7 +1252,7 @@ Perl_magic_clearsig(pTHX_ SV *sv, MAGIC *mg)
                PL_psig_name[i]=0;
            }
            if(PL_psig_ptr[i]) {
-                SV *to_dec=PL_psig_ptr[i];
+               SV * const to_dec=PL_psig_ptr[i];
                PL_psig_ptr[i]=0;
                LEAVE;
                SvREFCNT_dec(to_dec);
@@ -1964,12 +1959,11 @@ Perl_magic_getvec(pTHX_ SV *sv, MAGIC *mg)
     SV * const lsv = LvTARG(sv);
     PERL_UNUSED_ARG(mg);
 
-    if (!lsv) {
+    if (lsv)
+       sv_setuv(sv, do_vecget(lsv, LvTARGOFF(sv), LvTARGLEN(sv)));
+    else
        SvOK_off(sv);
-       return 0;
-    }
 
-    sv_setuv(sv, do_vecget(lsv, LvTARGOFF(sv), LvTARGLEN(sv)));
     return 0;
 }
 
@@ -2540,7 +2534,7 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
        /* The BSDs don't show the argv[] in ps(1) output, they
         * show a string from the process struct and provide
         * the setproctitle() routine to manipulate that. */
-       {
+       if (PL_origalen != 1) {
            s = SvPV_const(sv, len);
 #   if __FreeBSD_version > 410001
            /* The leading "-" removes the "perl: " prefix,
@@ -2561,35 +2555,37 @@ Perl_magic_set(pTHX_ SV *sv, MAGIC *mg)
        }
 #endif
 #if defined(__hpux) && defined(PSTAT_SETCMD)
-       {
+       if (PL_origalen != 1) {
             union pstun un;
             s = SvPV_const(sv, len);
             un.pst_command = (char *)s;
             pstat(PSTAT_SETCMD, un, len, 0, 0);
        }
 #endif
-       /* PL_origalen is set in perl_parse(). */
-       s = SvPV_force(sv,len);
-       if (len >= (STRLEN)PL_origalen-1) {
-           /* Longer than original, will be truncated. We assume that
-             * PL_origalen bytes are available. */
-           Copy(s, PL_origargv[0], PL_origalen-1, char);
+       if (PL_origalen > 1) {
+           /* PL_origalen is set in perl_parse(). */
+           s = SvPV_force(sv,len);
+           if (len >= (STRLEN)PL_origalen-1) {
+               /* Longer than original, will be truncated. We assume that
+                * PL_origalen bytes are available. */
+               Copy(s, PL_origargv[0], PL_origalen-1, char);
+           }
+           else {
+               /* Shorter than original, will be padded. */
+               Copy(s, PL_origargv[0], len, char);
+               PL_origargv[0][len] = 0;
+               memset(PL_origargv[0] + len + 1,
+                      /* Is the space counterintuitive?  Yes.
+                       * (You were expecting \0?)  
+                       * Does it work?  Seems to.  (In Linux 2.4.20 at least.)
+                       * --jhi */
+                      (int)' ',
+                      PL_origalen - len - 1);
+           }
+           PL_origargv[0][PL_origalen-1] = 0;
+           for (i = 1; i < PL_origargc; i++)
+               PL_origargv[i] = 0;
        }
-       else {
-           /* Shorter than original, will be padded. */
-           Copy(s, PL_origargv[0], len, char);
-           PL_origargv[0][len] = 0;
-           memset(PL_origargv[0] + len + 1,
-                  /* Is the space counterintuitive?  Yes.
-                   * (You were expecting \0?)  
-                   * Does it work?  Seems to.  (In Linux 2.4.20 at least.)
-                   * --jhi */
-                  (int)' ',
-                  PL_origalen - len - 1);
-       }
-       PL_origargv[0][PL_origalen-1] = 0;
-       for (i = 1; i < PL_origargc; i++)
-           PL_origargv[i] = 0;
        UNLOCK_DOLLARZERO_MUTEX;
        break;
 #endif