continued -Wformat support

Message-Id: <200009141707.SAA13276@tempest.npl.co.uk>

p4raw-id: //depot/perl@7081

diff --git a/Porting/pumpkin.pod b/Porting/pumpkin.pod
index 99776b5..d761059 100644 (file)
--- a/Porting/pumpkin.pod
+++ b/Porting/pumpkin.pod
@@ -701,6 +701,34 @@ supports dynamic loading, you can also test static loading with
 You can also hand-tweak your config.h to try out different #ifdef
 branches.
 
+=head2 Other tests
+
+=over 4
+
+=item CHECK_FORMAT
+
+To test the correct use of printf-style arguments, C<Configure> with
+S<-Dccflags='-DCHECK_FORMAT -Wformat'> and run C<make>.  The compiler
+will produce warning of incorrect use of format arguments.  CHECK_FORMAT
+changes perl-defined formats to common formats, so DO NOT USE the executable
+produced by this process. 
+
+A more accurate approach is the following commands:
+
+    sh Configure -des -Dccflags=-Wformat ...
+    make miniperl              # without -DCHECK_FORMAT
+    perl -i.orig -pwe 's/-Wformat/-DCHECK_FORMAT $&/' config.sh
+    sh Configure -S
+    make >& make.log           # build from correct miniperl
+    make clean
+    make miniperl >& mini.log  # build miniperl with -DCHECK_FORMAT 
+    perl -nwe 'print if /^\S+:/ and not /^make\b/' mini.log make.log
+    make clean
+
+(-Wformat support by Robin Barker.)
+
+=back
+
 =head1 Running Purify
 
 Purify is a commercial tool that is helpful in identifying memory

diff --git a/embed.pl b/embed.pl
index 23214a3..559c62a 100755 (executable)
--- a/embed.pl
+++ b/embed.pl
@@ -1428,7 +1428,7 @@ Afnrp     |void   |croak_nocontext|const char* pat|...
 Afnp   |OP*    |die_nocontext  |const char* pat|...
 Afnp   |void   |deb_nocontext  |const char* pat|...
 Afnp   |char*  |form_nocontext |const char* pat|...
-Afnp   |void   |load_module_nocontext|U32 flags|SV* name|SV* ver|...
+Anp    |void   |load_module_nocontext|U32 flags|SV* name|SV* ver|...
 Afnp   |SV*    |mess_nocontext |const char* pat|...
 Afnp   |void   |warn_nocontext |const char* pat|...
 Afnp   |void   |warner_nocontext|U32 err|const char* pat|...
@@ -1651,7 +1651,7 @@ p |void   |lex_start      |SV* line
 p      |OP*    |linklist       |OP* o
 p      |OP*    |list           |OP* o
 p      |OP*    |listkids       |OP* o
-Afp    |void   |load_module|U32 flags|SV* name|SV* ver|...
+Ap     |void   |load_module|U32 flags|SV* name|SV* ver|...
 Ap     |void   |vload_module|U32 flags|SV* name|SV* ver|va_list* args
 p      |OP*    |localize       |OP* arg|I32 lexical
 Apd    |I32    |looks_like_number|SV* sv

diff --git a/ext/ByteLoader/bytecode.h b/ext/ByteLoader/bytecode.h
index 83dc5a5..c6acd28 100644 (file)
--- a/ext/ByteLoader/bytecode.h
+++ b/ext/ByteLoader/bytecode.h
@@ -217,7 +217,11 @@ typedef IV IV64;
  *     -- BKS, June 2000
 */
 
-#define HEADER_FAIL(f, arg1, arg2)     \
+#define HEADER_FAIL(f) \
+       Perl_croak(aTHX_ "Invalid bytecode for this architecture: " f)
+#define HEADER_FAIL1(f, arg1)  \
+       Perl_croak(aTHX_ "Invalid bytecode for this architecture: " f, arg1)
+#define HEADER_FAIL2(f, arg1, arg2)    \
        Perl_croak(aTHX_ "Invalid bytecode for this architecture: " f, arg1, arg2)
 
 #define BYTECODE_HEADER_CHECK                                  \
@@ -227,27 +231,27 @@ typedef IV IV64;
                                                                \
            BGET_U32(sz); /* Magic: 'PLBC' */                   \
            if (sz != 0x43424c50) {                             \
-               HEADER_FAIL("bad magic (want 0x43424c50, got %#x)", sz, 0);             \
+               HEADER_FAIL1("bad magic (want 0x43424c50, got %#x)", (int)sz);          \
            }                                                   \
            BGET_strconst(str); /* archname */                  \
            if (strNE(str, ARCHNAME)) {                         \
-               HEADER_FAIL("wrong architecture (want %s, you have %s)",str,ARCHNAME);  \
+               HEADER_FAIL2("wrong architecture (want %s, you have %s)",str,ARCHNAME); \
            }                                                   \
            BGET_strconst(str); /* ByteLoader version */        \
            if (strNE(str, VERSION)) {                          \
-               HEADER_FAIL("mismatched ByteLoader versions (want %s, you have %s)",    \
+               HEADER_FAIL2("mismatched ByteLoader versions (want %s, you have %s)",   \
                        str, VERSION);                          \
            }                                                   \
            BGET_U32(sz); /* ivsize */                          \
            if (sz != IVSIZE) {                                 \
-               HEADER_FAIL("different IVSIZE", 0, 0);          \
+               HEADER_FAIL("different IVSIZE");                \
            }                                                   \
            BGET_U32(sz); /* ptrsize */                         \
            if (sz != PTRSIZE) {                                \
-               HEADER_FAIL("different PTRSIZE", 0, 0);         \
+               HEADER_FAIL("different PTRSIZE");               \
            }                                                   \
            BGET_strconst(str); /* byteorder */                 \
            if (strNE(str, STRINGIFY(BYTEORDER))) {             \
-               HEADER_FAIL("different byteorder", 0, 0);       \
+               HEADER_FAIL("different byteorder");     \
            }                                                   \
        } STMT_END

diff --git a/ext/Devel/Peek/Peek.xs b/ext/Devel/Peek/Peek.xs
index 9837e9c..dea57b1 100644 (file)
--- a/ext/Devel/Peek/Peek.xs
+++ b/ext/Devel/Peek/Peek.xs
@@ -173,7 +173,7 @@ void
 DumpProg()
 PPCODE:
 {
-    warn("dumpindent is %d", PL_dumpindent);
+    warn("dumpindent is %d", (int)PL_dumpindent);
     if (PL_main_root)
        op_dump(PL_main_root);
 }

diff --git a/ext/DynaLoader/dl_dlopen.xs b/ext/DynaLoader/dl_dlopen.xs
index 8e4936d..350b0d5 100644 (file)
--- a/ext/DynaLoader/dl_dlopen.xs
+++ b/ext/DynaLoader/dl_dlopen.xs
@@ -198,7 +198,7 @@ int
 dl_unload_file(libref)
     void *     libref
   CODE:
-    DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_unload_file(%lx):\n", libref));
+    DLDEBUG(1,PerlIO_printf(Perl_debug_log, "dl_unload_file(%lx):\n", PTR2ul(libref)));
     RETVAL = (dlclose(libref) == 0 ? 1 : 0);
     if (!RETVAL)
         SaveError(aTHX_ "%s", dlerror()) ;

diff --git a/ext/Storable/Storable.xs b/ext/Storable/Storable.xs
index bb830a9..9ace909 100644 (file)
--- a/ext/Storable/Storable.xs
+++ b/ext/Storable/Storable.xs
@@ -2818,7 +2818,7 @@ static SV *retrieve_idx_blessed(stcxt_t *cxt)
 
        sva = av_fetch(cxt->aclass, idx, FALSE);
        if (!sva)
-               CROAK(("Class name #%d should have been seen already", idx));
+               CROAK(("Class name #%d should have been seen already", (int)idx));
 
        class = SvPVX(*sva);    /* We know it's a PV, by construction */
 
@@ -2979,7 +2979,7 @@ static SV *retrieve_hook(stcxt_t *cxt)
 
                sva = av_fetch(cxt->aclass, idx, FALSE);
                if (!sva)
-                       CROAK(("Class name #%d should have been seen already", idx));
+                       CROAK(("Class name #%d should have been seen already", (int)idx));
 
                class = SvPVX(*sva);    /* We know it's a PV, by construction */
                TRACEME(("class ID %d => %s", idx, class));
@@ -3079,7 +3079,7 @@ static SV *retrieve_hook(stcxt_t *cxt)
                        tag = ntohl(tag);
                        svh = av_fetch(cxt->aseen, tag, FALSE);
                        if (!svh)
-                               CROAK(("Object #%d should have been retrieved already", tag));
+                               CROAK(("Object #%d should have been retrieved already", (int)tag));
                        xsv = *svh;
                        ary[i] = SvREFCNT_inc(xsv);
                }
@@ -4100,7 +4100,7 @@ static SV *retrieve(stcxt_t *cxt)
                        I32 tagn;
                        svh = hv_fetch(cxt->hseen, (char *) &tag, sizeof(tag), FALSE);
                        if (!svh)
-                               CROAK(("Old tag 0x%x should have been mapped already", tag));
+                               CROAK(("Old tag 0x%x should have been mapped already", (unsigned)tag));
                        tagn = SvIV(*svh);      /* Mapped tag number computed earlier below */
 
                        /*
@@ -4109,7 +4109,7 @@ static SV *retrieve(stcxt_t *cxt)
 
                        svh = av_fetch(cxt->aseen, tagn, FALSE);
                        if (!svh)
-                               CROAK(("Object #%d should have been retrieved already", tagn));
+                               CROAK(("Object #%d should have been retrieved already", (int)tagn));
                        sv = *svh;
                        TRACEME(("has retrieved #%d at 0x%"UVxf, tagn, PTR2UV(sv)));
                        SvREFCNT_inc(sv);       /* One more reference to this same sv */
@@ -4150,7 +4150,7 @@ again:
                tag = ntohl(tag);
                svh = av_fetch(cxt->aseen, tag, FALSE);
                if (!svh)
-                       CROAK(("Object #%d should have been retrieved already", tag));
+                       CROAK(("Object #%d should have been retrieved already", (int)tag));
                sv = *svh;
                TRACEME(("had retrieved #%d at 0x%"UVxf, tag, PTR2UV(sv)));
                SvREFCNT_inc(sv);       /* One more reference to this same sv */

diff --git a/malloc.c b/malloc.c
index 57ca5a1..2db2a6a 100644 (file)
--- a/malloc.c
+++ b/malloc.c
@@ -1060,7 +1060,7 @@ Perl_malloc(register size_t nbytes)
            dTHX;
            PerlIO_printf(PerlIO_stderr(),
                          "Unaligned `next' pointer in the free "
-                         "chain 0x"UVxf" at 0x%"UVxf"\n",
+                         "chain 0x%"UVxf" at 0x%"UVxf"\n",
                          PTR2UV(p->ov_next), PTR2UV(p));
        }
 #endif

diff --git a/perl.c b/perl.c
index 39adc9b..d43a64b 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -2248,7 +2248,7 @@ Perl_moreswitches(pTHX_ char *s)
        return s;
     case 'v':
        PerlIO_printf(PerlIO_stdout(),
-                     Perl_form(aTHX_ "\nThis is perl, v%vd built for %s",
+                     Perl_form(aTHX_ "\nThis is perl, v%"VDf" built for %s",
                                PL_patchlevel, ARCHNAME));
 #if defined(LOCAL_PATCH_COUNT)
        if (LOCAL_PATCH_COUNT > 0)

diff --git a/perl.h b/perl.h
index ece27a2..5661851 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -1079,6 +1079,11 @@ typedef UVTYPE UV;
 #define PTR2IV(p)      INT2PTR(IV,p)
 #define PTR2UV(p)      INT2PTR(UV,p)
 #define PTR2NV(p)      NUM2PTR(NV,p)
+#if PTRSIZE == LONGSIZE 
+#  define PTR2ul(p)    (unsigned long)(p)
+#else
+#  define PTR2ul(p)    INT2PTR(unsigned long,p)        
+#endif
   
 #ifdef USE_LONG_DOUBLE
 #  if !(defined(HAS_LONG_DOUBLE) && (LONG_DOUBLESIZE > DOUBLESIZE))
@@ -1813,9 +1818,25 @@ typedef pthread_key_t    perl_key;
 #  endif 
 #endif
 
+#ifndef UVf
+#  ifdef CHECK_FORMAT
+#    define UVf UVuf
+#  else
+#    define UVf "Vu"
+#  endif 
+#endif
+
+#ifndef VDf
+#  ifdef CHECK_FORMAT
+#    define VDf "p"
+#  else
+#    define VDf "vd"
+#  endif 
+#endif
+
 /* Some unistd.h's give a prototype for pause() even though
    HAS_PAUSE ends up undefined.  This causes the #define
-   below to be rejected by the compmiler.  Sigh.
+   below to be rejected by the compiler.  Sigh.
 */
 #ifdef HAS_PAUSE
 #define Pause  pause

diff --git a/pp.c b/pp.c
index 1c5a963..d4a1df0 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -4045,7 +4045,7 @@ PP(pp_unpack)
                        char *t;
                        STRLEN n_a;
 
-                       sv = Perl_newSVpvf(aTHX_ "%.*Vu", (int)TYPE_DIGITS(UV), auv);
+                       sv = Perl_newSVpvf(aTHX_ "%.*"UVf, (int)TYPE_DIGITS(UV), auv);
                        while (s < strend) {
                            sv = mul128(sv, *s & 0x7f);
                            if (!(*s++ & 0x80)) {

diff --git a/proto.h b/proto.h
index 6a0229a..9c569f1 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -130,11 +130,7 @@ PERL_CALLCONV char*        Perl_form_nocontext(const char* pat, ...)
  __attribute__((format(printf,1,2)))
 #endif
 ;
-PERL_CALLCONV void     Perl_load_module_nocontext(U32 flags, SV* name, SV* ver, ...)
-#ifdef CHECK_FORMAT
- __attribute__((format(printf,3,4)))
-#endif
-;
+PERL_CALLCONV void     Perl_load_module_nocontext(U32 flags, SV* name, SV* ver, ...);
 PERL_CALLCONV SV*      Perl_mess_nocontext(const char* pat, ...)
 #ifdef CHECK_FORMAT
  __attribute__((format(printf,1,2)))
@@ -394,11 +390,7 @@ PERL_CALLCONV void Perl_lex_start(pTHX_ SV* line);
 PERL_CALLCONV OP*      Perl_linklist(pTHX_ OP* o);
 PERL_CALLCONV OP*      Perl_list(pTHX_ OP* o);
 PERL_CALLCONV OP*      Perl_listkids(pTHX_ OP* o);
-PERL_CALLCONV void     Perl_load_module(pTHX_ U32 flags, SV* name, SV* ver, ...)
-#ifdef CHECK_FORMAT
- __attribute__((format(printf,pTHX_3,pTHX_4)))
-#endif
-;
+PERL_CALLCONV void     Perl_load_module(pTHX_ U32 flags, SV* name, SV* ver, ...);
 PERL_CALLCONV void     Perl_vload_module(pTHX_ U32 flags, SV* name, SV* ver, va_list* args);
 PERL_CALLCONV OP*      Perl_localize(pTHX_ OP* arg, I32 lexical);
 PERL_CALLCONV I32      Perl_looks_like_number(pTHX_ SV* sv);

diff --git a/regcomp.c b/regcomp.c
index b0fd6da..766b84c 100644 (file)
--- a/regcomp.c
+++ b/regcomp.c
@@ -234,7 +234,7 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
            ellipses = "...";                                                \
        }                                                                    \
        Perl_croak(aTHX_ "%s in regex m/%.*s%s/",                            \
-                  msg, len, PL_regprecomp, ellipses);                        \
+                  msg, (int)len, PL_regprecomp, ellipses);                  \
     } STMT_END
 
 /*
@@ -256,7 +256,7 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
            ellipses = "...";                                                \
        }                                                                    \
        S_re_croak2(aTHX_ pat, " in regex m/%.*s%s/",                        \
-                   msg, len, PL_regprecomp, ellipses);                     \
+                   msg, (int)len, PL_regprecomp, ellipses);                \
     } STMT_END
 
 
@@ -268,7 +268,7 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
       unsigned offset = strlen(PL_regprecomp)-(PL_regxend-PL_regcomp_parse); \
                                                                              \
       Perl_croak(aTHX_ "%s" REPORT_LOCATION,               \
-                m, offset, PL_regprecomp, PL_regprecomp + offset);          \
+                m, (int)offset, PL_regprecomp, PL_regprecomp + offset);     \
     } STMT_END
 
 /*
@@ -289,7 +289,7 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
       unsigned offset = strlen(PL_regprecomp)-(PL_regxend-PL_regcomp_parse); \
                                                                              \
       S_re_croak2(aTHX_ m, REPORT_LOCATION, a1,       \
-                 offset, PL_regprecomp, PL_regprecomp + offset);            \
+                 (int)offset, PL_regprecomp, PL_regprecomp + offset);       \
     } STMT_END
 
 /*
@@ -311,7 +311,7 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
       unsigned offset = strlen(PL_regprecomp)-(PL_regxend-PL_regcomp_parse); \
                                                                              \
       S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, a2,   \
-                 offset, PL_regprecomp, PL_regprecomp + offset);            \
+                 (int)offset, PL_regprecomp, PL_regprecomp + offset);       \
     } STMT_END
 
 /*
@@ -332,7 +332,7 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
       unsigned offset = strlen(PL_regprecomp)-(PL_regxend-PL_regcomp_parse); \
                                                                              \
       S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, a2, a3,\
-                 offset, PL_regprecomp, PL_regprecomp + offset);            \
+                 (int)offset, PL_regprecomp, PL_regprecomp + offset);       \
     } STMT_END
 
 /*
@@ -342,7 +342,7 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
     STMT_START {                                                             \
       unsigned offset = strlen(PL_regprecomp)-(PL_regxend-PL_regcomp_parse); \
       S_re_croak2(aTHX_ m, REPORT_LOCATION, a1, a2, a3, a4,\
-                 offset, PL_regprecomp, PL_regprecomp + offset);            \
+                 (int)offset, PL_regprecomp, PL_regprecomp + offset);       \
     } STMT_END
 
 
@@ -350,7 +350,7 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
     STMT_START {                                                             \
         unsigned offset = strlen(PL_regprecomp)-(PL_regxend-(loc));          \
        Perl_warner(aTHX_ WARN_REGEXP, "%s" REPORT_LOCATION,\
-                m, offset, PL_regprecomp, PL_regprecomp + offset);          \
+                m, (int)offset, PL_regprecomp, PL_regprecomp + offset);          \
     } STMT_END                                                               \
 
 
@@ -359,7 +359,7 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
         unsigned offset = strlen(PL_regprecomp)-(PL_regxend-(loc));          \
        Perl_warner(aTHX_ WARN_REGEXP, m REPORT_LOCATION,\
                  a1,                                                         \
-                offset, PL_regprecomp, PL_regprecomp + offset);             \
+                (int)offset, PL_regprecomp, PL_regprecomp + offset);        \
     } STMT_END
 
 #define        vWARN3(loc, m, a1, a2)                                               \
@@ -367,7 +367,7 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
       unsigned offset = strlen(PL_regprecomp) - (PL_regxend - (loc));        \
        Perl_warner(aTHX_ WARN_REGEXP, m REPORT_LOCATION,                    \
                  a1, a2,                                                     \
-                offset, PL_regprecomp, PL_regprecomp + offset);             \
+                (int)offset, PL_regprecomp, PL_regprecomp + offset);        \
     } STMT_END
 
 #define        vWARN4(loc, m, a1, a2, a3)                                           \
@@ -375,7 +375,7 @@ static scan_data_t zero_scan_data = { 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
       unsigned offset = strlen(PL_regprecomp)-(PL_regxend-(loc));            \
        Perl_warner(aTHX_ WARN_REGEXP, m REPORT_LOCATION,\
                  a1, a2, a3,                                                 \
-                offset, PL_regprecomp, PL_regprecomp + offset);             \
+                (int)offset, PL_regprecomp, PL_regprecomp + offset);        \
     } STMT_END
 
 

diff --git a/toke.c b/toke.c
index 31f5f0a..e75d878 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -1219,7 +1219,7 @@ S_scan_const(pTHX_ char *start)
                 if (min > max) {
                    Perl_croak(aTHX_
                               "Invalid [] range \"%c-%c\" in transliteration operator",
-                              min, max);
+                              (char)min, (char)max);
                 }
 
 #ifndef ASCIIish
@@ -7354,7 +7354,7 @@ Perl_yyerror(pTHX_ char *s)
        qerror(msg);
     if (PL_error_count >= 10) {
        if (PL_in_eval && SvCUR(ERRSV))
-           Perl_croak(aTHX_ "%_%s has too many errors.\n",
+           Perl_croak(aTHX_ "%"SVf"%s has too many errors.\n",
                       ERRSV, CopFILE(PL_curcop));
        else
            Perl_croak(aTHX_ "%s has too many errors.\n",

diff --git a/universal.c b/universal.c
index 6c555a1..0899b1a 100644 (file)
--- a/universal.c
+++ b/universal.c
@@ -266,8 +266,8 @@ XS(XS_UNIVERSAL_VERSION)
                    /* they said C<use Foo v1.2.3> and $Foo::VERSION
                     * doesn't look like a float: do string compare */
                    if (sv_cmp(req,sv) == 1) {
-                       Perl_croak(aTHX_ "%s v%vd required--"
-                                  "this is only v%vd",
+                       Perl_croak(aTHX_ "%s v%"VDf" required--"
+                                  "this is only v%"VDf,
                                   HvNAME(pkg), req, sv);
                    }
                    goto finish;