From: Andy Lester <andy@petdance.com>
Date: Sun, 1 May 2005 15:07:55 +0000 (-0500)
Subject: printf.patch: Adding printf checking for gcc
X-Git-Tag: perl-5.9.3~2142
X-Git-Url: https://perl5.git.perl.org/perl5.git/commitdiff_plain/b7787f18a4d9a5b6205453133731406d627268af

printf.patch: Adding printf checking for gcc
Message-ID: <20050501200755.GA30259@petdance.com>

p4raw-id: //depot/perl@24365
---

diff --git a/gv.c b/gv.c
index 8ea4171..d6a62e4 100644
--- a/gv.c
+++ b/gv.c
@@ -241,7 +241,7 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
 
     /* create and re-create @.*::SUPER::ISA on demand */
     if (!av || !SvMAGIC(av)) {
-	char* packname = HvNAME(stash);
+	const char* packname = HvNAME(stash);
 	STRLEN packlen = strlen(packname);
 
 	if (packlen >= 7 && strEQ(packname + packlen - 7, "::SUPER")) {
@@ -338,7 +338,7 @@ Perl_gv_fetchmeth_autoload(pTHX_ HV *stash, const char *name, STRLEN len, I32 le
     GV *gv = gv_fetchmeth(stash, name, len, level);
 
     if (!gv) {
-	char autoload[] = "AUTOLOAD";
+	const char autoload[] = "AUTOLOAD";
 	STRLEN autolen = sizeof(autoload)-1;
 	CV *cv;
 	GV **gvp;
@@ -484,8 +484,8 @@ GV*
 Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
 {
     dVAR;
-    char autoload[] = "AUTOLOAD";
-    STRLEN autolen = sizeof(autoload)-1;
+    const char autoload[] = "AUTOLOAD";
+    const STRLEN autolen = sizeof(autoload)-1;
     GV* gv;
     CV* cv;
     HV* varstash;
@@ -647,17 +647,15 @@ valid UTF-8 string.  See C<gv_stashpv>.
 HV*
 Perl_gv_stashsv(pTHX_ SV *sv, I32 create)
 {
-    register char *ptr;
     STRLEN len;
-    ptr = SvPV(sv,len);
+    const char *ptr = SvPV(sv,len);
     return gv_stashpvn(ptr, len, create);
 }
 
 
 GV *
 Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 add, I32 sv_type) {
-    STRLEN len = strlen (nambeg);
-    return gv_fetchpvn_flags(nambeg, len, add, sv_type);
+    return gv_fetchpvn_flags(nambeg, strlen(nambeg), add, sv_type);
 }
 
 GV *
@@ -1179,10 +1177,9 @@ Perl_gv_efullname(pTHX_ SV *sv, const GV *gv)
 IO *
 Perl_newIO(pTHX)
 {
-    IO *io;
     GV *iogv;
+    IO * const io = (IO*)NEWSV(0,0);
 
-    io = (IO*)NEWSV(0,0);
     sv_upgrade((SV *)io,SVt_PVIO);
     SvREFCNT(io) = 1;
     SvOBJECT_on(io);
@@ -1201,14 +1198,14 @@ void
 Perl_gv_check(pTHX_ HV *stash)
 {
     register I32 i;
-    register GV *gv;
-    HV *hv;
 
     if (!HvARRAY(stash))
 	return;
     for (i = 0; i <= (I32) HvMAX(stash); i++) {
         const HE *entry;
 	for (entry = HvARRAY(stash)[i]; entry; entry = HeNEXT(entry)) {
+            register GV *gv;
+            HV *hv;
 	    if (HeKEY(entry)[HeKLEN(entry)-1] == ':' &&
 		(gv = (GV*)HeVAL(entry)) && isGV(gv) && (hv = GvHV(gv)))
 	    {
@@ -1464,7 +1461,6 @@ Perl_gv_handler(pTHX_ HV *stash, I32 id)
 {
     MAGIC *mg;
     AMT *amtp;
-    CV *ret;
 
     if (!stash || !HvNAME(stash))
         return Nullcv;
@@ -1479,7 +1475,7 @@ Perl_gv_handler(pTHX_ HV *stash, I32 id)
 	 || amtp->was_ok_sub != PL_sub_generation )
 	goto do_update;
     if (AMT_AMAGIC(amtp)) {
-	ret = amtp->table[id];
+	CV * const ret = amtp->table[id];
 	if (ret && isGV(ret)) {		/* Autoloading stab */
 	    /* Passing it through may have resulted in a warning
 	       "Inherited AUTOLOAD for a non-method deprecated", since
@@ -1556,12 +1552,12 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
 	 case string_amg:
 	   (void)((cv = cvp[off=numer_amg]) || (cv = cvp[off=bool__amg]));
 	   break;
- case not_amg:
-   (void)((cv = cvp[off=bool__amg])
-	  || (cv = cvp[off=numer_amg])
-	  || (cv = cvp[off=string_amg]));
-   postpr = 1;
-   break;
+         case not_amg:
+           (void)((cv = cvp[off=bool__amg])
+                  || (cv = cvp[off=numer_amg])
+                  || (cv = cvp[off=string_amg]));
+           postpr = 1;
+           break;
 	 case copy_amg:
 	   {
 	     /*
@@ -1764,7 +1760,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
     dSP;
     BINOP myop;
     SV* res;
-    bool oldcatch = CATCH_GET;
+    const bool oldcatch = CATCH_GET;
 
     CATCH_SET(TRUE);
     Zero(&myop, 1, BINOP);
@@ -1802,7 +1798,7 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
     CATCH_SET(oldcatch);
 
     if (postpr) {
-      int ans=0;
+      int ans;
       switch (method) {
       case le_amg:
       case sle_amg:
@@ -1827,6 +1823,8 @@ Perl_amagic_call(pTHX_ SV *left, SV *right, int method, int flags)
 	SvSetSV(left,res); return left;
       case not_amg:
 	ans=!SvTRUE(res); break;
+      default:
+        ans=0; break;
       }
       return boolSV(ans);
     } else if (method==copy_amg) {
diff --git a/lib/ExtUtils/t/Embed.t b/lib/ExtUtils/t/Embed.t
index 1c82cd9..010d05a 100644
--- a/lib/ExtUtils/t/Embed.t
+++ b/lib/ExtUtils/t/Embed.t
@@ -168,7 +168,9 @@ int main(int argc, char **argv, char **env)
     my_vars = my_plvarsp = plvarsp;
 #  endif
 #endif /* PERL_GLOBAL_STRUCT */
-    
+
+    (void)argc; /* PERL_SYS_INIT3 may #define away their use */
+    (void)argv;
     PERL_SYS_INIT3(&argc,&argv,&env);
 
     my_perl = perl_alloc();
diff --git a/pad.c b/pad.c
index ce6ef3f..5b1148c 100644
--- a/pad.c
+++ b/pad.c
@@ -1378,7 +1378,6 @@ Perl_cv_clone(pTHX_ CV *proto)
     SV** ppad = AvARRAY(protopad);
     const I32 fname = AvFILLp(protopad_name);
     const I32 fpad = AvFILLp(protopad);
-    AV* comppadlist;
     CV* cv;
     SV** outpad;
     CV* outside;
@@ -1425,7 +1424,7 @@ Perl_cv_clone(pTHX_ CV *proto)
     if (SvPOK(proto))
 	sv_setpvn((SV*)cv, SvPVX(proto), SvCUR(proto));
 
-    CvPADLIST(cv) = comppadlist = pad_new(padnew_CLONE|padnew_SAVE);
+    CvPADLIST(cv) = pad_new(padnew_CLONE|padnew_SAVE);
 
     av_fill(PL_comppad, fpad);
     for (ix = fname; ix >= 0; ix--)
diff --git a/perl.c b/perl.c
index 96f5b2d..81f3690 100644
--- a/perl.c
+++ b/perl.c
@@ -407,7 +407,7 @@ perl_destruct(pTHXx)
     destruct_level = PL_perl_destruct_level;
 #ifdef DEBUGGING
     {
-	char *s;
+	const char *s;
 	if ((s = PerlEnv_getenv("PERL_DESTRUCT_LEVEL"))) {
             const int i = atoi(s);
 	    if (destruct_level < i)
diff --git a/perl.h b/perl.h
index 2e36142..0b3a6a2 100644
--- a/perl.h
+++ b/perl.h
@@ -2536,12 +2536,12 @@ typedef pthread_key_t	perl_key;
 
 #ifndef __attribute__format__
 #  ifdef CHECK_FORMAT
-#    define __attribute__format__(x,y,z) __attribute__((__format__(x,y,z)))
+#    define __attribute__format__(x,y,z) __attribute__((format(x,y,z)))
 #  else
 #    define __attribute__format__(x,y,z)
 #  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 compiler.  Sigh.
diff --git a/perlio.c b/perlio.c
index 3f659ca..fbe8da2 100644
--- a/perlio.c
+++ b/perlio.c
@@ -163,6 +163,9 @@ perlsio_binmode(FILE *fp, int iotype, int mode)
     else
 	return 0;
 #  else
+    (void)fp;
+    (void)iotype;
+    (void)mode;
     return 1;
 #  endif
 #endif
@@ -245,6 +248,9 @@ int
 PerlIO_binmode(pTHX_ PerlIO *fp, int iotype, int mode, const char *names)
 {
 #ifdef USE_SFIO
+    (void)iotype;
+    (void)mode;
+    (void)names;
     return 1;
 #else
     return perlsio_binmode(fp, iotype, mode);
diff --git a/perlio.h b/perlio.h
index f0e735e..9183948 100644
--- a/perlio.h
+++ b/perlio.h
@@ -210,10 +210,10 @@ PERL_EXPORT_C void PerlIO_clone(pTHX_ PerlInterpreter *proto,
 
 START_EXTERN_C
 #ifndef __attribute__format__
-#ifdef CHECK_FORMAT
-#define __attribute__format__(x,y,z) __attribute__((__format__(x,y,z)))
-#else
-#define __attribute__format__(x,y,z)
+#  ifdef CHECK_FORMAT
+#    define __attribute__format__(x,y,z) __attribute__((format(x,y,z)))
+#  else
+#    define __attribute__format__(x,y,z)
 #endif
 #endif
 #ifndef NEXT30_NO_ATTRIBUTE
diff --git a/perliol.h b/perliol.h
index 35f67e0..c6da2b6 100644
--- a/perliol.h
+++ b/perliol.h
@@ -147,8 +147,6 @@ PERL_EXPORT_C int PerlIO_apply_layera(pTHX_ PerlIO *f, const char *mode,
 		    PerlIO_list_t *layers, IV n, IV max);
 PERL_EXPORT_C int PerlIO_parse_layers(pTHX_ PerlIO_list_t *av, const char *names);
 PERL_EXPORT_C PerlIO_funcs *PerlIO_layer_fetch(pTHX_ PerlIO_list_t *av, IV n, PerlIO_funcs *def);
-PERL_EXPORT_C void PerlIO_debug(const char *fmt, ...)
-    __attribute__format__(__printf__, 1, 2);
 
 
 PERL_EXPORT_C SV *PerlIO_sv_dup(pTHX_ SV *arg, CLONE_PARAMS *param);
@@ -161,7 +159,8 @@ PERL_EXPORT_C PerlIO_list_t * PerlIO_resolve_layers(pTHX_ const char *layers, co
 PERL_EXPORT_C PerlIO_funcs * PerlIO_default_layer(pTHX_ I32 n);
 PERL_EXPORT_C PerlIO_list_t * PerlIO_default_layers(pTHX);
 PERL_EXPORT_C PerlIO * PerlIO_reopen(const char *path, const char *mode, PerlIO *f);
-PERL_EXPORT_C int PerlIO_vsprintf(char *s, int n, const char *fmt, va_list ap);
+PERL_EXPORT_C int PerlIO_vsprintf(char *s, int n, const char *fmt, va_list ap)
+                __attribute__format__(__printf__,3,0);
 
 PERL_EXPORT_C PerlIO_list_t *PerlIO_list_alloc(pTHX);
 PERL_EXPORT_C PerlIO_list_t *PerlIO_clone_list(pTHX_ PerlIO_list_t *proto, CLONE_PARAMS *param);
diff --git a/pp_pack.c b/pp_pack.c
index bb312a3..826b26e 100644
--- a/pp_pack.c
+++ b/pp_pack.c
@@ -940,7 +940,6 @@ S_next_symbol(pTHX_ tempsym_t* symptr )
 {
   const char* patptr = symptr->patptr;
   const char* patend = symptr->patend;
-  const char *allowed = "";
 
   symptr->flags &= ~FLAG_SLASH;
 
@@ -987,7 +986,8 @@ S_next_symbol(pTHX_ tempsym_t* symptr )
 
       /* look for modifiers */
       while (patptr < patend) {
-        I32 modifier = 0;
+        const char *allowed;
+        I32 modifier;
         switch (*patptr) {
           case '!':
             modifier = TYPE_IS_SHRIEKING;
@@ -1004,6 +1004,8 @@ S_next_symbol(pTHX_ tempsym_t* symptr )
             break;
 #endif /* PERL_PACK_CAN_BYTEORDER */
           default:
+            allowed = "";
+            modifier = 0;
             break;
         }
 
diff --git a/pp_sort.c b/pp_sort.c
index 649375a..1e338a81 100644
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -1463,7 +1463,7 @@ Perl_sortsv(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp)
 }
 
 
-void
+static void
 S_sortsv_desc(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp)
 {
     void (*sortsvp)(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
diff --git a/x2p/util.c b/x2p/util.c
index 5759c5b..20444de 100644
--- a/x2p/util.c
+++ b/x2p/util.c
@@ -177,7 +177,7 @@ growstr(char **strptr, int *curlen, int newlen)
 }
 
 void
-croak(char *pat,...)
+croak(const char *pat,...)
 {
 #if defined(HAS_VPRINTF)
     va_list args;
@@ -192,7 +192,7 @@ croak(char *pat,...)
 }
 
 void
-fatal(char *pat,...)
+fatal(const char *pat,...)
 {
 #if defined(HAS_VPRINTF)
     va_list args;
@@ -210,7 +210,7 @@ fatal(char *pat,...)
 __private_extern__	/* warn() conflicts with libc */
 #endif
 void
-warn(char *pat,...)
+warn(const char *pat,...)
 {
 #if defined(HAS_VPRINTF)
     va_list args;
diff --git a/x2p/util.h b/x2p/util.h
index e76a612..8ca913b 100644
--- a/x2p/util.h
+++ b/x2p/util.h
@@ -20,18 +20,15 @@
     int		eaccess();
 #endif
 
-char	*getwd();
-int	makedir();
-
 char * cpy2 ( char *to, char *from, int delim );
 char * cpytill ( char *to, char *from, int delim );
 void growstr ( char **strptr, int *curlen, int newlen );
 char * instr ( char *big, char *little );
 char * safecpy ( char *to, char *from, int len );
 char * savestr ( char *str );
-void croak ( char *pat, ... );
-void fatal ( char *pat, ... );
-void warn  ( char *pat, ... );
+void croak ( const char *pat, ... );
+void fatal ( const char *pat, ... );
+void warn  ( const char *pat, ... );
 int prewalk ( int numit, int level, int node, int *numericptr );
 
 Malloc_t safemalloc (MEM_SIZE nbytes);