to improve -DCHECK_FORMAT

Message-ID: <533D273D4014D411AB1D00062938C4D90849C55A@hotel.npl.co.uk>

p4raw-id: //depot/perl@23767

5 files changed, 33 insertions, 8 deletions

diff --git a/mg.c b/mg.c
index 83157215ce..255e2082e5 100644
--- a/mg.c
+++ b/mg.c
@@ -2616,7 +2616,7 @@ Perl_sighandler(int sig)
 	(void)rsignal(sig, PL_csighandlerp);
 #endif
 #endif /* !PERL_MICRO */
-	Perl_die(aTHX_ Nullformat);
+	DieNull;
     }
 cleanup:
     if (flags & 1)
diff --git a/perl.h b/perl.h
index 4bcf22970d..06e8a136d0 100644
--- a/perl.h
+++ b/perl.h
@@ -2392,9 +2392,9 @@ typedef pthread_key_t	perl_key;
 
 #ifndef SVf
 #  ifdef CHECK_FORMAT
-#    define SVf "p"
+#    define SVf "-p"
 #    ifndef SVf256
-#      define SVf256 SVf
+#      define SVf256 "-256p" 
 #    endif
 #  else
 #    define SVf "_"
@@ -2415,17 +2415,17 @@ typedef pthread_key_t	perl_key;
 
 #ifndef VDf
 #  ifdef CHECK_FORMAT
-#    define VDf "p"
+#    define VDf "-1p"
 #  else
 #    define VDf "vd"
 #  endif
 #endif
 
-#ifndef Nullformat
+#ifndef DieNull
 #  ifdef CHECK_FORMAT
-#    define Nullformat "%s",""
+#    define DieNull vdie(aTHX_ Nullch, Null(va_list *))
 #  else
-#    define Nullformat Nullch
+#    define DieNull Perl_die(aTHX_ Nullch)
 #  endif
 #endif
 
diff --git a/pp.h b/pp.h
index 82635dfd80..fed78e6f37 100644
--- a/pp.h
+++ b/pp.h
@@ -88,6 +88,7 @@ Refetch the stack pointer.  Used after a callback.  See L<perlcall>.
 
 #define NORMAL PL_op->op_next
 #define DIE return Perl_die
+#define DIE_NULL return DieNull
 
 /*
 =for apidoc Ams||PUTBACK
diff --git a/pp_sys.c b/pp_sys.c
index e0d9ca065d..e125fb93ed 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -504,7 +504,7 @@ PP(pp_die)
 		    sv_setsv(error,*PL_stack_sp--);
 		}
 	    }
-	    DIE(aTHX_ Nullformat);
+	    DIE_NULL;
 	}
 	else {
 	    if (SvPOK(error) && SvCUR(error))
diff --git a/sv.c b/sv.c
index a009dfcb5e..d750f10944 100644
--- a/sv.c
+++ b/sv.c
@@ -9392,6 +9392,11 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 		fill = *q++;
 	    EXPECT_NUMBER(q, width);
 
+#ifdef CHECK_FORMAT
+	if ((*q == 'p') && left) {
+	     vectorize = (width == 1);
+	}
+#endif
 	if (vectorize) {
 	    if (vectorarg) {
 		if (args)
@@ -9583,6 +9588,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	    goto string;
 
 	case '_':
+#ifdef CHECK_FORMAT
+	format_sv:
+#endif
 	    /*
 	     * The "%_" hack might have to be changed someday,
 	     * if ISO or ANSI decide to use '_' for something.
@@ -9604,6 +9612,19 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 	    /* INTEGERS */
 
 	case 'p':
+#ifdef CHECK_FORMAT
+	    if (left) {
+		left = FALSE;
+		if (width > 0) {
+		    width = 0;
+		    if (vectorize) 
+			goto format_d;
+		    precis = width;
+		    has_precis = TRUE;
+		}
+		goto format_sv;
+	    }
+#endif
 	    if (alt || vectorize)
 		goto unknown;
 	    uv = PTR2UV(args ? va_arg(*args, void*) : argsv);
@@ -9616,6 +9637,9 @@ Perl_sv_vcatpvfn(pTHX_ SV *sv, const char *pat, STRLEN patlen, va_list *args, SV
 #else
 	    intsize = 'l';
 #endif
+#ifdef CHECK_FORMAT
+	format_d:
+#endif
 	    /* FALL THROUGH */
 	case 'd':
 	case 'i':