From: Robin Barker Date: Thu, 14 Sep 2000 18:07:38 +0000 (+0100) Subject: continued -Wformat support X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d2560b705d852dbc96fd94b95faaa076758b7a8c;p=p5sagit%2Fp5-mst-13.2.git 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 --- 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 with +S<-Dccflags='-DCHECK_FORMAT -Wformat'> and run C. 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- 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 --- a/universal.c +++ b/universal.c @@ -266,8 +266,8 @@ XS(XS_UNIVERSAL_VERSION) /* they said C 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;