It looks like the only way to reliably make Perl_hv_name_set a pure

[perl5.git] / pp_pack.c

diff --git a/pp_pack.c b/pp_pack.c
index 2bcb731..479782e 100644 (file)
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -240,6 +240,8 @@ S_mul128(pTHX_ SV *sv, U8 m)
 # define DO_BO_PACK_N(var, type)
 # define DO_BO_UNPACK_P(var)
 # define DO_BO_PACK_P(var)
+# define DO_BO_UNPACK_PC(var)
+# define DO_BO_PACK_PC(var)
 
 #else /* PERL_PACK_CAN_BYTEORDER */
 
@@ -323,6 +325,8 @@ S_mul128(pTHX_ SV *sv, U8 m)
 # else
 #  define DO_BO_UNPACK_P(var)  BO_CANT_DOIT(unpack, pointer)
 #  define DO_BO_PACK_P(var)    BO_CANT_DOIT(pack, pointer)
+#  define DO_BO_UNPACK_PC(var) BO_CANT_DOIT(unpack, pointer)
+#  define DO_BO_PACK_PC(var)   BO_CANT_DOIT(pack, pointer)
 # endif
 
 # if defined(my_htolen) && defined(my_letohn) && \
@@ -1024,8 +1028,7 @@ S_next_symbol(pTHX_ tempsym_t* symptr )
           Perl_croak(aTHX_ "Can't use '%c' in a group with different byte-order in %s",
                      *patptr, _action( symptr ) );
 
-        if (ckWARN(WARN_UNPACK)) {
-          if (code & modifier)
+        if ((code & modifier) && ckWARN(WARN_UNPACK)) {
            Perl_warner(aTHX_ packWARN(WARN_UNPACK),
                         "Duplicate modifier '%c' after '%c' in %s",
                         *patptr, (int) TYPE_NO_MODIFIERS(code),
@@ -1117,7 +1120,6 @@ S_next_symbol(pTHX_ tempsym_t* symptr )
    version of the string. Users are advised to upgrade their pack string
    themselves if they need to do a lot of unpacks like this on it
 */
-/* XXX These can be const */
 STATIC bool
 need_utf8(const char *pat, const char *patend)
 {
@@ -2392,8 +2394,8 @@ S_div128(pTHX_ SV *pnum, bool *done)
 The engine implementing pack() Perl function. Note: parameters next_in_list and
 flags are not used. This call should not be used; use packlist instead.
 
-=cut */
-
+=cut
+*/
 
 void
 Perl_pack_cat(pTHX_ SV *cat, const char *pat, const char *patend, register SV **beglist, SV **endlist, SV ***next_in_list, U32 flags)
@@ -2413,8 +2415,8 @@ Perl_pack_cat(pTHX_ SV *cat, const char *pat, const char *patend, register SV **
 
 The engine implementing pack() Perl function.
 
-=cut */
-
+=cut
+*/
 
 void
 Perl_packlist(pTHX_ SV *cat, const char *pat, const char *patend, register SV **beglist, SV **endlist )
@@ -2427,7 +2429,8 @@ Perl_packlist(pTHX_ SV *cat, const char *pat, const char *patend, register SV **
     /* We're going to do changes through SvPVX(cat). Make sure it's valid.
        Also make sure any UTF8 flag is loaded */
     SvPV_force(cat, no_len);
-    if (DO_UTF8(cat)) sym.flags |= FLAG_PARSE_UTF8 | FLAG_DO_UTF8;
+    if (DO_UTF8(cat))
+       sym.flags |= FLAG_PARSE_UTF8 | FLAG_DO_UTF8;
 
     (void)pack_rec( cat, &sym, beglist, endlist );
 }
@@ -2518,6 +2521,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
     I32 items  = endlist - beglist;
     bool found = next_symbol(symptr);
     bool utf8 = (symptr->flags & FLAG_PARSE_UTF8) ? 1 : 0;
+    bool warn_utf8 = ckWARN(WARN_UTF8);
 
     if (symptr->level == 0 && found && symptr->code == 'U') {
        marked_upgrade(aTHX_ cat, symptr);
@@ -2843,7 +2847,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
            end = str + fromlen;
            if (DO_UTF8(fromstr)) {
                utf8_source = TRUE;
-               utf8_flags  = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY;
+               utf8_flags  = warn_utf8 ? 0 : UTF8_ALLOW_ANY;
            } else {
                utf8_source = FALSE;
                utf8_flags  = 0; /* Unused, but keep compilers happy */
@@ -2912,7 +2916,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
            end = str + fromlen;
            if (DO_UTF8(fromstr)) {
                utf8_source = TRUE;
-               utf8_flags  = ckWARN(WARN_UTF8) ? 0 : UTF8_ALLOW_ANY;
+               utf8_flags  = warn_utf8 ? 0 : UTF8_ALLOW_ANY;
            } else {
                utf8_source = FALSE;
                utf8_flags  = 0; /* Unused, but keep compilers happy */
@@ -3025,7 +3029,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                    }
                    cur = (char *) uvuni_to_utf8_flags((U8 *) cur,
                                                       NATIVE_TO_UNI(auv),
-                                                      ckWARN(WARN_UTF8) ?
+                                                      warn_utf8 ?
                                                       0 : UNICODE_ALLOW_ANY);
                } else {
                    if (auv >= 0x100) {
@@ -3079,7 +3083,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                if (utf8) {
                    U8 buffer[UTF8_MAXLEN], *endb;
                    endb = uvuni_to_utf8_flags(buffer, auv,
-                                              ckWARN(WARN_UTF8) ?
+                                              warn_utf8 ?
                                               0 : UNICODE_ALLOW_ANY);
                    if (cur+(endb-buffer)*UTF8_EXPAND >= end) {
                        *cur = '\0';
@@ -3097,7 +3101,7 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                        end = start+SvLEN(cat)-UTF8_MAXLEN;
                    }
                    cur = (char *) uvuni_to_utf8_flags((U8 *) cur, auv,
-                                                      ckWARN(WARN_UTF8) ?
+                                                      warn_utf8 ?
                                                       0 : UNICODE_ALLOW_ANY);
                }
            }
@@ -3524,9 +3528,8 @@ S_pack_rec(pTHX_ SV *cat, tempsym_t* symptr, SV **beglist, SV **endlist )
                     * of pack() (and all copies of the result) are
                     * gone.
                     */
-                   if (ckWARN(WARN_PACK) &&
-                       (SvTEMP(fromstr) || (SvPADTMP(fromstr) &&
-                                            !SvREADONLY(fromstr)))) {
+                   if ((SvTEMP(fromstr) || (SvPADTMP(fromstr) &&
+                            !SvREADONLY(fromstr))) && ckWARN(WARN_PACK)) {
                        Perl_warner(aTHX_ packWARN(WARN_PACK),
                                    "Attempt to pack pointer to temporary value");
                    }