continued -Wformat support

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

p4raw-id: //depot/perl@7081

14 files changed, 91 insertions, 46 deletions

diff --git a/Porting/pumpkin.pod b/Porting/pumpkin.pod
index 99776b50d2..d7610595f0 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<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 23214a3f26..559c62a8f1 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 83dc5a5fb9..c6acd28436 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 9837e9ceb2..dea57b1712 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 8e4936d128..350b0d5074 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 bb830a9757..9ace909de1 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 57ca5a1b84..2db2a6a6bc 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 39adc9b869..d43a64bdf5 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 ece27a2ebe..5661851489 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 1c5a9638e9..d4a1df0c50 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 6a0229a7fc..9c569f1522 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 b0fd6da71f..766b84cfc8 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 31f5f0a903..e75d878c31 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 6c555a1347..0899b1a601 100644
--- 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;