From: Robin Barker Date: Mon, 13 Nov 2006 10:25:08 +0000 (+0000) Subject: was RE: Perl_die() / Perl_croak() X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=cdfeb707a2638190212953e4a52d8460de223429;p=p5sagit%2Fp5-mst-13.2.git was RE: Perl_die() / Perl_croak() From: "Robin Barker" Message-ID: <2C2E01334A940D4792B3E115F95B7226149377@exchsvr1.npl.ad.local> p4raw-id: //depot/perl@29259 --- diff --git a/embed.fnc b/embed.fnc index 3ac4bc4..0c82dfa 100644 --- a/embed.fnc +++ b/embed.fnc @@ -131,7 +131,7 @@ ApR |I32 |my_chsize |int fd|Off_t length pR |OP* |convert |I32 optype|I32 flags|NULLOK OP* o pM |PERL_CONTEXT* |create_eval_scope|U32 flags : croak()'s first parm can be NULL. Otherwise, mod_perl breaks. -Aprd |void |croak |NULLOK const char* pat|... +Afprd |void |croak |NULLOK const char* pat|... Apr |void |vcroak |NN const char* pat|NULLOK va_list* args #if defined(PERL_IMPLICIT_CONTEXT) Afnrp |void |croak_nocontext|NN const char* pat|... @@ -180,7 +180,7 @@ Ap |char* |delimcpy |NN char* to|NN const char* toend|NN const char* from \ pM |void |delete_eval_scope p |void |deprecate |NN const char* s p |void |deprecate_old |NN const char* s -Ap |OP* |die |NULLOK const char* pat|... +Afp |OP* |die |NULLOK const char* pat|... p |OP* |vdie |NULLOK const char* pat|NULLOK va_list* args p |OP* |die_where |NULLOK const char* message|STRLEN msglen Ap |void |dounwind |I32 cxix diff --git a/embed.pl b/embed.pl index 7d4dbc4..90b5f79 100755 --- a/embed.pl +++ b/embed.pl @@ -232,10 +232,14 @@ sub write_protos { push @attrs, "__attribute__pure__"; } if( $flags =~ /f/ ) { - my $prefix = $has_context ? 'pTHX_' : ''; - my $args = scalar @args; - push @attrs, sprintf "__attribute__format__(__printf__,%s%d,%s%d)", - $prefix, $args - 1, $prefix, $args; + my $prefix = $has_context ? 'pTHX_' : ''; + my $args = scalar @args; + my $pat = $args - 1; + my $macro = @nonnull && $nonnull[-1] == $pat + ? '__attribute__format__' + : '__attribute__format__null_ok__'; + push @attrs, sprintf "%s(__printf__,%s%d,%s%d)", $macro, + $prefix, $pat, $prefix, $args; } if ( @nonnull ) { my @pos = map { $has_context ? "pTHX_$_" : $_ } @nonnull; diff --git a/perl.h b/perl.h index 51f26e4..5fa0da3 100644 --- a/perl.h +++ b/perl.h @@ -3101,6 +3101,13 @@ typedef pthread_key_t perl_key; # define NORETURN_FUNCTION_END /* NOTREACHED */ return 0 #endif +/* Some OS warn on NULL format to printf */ +#ifdef PRINTF_FORMAT_NULL_OK +# define __attribute__format__null_ok__(x,y,z) __attribute__format__(x,y,z) +#else +# define __attribute__format__null_ok__(x,y,z) +#endif + #ifdef HAS_BUILTIN_EXPECT # define EXPECT(expr,val) __builtin_expect(expr,val) #else diff --git a/proto.h b/proto.h index 11a5fc4..d3a623f 100644 --- a/proto.h +++ b/proto.h @@ -226,7 +226,8 @@ PERL_CALLCONV OP* Perl_convert(pTHX_ I32 optype, I32 flags, OP* o) PERL_CALLCONV PERL_CONTEXT* Perl_create_eval_scope(pTHX_ U32 flags); PERL_CALLCONV void Perl_croak(pTHX_ const char* pat, ...) - __attribute__noreturn__; + __attribute__noreturn__ + __attribute__format__null_ok__(__printf__,pTHX_1,pTHX_2); PERL_CALLCONV void Perl_vcroak(pTHX_ const char* pat, va_list* args) __attribute__noreturn__ @@ -383,7 +384,9 @@ PERL_CALLCONV void Perl_deprecate(pTHX_ const char* s) PERL_CALLCONV void Perl_deprecate_old(pTHX_ const char* s) __attribute__nonnull__(pTHX_1); -PERL_CALLCONV OP* Perl_die(pTHX_ const char* pat, ...); +PERL_CALLCONV OP* Perl_die(pTHX_ const char* pat, ...) + __attribute__format__null_ok__(__printf__,pTHX_1,pTHX_2); + PERL_CALLCONV OP* Perl_vdie(pTHX_ const char* pat, va_list* args); PERL_CALLCONV OP* Perl_die_where(pTHX_ const char* message, STRLEN msglen); PERL_CALLCONV void Perl_dounwind(pTHX_ I32 cxix);