develooper Front page | perl.perl5.porters | Postings from September 2000

[PATCH perl-5.7.0] continued -Wformat support

Thread Next
From:
Robin Barker
Date:
September 14, 2000 10:07
Subject:
[PATCH perl-5.7.0] continued -Wformat support
Message ID:
200009141707.SAA13276@tempest.npl.co.uk
I have patched my support for running printf format checks
on the perl source, using ccflags -Wformat and -DCHECK_FORMAT.

The patch below adds macros to allow proper checks to be made
(enabled by -DCHECK_FORMAT) and corrects the errors this detected.
The patch should be applied with C<patch -p1> and requires
C<make regen_headers>.  There are two warnings this detects that I
have not fixed (both appear deliberate).

	pp_sys.c: In function `Perl_pp_die':
	pp_sys.c:489: warning: null format string
	Storable.xs: In function `store_other':
	Storable.xs:2355: warning: embedded `\0' in format

As before, -DCHECK_FORMAT changes perl-defined formats to formats that
gcc knows and can type check against.  As a consequence you can not
built a correct perl with -DCHECK_FORMAT.  I have added a bit of text
to Porting/pumpkin.pod to explain some of this (see first patched file).

Robin

diff -r -u perl-5.7.0/Porting/pumpkin.pod perl-patch/Porting/pumpkin.pod
--- perl-5.7.0/Porting/pumpkin.pod	Sun Aug 13 19:33:05 2000
+++ perl-patch/Porting/pumpkin.pod	
@@ -701,6 +701,34 @@
 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 -r -u perl-5.7.0/embed.pl perl-patch/embed.pl
--- perl-5.7.0/embed.pl	Fri Sep  1 20:19:14 2000
+++ perl-patch/embed.pl	
@@ -138,7 +138,7 @@
 	if( $flags =~ /f/ ) { 
 	    my $prefix = $flags =~ /n/ ? '' : 'pTHX_';
 	    my $args = scalar @args; 
-	    $ret .= "\n#ifdef CHECK_FORMAT\n";
+	    $ret .= "\n#ifdef HASATTRIBUTE\n";
 	    $ret .= sprintf " __attribute__((format(printf,%s%d,%s%d)))",
 				    $prefix, $args - 1, $prefix, $args; 
 	    $ret .= "\n#endif\n";
@@ -1428,7 +1428,7 @@
 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	|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 -r -u perl-5.7.0/ext/ByteLoader/bytecode.h perl-patch/ext/ByteLoader/bytecode.h
--- perl-5.7.0/ext/ByteLoader/bytecode.h	Mon Aug 28 17:06:39 2000
+++ perl-patch/ext/ByteLoader/bytecode.h	
@@ -217,7 +217,11 @@
  *	-- 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 @@
 								\
 	    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 -r -u perl-5.7.0/ext/Devel/Peek/Peek.xs perl-patch/ext/Devel/Peek/Peek.xs
--- perl-5.7.0/ext/Devel/Peek/Peek.xs	Sun Aug 13 19:33:32 2000
+++ perl-patch/ext/Devel/Peek/Peek.xs	
@@ -173,7 +173,7 @@
 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 -r -u perl-5.7.0/ext/DynaLoader/dl_dlopen.xs perl-patch/ext/DynaLoader/dl_dlopen.xs
--- perl-5.7.0/ext/DynaLoader/dl_dlopen.xs	Sun Aug 13 19:33:32 2000
+++ perl-patch/ext/DynaLoader/dl_dlopen.xs	
@@ -198,7 +198,7 @@
 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 -r -u perl-5.7.0/ext/Storable/Storable.xs perl-patch/ext/Storable/Storable.xs
--- perl-5.7.0/ext/Storable/Storable.xs	Fri Sep  1 21:55:05 2000
+++ perl-patch/ext/Storable/Storable.xs	
@@ -2818,7 +2818,7 @@
 
 	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 @@
 
 		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 @@
 			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 @@
 			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 @@
 
 			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 @@
 		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 -r -u perl-5.7.0/malloc.c perl-patch/malloc.c
--- perl-5.7.0/malloc.c	Sun Aug 20 20:41:40 2000
+++ perl-patch/malloc.c	
@@ -1060,7 +1060,7 @@
 	    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 -r -u perl-5.7.0/perl.c perl-patch/perl.c
--- perl-5.7.0/perl.c	Wed Aug 30 14:52:07 2000
+++ perl-patch/perl.c	
@@ -2248,7 +2248,7 @@
 	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 -r -u perl-5.7.0/perl.h perl-patch/perl.h
--- perl-5.7.0/perl.h	Thu Aug 31 18:00:13 2000
+++ perl-patch/perl.h	
@@ -1079,6 +1079,11 @@
 #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 @@
 #  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 -r -u perl-5.7.0/pp.c perl-patch/pp.c
--- perl-5.7.0/pp.c	Fri Aug 25 19:29:31 2000
+++ perl-patch/pp.c	
@@ -4045,7 +4045,7 @@
 			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 -r -u perl-5.7.0/regcomp.c perl-patch/regcomp.c
--- perl-5.7.0/regcomp.c	Tue Aug 22 15:30:00 2000
+++ perl-patch/regcomp.c	
@@ -234,7 +234,7 @@
 	    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 @@
 	    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 @@
       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 @@
       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 @@
       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 @@
       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 @@
     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 @@
     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 @@
         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 @@
       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 @@
       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 -r -u perl-5.7.0/toke.c perl-patch/toke.c
--- perl-5.7.0/toke.c	Fri Sep  1 14:59:20 2000
+++ perl-patch/toke.c	
@@ -1219,7 +1219,7 @@
                 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 @@
 	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 -r -u perl-5.7.0/universal.c perl-patch/universal.c
--- perl-5.7.0/universal.c	Sun Aug 13 19:37:04 2000
+++ perl-patch/universal.c	
@@ -266,8 +266,8 @@
 		    /* 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;

-- 
Robin Barker                        | Email: Robin.Barker@npl.co.uk
CMSC, Building 10,                  | Phone: +44 (0) 20 8943 7090
National Physical Laboratory,       | Fax:   +44 (0) 20 8977 7091
Teddington, Middlesex, UK. TW11 OLW | WWW:   http://www.npl.co.uk

Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About