In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/23aa77bc9fa488ace3ef1089104e999c23821171?hp=46205598fd4365259edae4d52902d161f025d0c2>
- Log ----------------------------------------------------------------- commit 23aa77bc9fa488ace3ef1089104e999c23821171 Author: Karl Williamson <[email protected]> Date: Sat Feb 2 10:18:45 2013 -0700 Change pods to not refer to av_len() This name for the function is misleading; don't encourage its use. M dist/ExtUtils-ParseXS/lib/perlxstut.pod M pod/perlembed.pod M pp_sort.c commit 127191935588596728c62621b37dcfbab94edc5c Author: Karl Williamson <[email protected]> Date: Fri Feb 8 14:27:57 2013 -0700 Add av_tindex() synonym for av_top_index() The latter is a somewhat less clumsy name. The old one is provided a a very clear name; the new one as a somewhat slangy version M av.c M av.h M embed.fnc M pod/perldelta.pod M proto.h M regcomp.c commit be3a7a5d0cbc1f6097d4470182c7b7e1d05d94c0 Author: Karl Williamson <[email protected]> Date: Thu Feb 7 12:06:43 2013 -0700 Inline av_top_index() This function is just an assert and a macro call. Avoid the function call overhead by making it inline. M av.c M embed.fnc M embed.h M inline.h M proto.h commit dab460cdc878907f9f3f36b96709f818ac937409 Author: Karl Williamson <[email protected]> Date: Thu Feb 7 11:43:02 2013 -0700 Change name 'av_top' to 'av_top_index' In using the av_top() function created in a recent commit, I found myself being confused, and thinking it meant the top element of the array, whereas it really means the index of the top element of that array. Since the new name has not appeared in a stable release, it can be changed, without remorse, to include 'index' in it. M av.c M av.h M embed.fnc M embed.h M pod/perlguts.pod M proto.h M regcomp.c commit 2dbb0a307f0954c1222fc47c920f695d0b1db80d Author: Karl Williamson <[email protected]> Date: Fri Feb 8 14:00:09 2013 -0700 makedef.pl: Don't export inline fcns An inline function is static to the file it is defined in. But they can be part of the public API if they are in #included header files and defined in embed.fnc. Normally such functions are written to the export list on platforms that have this, but since they are static, you get a linkage error. This commit suppresses the writing of inline functions M makedef.pl commit 03b6588a53580864a6eb17030d4a277a0231ab41 Author: Karl Williamson <[email protected]> Date: Thu Feb 7 10:45:14 2013 -0700 regen/embed.pl: Extract out duplicate code into a fcn M regen/embed.pl commit 82728c33fe83d22b939bf6a82f2f0bbdc9b52a07 Author: Karl Williamson <[email protected]> Date: Thu Feb 7 10:31:22 2013 -0700 regen/embed.pl: Warn if have > 1 i, p, and s flags These should be mutually exclusive M regen/embed.pl commit e42bd20440a10c098e7fba28bcad166baad5f2eb Author: Karl Williamson <[email protected]> Date: Thu Feb 7 10:26:54 2013 -0700 embed.fnc: Remove inappropriate 'p' flags These functions do not begin with 'Perl_'; currently this flag is ignored here. M embed.fnc ----------------------------------------------------------------------- Summary of changes: av.c | 25 ++++-------------- av.h | 6 +++- dist/ExtUtils-ParseXS/lib/perlxstut.pod | 6 ++-- embed.fnc | 7 +++-- embed.h | 2 +- inline.h | 11 ++++++++ makedef.pl | 2 +- pod/perldelta.pod | 6 ++++ pod/perlembed.pod | 2 +- pod/perlguts.pod | 4 +- pp_sort.c | 2 +- proto.h | 8 ++++- regcomp.c | 8 +++--- regen/embed.pl | 42 ++++++++++++++---------------- 14 files changed, 71 insertions(+), 60 deletions(-) diff --git a/av.c b/av.c index 9f08212..3041cd2 100644 --- a/av.c +++ b/av.c @@ -759,16 +759,18 @@ Perl_av_shift(pTHX_ AV *av) } /* -=for apidoc av_top +=for apidoc av_top_index Returns the highest index in the array. The number of elements in the -array is C<av_top(av) + 1>. Returns -1 if the array is empty. +array is C<av_top_index(av) + 1>. Returns -1 if the array is empty. The Perl equivalent for this is C<$#myarray>. +(A slightly shorter form is C<av_tindex>.) + =for apidoc av_len -Same as L</av_top>. Returns the highest index in the array. Note that the +Same as L</av_top_index>. Returns the highest index in the array. Note that the return value is +1 what its name implies it returns; and hence differs in meaning from what the similarly named L</sv_len> returns. @@ -778,24 +780,9 @@ meaning from what the similarly named L</sv_len> returns. I32 Perl_av_len(pTHX_ AV *av) { - /* If change this, must change identical Perl_av_top() just below */ - PERL_ARGS_ASSERT_AV_LEN; - assert(SvTYPE(av) == SVt_PVAV); - - return AvFILL(av); -} - -I32 -Perl_av_top(pTHX_ AV *av) -{ - /* So short, that it is just a duplicate of Perl_av_len(). Must keep them - * in sync */ - - PERL_ARGS_ASSERT_AV_TOP; - assert(SvTYPE(av) == SVt_PVAV); - return AvFILL(av); + return av_top_index(av); } /* diff --git a/av.h b/av.h index 500fe5a..391ae36 100644 --- a/av.h +++ b/av.h @@ -47,7 +47,10 @@ Null AV pointer. =head1 Array Manipulation Functions =for apidoc Am|int|AvFILL|AV* av -Same as C<av_top()>. Deprecated, use C<av_top()> instead. +Same as C<av_top_index()>. Deprecated, use C<av_top_index()> instead. + +=for apidoc Am|int|av_tindex|AV* av +Same as C<av_top_index()>. =cut */ @@ -75,6 +78,7 @@ Same as C<av_top()>. Deprecated, use C<av_top()> instead. #define AvFILL(av) ((SvRMAGICAL((const SV *) (av))) \ ? mg_size(MUTABLE_SV(av)) : AvFILLp(av)) +#define av_tindex(av) av_top_index(av) #define NEGATIVE_INDICES_VAR "NEGATIVE_INDICES" diff --git a/dist/ExtUtils-ParseXS/lib/perlxstut.pod b/dist/ExtUtils-ParseXS/lib/perlxstut.pod index 0afa408..d36f425 100644 --- a/dist/ExtUtils-ParseXS/lib/perlxstut.pod +++ b/dist/ExtUtils-ParseXS/lib/perlxstut.pod @@ -1095,7 +1095,7 @@ Mytest.xs: SvGETMAGIC(paths); if ((!SvROK(paths)) || (SvTYPE(SvRV(paths)) != SVt_PVAV) - || ((numpaths = av_len((AV *)SvRV(paths))) < 0)) + || ((numpaths = av_top_index((AV *)SvRV(paths))) < 0)) { XSRETURN_UNDEF; } @@ -1158,7 +1158,7 @@ true, which indicates that paths is a valid reference. (Simply checking C<SvROK> won't trigger FETCH on a tied variable.) It then verifies that the object referenced by paths is an array, using C<SvRV> to dereference paths, and C<SvTYPE> to discover its type. As an added test, -it checks that the array referenced by paths is non-empty, using the C<av_len> +it checks that the array referenced by paths is non-empty, using the C<av_top_index> function (which returns -1 if the array is empty). The XSRETURN_UNDEF macro is used to abort the XSUB and return the undefined value whenever all three of these conditions are not met. @@ -1167,7 +1167,7 @@ these conditions are not met. We manipulate several arrays in this XSUB. Note that an array is represented internally by an AV* pointer. The functions and macros for manipulating -arrays are similar to the functions in Perl: C<av_len> returns the highest +arrays are similar to the functions in Perl: C<av_top_index> returns the highest index in an AV*, much like $#array; C<av_fetch> fetches a single scalar value from an array, given its index; C<av_push> pushes a scalar value onto the end of the array, automatically extending the array as necessary. diff --git a/embed.fnc b/embed.fnc index 31ce911..a288c5a 100644 --- a/embed.fnc +++ b/embed.fnc @@ -219,7 +219,8 @@ Apd |void |av_push |NN AV *av|NN SV *val EXp |void |av_reify |NN AV *av ApdR |SV* |av_shift |NN AV *av Apd |SV** |av_store |NN AV *av|I32 key|NULLOK SV *val -ApdR |I32 |av_top |NN AV *av +AidR |I32 |av_top_index |NN AV *av +AmpdR |I32 |av_tindex |NN AV *av Apd |void |av_undef |NN AV *av ApdoxM |SV** |av_create_and_unshift_one|NN AV **const avp|NN SV *const val Apd |void |av_unshift |NN AV *av|I32 num @@ -625,8 +626,8 @@ ADMpPR |bool |is_uni_punct |UV c ADMpPR |bool |is_uni_xdigit |UV c AMp |UV |to_uni_upper |UV c|NN U8 *p|NN STRLEN *lenp AMp |UV |to_uni_title |UV c|NN U8 *p|NN STRLEN *lenp -iDMpPR |bool |isIDFIRST_lazy |NN const char* p -iDMpPR |bool |isALNUM_lazy |NN const char* p +iDMPR |bool |isIDFIRST_lazy |NN const char* p +iDMPR |bool |isALNUM_lazy |NN const char* p #ifdef PERL_IN_UTF8_C sR |U8 |to_lower_latin1|const U8 c|NULLOK U8 *p|NULLOK STRLEN *lenp #endif diff --git a/embed.h b/embed.h index 0460505..c66eba9 100644 --- a/embed.h +++ b/embed.h @@ -56,7 +56,7 @@ #define av_push(a,b) Perl_av_push(aTHX_ a,b) #define av_shift(a) Perl_av_shift(aTHX_ a) #define av_store(a,b,c) Perl_av_store(aTHX_ a,b,c) -#define av_top(a) Perl_av_top(aTHX_ a) +#define av_top_index(a) S_av_top_index(aTHX_ a) #define av_undef(a) Perl_av_undef(aTHX_ a) #define av_unshift(a,b) Perl_av_unshift(aTHX_ a,b) #define block_gimme() Perl_block_gimme(aTHX) diff --git a/inline.h b/inline.h index 85bdc74..6b5f93c 100644 --- a/inline.h +++ b/inline.h @@ -12,6 +12,17 @@ * Each section names the header file that the functions "belong" to. */ +/* ------------------------------- av.h ------------------------------- */ + +PERL_STATIC_INLINE I32 +S_av_top_index(pTHX_ AV *av) +{ + PERL_ARGS_ASSERT_AV_TOP_INDEX; + assert(SvTYPE(av) == SVt_PVAV); + + return AvFILL(av); +} + /* ------------------------------- cv.h ------------------------------- */ PERL_STATIC_INLINE I32 * diff --git a/makedef.pl b/makedef.pl index 4376842..6c1b8f3 100644 --- a/makedef.pl +++ b/makedef.pl @@ -743,7 +743,7 @@ if ($define{'USE_PERLIO'}) { foreach (@$embed) { my ($flags, $retval, $func, @args) = @$_; next unless $func; - if ($flags =~ /[AX]/ && $flags !~ /[xm]/ || $flags =~ /b/) { + if ($flags =~ /[AX]/ && $flags !~ /[xmi]/ || $flags =~ /b/) { # public API, so export # If a function is defined twice, for example before and after diff --git a/pod/perldelta.pod b/pod/perldelta.pod index b0aa3c2..9895b71 100644 --- a/pod/perldelta.pod +++ b/pod/perldelta.pod @@ -494,6 +494,12 @@ well. =item * +Synonyms for the misleadingly named C<av_len()> has been created: +C<av_top_index()> and C<av_tindex>. All three of these return the +number of the highest index in the array, not the number of elements it +contains. (The name C<av_top> which was introduced in Perl v.5.17.8 has +been removed.) + XXX =back diff --git a/pod/perlembed.pod b/pod/perlembed.pod index e40035e..1596df8 100644 --- a/pod/perlembed.pod +++ b/pod/perlembed.pod @@ -490,7 +490,7 @@ been wrapped here): SvREFCNT_dec(command); *match_list = get_av("array", 0); - num_matches = av_len(*match_list) + 1; + num_matches = av_top_index(*match_list) + 1; return num_matches; } diff --git a/pod/perlguts.pod b/pod/perlguts.pod index 4fb9ce1..339ecce 100644 --- a/pod/perlguts.pod +++ b/pod/perlguts.pod @@ -351,11 +351,11 @@ to these new elements. Here are some other functions: - I32 av_top(AV*); + I32 av_top_index(AV*); SV** av_fetch(AV*, I32 key, I32 lval); SV** av_store(AV*, I32 key, SV* val); -The C<av_top> function returns the highest index value in an array (just +The C<av_top_index> function returns the highest index value in an array (just like $#array in Perl). If the array is empty, -1 is returned. The C<av_fetch> function returns the value at index C<key>, but if C<lval> is non-zero, then C<av_fetch> will store an undef value at that index. diff --git a/pp_sort.c b/pp_sort.c index d6a5e88..bf7182b 100644 --- a/pp_sort.c +++ b/pp_sort.c @@ -1432,7 +1432,7 @@ S_qsortsv(pTHX_ gptr *list1, size_t nmemb, SVCOMPARE_t cmp, U32 flags) Sort an array. Here is an example: - sortsv(AvARRAY(av), av_len(av)+1, Perl_sv_cmp_locale); + sortsv(AvARRAY(av), av_top_index(av)+1, Perl_sv_cmp_locale); Currently this always uses mergesort. See sortsv_flags for a more flexible routine. diff --git a/proto.h b/proto.h index a2cf682..18f46cc 100644 --- a/proto.h +++ b/proto.h @@ -227,10 +227,14 @@ PERL_CALLCONV SV** Perl_av_store(pTHX_ AV *av, I32 key, SV *val) #define PERL_ARGS_ASSERT_AV_STORE \ assert(av) -PERL_CALLCONV I32 Perl_av_top(pTHX_ AV *av) +/* PERL_CALLCONV I32 Perl_av_tindex(pTHX_ AV *av) + __attribute__warn_unused_result__ + __attribute__nonnull__(pTHX_1); */ + +PERL_STATIC_INLINE I32 S_av_top_index(pTHX_ AV *av) __attribute__warn_unused_result__ __attribute__nonnull__(pTHX_1); -#define PERL_ARGS_ASSERT_AV_TOP \ +#define PERL_ARGS_ASSERT_AV_TOP_INDEX \ assert(av) PERL_CALLCONV void Perl_av_undef(pTHX_ AV *av) diff --git a/regcomp.c b/regcomp.c index a8b27dc..603770f 100644 --- a/regcomp.c +++ b/regcomp.c @@ -11560,7 +11560,7 @@ S_handle_regex_sets(pTHX_ RExC_state_t *pRExC_state, SV** return_invlist, I32 *f stack = newAV(); while (RExC_parse < RExC_end) { - I32 top_index = av_top(stack); + I32 top_index = av_tindex(stack); SV** top_ptr; SV* current = NULL; @@ -11577,7 +11577,7 @@ S_handle_regex_sets(pTHX_ RExC_state_t *pRExC_state, SV** return_invlist, I32 *f switch (curchar) { case '?': - if (av_top(stack) >= 0 /* This makes sure that we can + if (av_tindex(stack) >= 0 /* This makes sure that we can safely subtract 1 from RExC_parse in the next clause. If we have something on the @@ -11814,10 +11814,10 @@ S_handle_regex_sets(pTHX_ RExC_state_t *pRExC_state, SV** return_invlist, I32 *f RExC_parse += (UTF) ? UTF8SKIP(RExC_parse) : 1; } - if (av_top(stack) < 0 /* Was empty */ + if (av_tindex(stack) < 0 /* Was empty */ || ((final = av_pop(stack)) == NULL) || ! IS_OPERAND(final) - || av_top(stack) >= 0) /* More left on stack */ + || av_tindex(stack) >= 0) /* More left on stack */ { vFAIL("Incomplete expression within '(?[ ])'"); } diff --git a/regen/embed.pl b/regen/embed.pl index cbf421f..521217d 100755 --- a/regen/embed.pl +++ b/regen/embed.pl @@ -40,6 +40,15 @@ my $unflagged_pointers; # implicit interpreter context argument. # +sub full_name ($$) { # Returns the function name with potentially the + # prefixes 'S_' or 'Perl_' + my ($func, $flags) = @_; + + return "S_$func" if $flags =~ /[si]/; + return "Perl_$func" if $flags =~ /[bp]/; + return $func; +} + sub open_print_header { my ($file, $quote) = @_; @@ -79,6 +88,13 @@ my ($embed, $core, $ext, $api) = setup_embed(); if (! $can_ignore && $retval eq 'void') { warn "It is nonsensical to require the return value of a void function ($plain_func) to be checked"; } + + my $scope_type_flag_count = 0; + $scope_type_flag_count++ if $flags =~ /s/; + $scope_type_flag_count++ if $flags =~ /i/; + $scope_type_flag_count++ if $flags =~ /p/; + warn "$plain_func: i, p, and s flags are all mutually exclusive" + if $scope_type_flag_count > 1; my $splint_flags = ""; if ( $SPLINT && !$commented_out ) { $splint_flags .= '/*@noreturn@*/ ' if $never_returns; @@ -95,10 +111,7 @@ my ($embed, $core, $ext, $api) = setup_embed(); else { $type = $1 eq 's' ? "STATIC" : "PERL_STATIC_INLINE"; } - warn "$plain_func: i and s flags are mutually exclusive" - if $flags =~ /s/ && $flags =~ /i/; $retval = "$type $splint_flags$retval"; - $func = "S_$plain_func"; } else { if ($never_returns) { @@ -107,13 +120,8 @@ my ($embed, $core, $ext, $api) = setup_embed(); else { $retval = "PERL_CALLCONV $splint_flags$retval"; } - if ($flags =~ /[bp]/) { - $func = "Perl_$plain_func"; - } - else { - $func = $plain_func; - } } + $func = full_name($plain_func, $flags); $ret = "$retval\t$func("; if ( $has_context ) { $ret .= @args ? "pTHX_ " : "pTHX"; @@ -277,19 +285,14 @@ sub embed_h { unless ($flags =~ /[om]/) { my $args = scalar @args; if ($flags =~ /n/) { - if ($flags =~ /[si]/) { - $ret = hide($func,"S_$func"); - } - elsif ($flags =~ /p/) { - $ret = hide($func,"Perl_$func"); - } + $ret = hide($func, full_name($func, $flags)); } elsif ($args and $args[$args-1] =~ /\.\.\./) { if ($flags =~ /p/) { # we're out of luck for varargs functions under CPP # So we can only do these macros for no implicit context: $ret = "#ifndef PERL_IMPLICIT_CONTEXT\n" - . hide($func,"Perl_$func") . "#endif\n"; + . hide($func, full_name($func, $flags)) . "#endif\n"; } } else { @@ -297,12 +300,7 @@ sub embed_h { $ret = "#define $func($alist)"; my $t = int(length($ret) / 8); $ret .= "\t" x ($t < 4 ? 4 - $t : 1); - if ($flags =~ /[si]/) { - $ret .= "S_$func(aTHX"; - } - elsif ($flags =~ /p/) { - $ret .= "Perl_$func(aTHX"; - } + $ret .= full_name($func, $flags) . "(aTHX"; $ret .= "_ " if $alist; $ret .= $alist . ")\n"; } -- Perl5 Master Repository
