From dfaee99f9ded5698a13e1564927003be59ab96db Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Sat, 3 Aug 2019 16:47:40 -0600 Subject: [PATCH] Add script to regenerate ppport.fnc Now, instead of this being static, it will be regenerated. This allows us to create tests for macros that otherwise wouldn't be. (cherry picked from commit b730918253cf5ea4167f6c3ee7096dd2e4068506) Signed-off-by: Nicolas R --- dist/Devel-PPPort/devel/mkppport_fnc.pl | 165 +++++++++++++++++++++ dist/Devel-PPPort/devel/regenerate | 2 +- dist/Devel-PPPort/parts/apicheck.pl | 4 +- dist/Devel-PPPort/parts/ppport.fnc | 248 +++++++++++++++++++++++++++++++- 4 files changed, 413 insertions(+), 6 deletions(-) create mode 100644 dist/Devel-PPPort/devel/mkppport_fnc.pl diff --git a/dist/Devel-PPPort/devel/mkppport_fnc.pl b/dist/Devel-PPPort/devel/mkppport_fnc.pl new file mode 100644 index 0000000..d8b9b00 --- /dev/null +++ b/dist/Devel-PPPort/devel/mkppport_fnc.pl @@ -0,0 +1,165 @@ +use Data::Dumper; +$Data::Dumper::Sortkeys=1; +################################################################################ +# +# mkppport_fnc.pl -- generate ppport.fnc +# +# This program should be run when regenerating the data for ppport.h +# (devel/regenerate). It should be run after parts/embed.fnc is updated, and +# after mkapidoc.sh has been run. +# +# Its purpose is to generate ppport.fnc, a file which has the same syntax as +# embed.fnc and apidoc.fnc, but contains entries that should only be tested +# when ppport.h is enabled during the test. +# +# Thus it includes items that are Devel::PPPort only, and items that it +# figures out aren't tested by the other two functions. +# +# These otherwise-untested items are those: +# 1) which D:P provides and are not found in embed.fnc nor apidoc.fnc, or +# aren't listed as public API in those files +# 2) and for which tests can be automatically generated that they at least +# compile. +# +# The reason that an item isn't in those two files is that it is an +# undocumented macro. (If it's not a macro, it has to be in embed.fnc, and if +# it's documented, mkapidoc.sh would find it and place it in apidoc.fnc.) +# +# And, the reason we can't generate tests for undocumented macros is we don't +# readily know the types of the parameters, which we need to get a C program +# to compile. We could easily discover the number of parameters, but gleaning +# their types is harder. +# +# Instead of expending effort to cope with undocumented items, document them +# instead, improving the product doubly. +# +# However, if the macro has no parameters, there are no types to need to know. +# And, it turns out, that it may be that many of these macros (which typically +# just define constants) really don't need to be documented. They may be +# something that is considered to be provided, but should actually have been +# internal constants, not exposed to the outside world. And they're a lot of +# them. So this function was written to handle them. +# +# Algorithms could be devised to read the =xsubs sections and associate code +# found therein with the item, and to include the code as the test for the +# item, but again, it would be better to just document them. +# +# Later it was discovered that ppport provides support for non-public items. +# We can list those here too, so that tests can be generated. (An alternative +# would be to invent a new flag that means non-public, but test and use that +# in apidoc.fnc.) +################################################################################ +# +# This program is free software; you can redistribute it and/or +# modify it under the same terms as Perl itself. +# +################################################################################ + +use strict; + use Data::Dumper; + $Data::Dumper::Sortkeys=1; +use warnings; + +my $main_dir = $0; + +# Up one level +$main_dir =~ s;[^/]*$;;; +$main_dir =~ s;/$;;; + +# Up a second level +$main_dir =~ s;[^/]*$;;; +$main_dir =~ s;/$;;; + +$main_dir = '.' unless $main_dir; +require "$main_dir/parts/ppptools.pl"; + + +my @provided = map { /^(\w+)/ ? $1 : () } `$^X ppport.h --list-provided`; + +# First, we look for non-API macros that are documented and furnished by us in +# spite of not being public +my @non_public_provided; +my $api_fnc = "$main_dir/parts/apidoc.fnc"; +open F, "<", $api_fnc or die "Can't open $api_fnc: $!"; +while () { + my $line = $_; + next if $line =~ / ^ [^|]* A /x; # Skip API + chomp $line; + push @non_public_provided, $line + # Look for the name in the third '|' separated field + if grep { $line =~ / ^ [^|]* \| [^|]* \| \s* $_ \s* (?: $ |\| ) /x } + @provided; +} + +my @embeds = parse_embed('parts/embed.fnc', $api_fnc); + +# Look for %include lines in the ppport.h generator +my $PPPort = "$main_dir/PPPort_pm.PL"; +open F, "<", $PPPort or die "Can't open $PPPort: $!"; + +my @no_parameters; +while () { + next unless/^%include (\w+)/; + my $implementation = parse_partspec("$main_dir/parts/inc/$1")->{'implementation'}; + + # Find no-parameter entries using __UNDEFINED__ that aren't in the other. + # We know these are provided. + while ($implementation =~ /^__UNDEFINED__\s+(\w+)\s/mg) { + push @no_parameters, $1 unless grep { $1 eq $_->{'name'} } @embeds; + } +} + +# Repeat, but look for ones that are 'provided' that don't use __UNDEFINED__ +seek F, 0, 0; +while () { + next unless/^%include (\w+)/; + my $implementation = parse_partspec("$main_dir/parts/inc/$1")->{'implementation'}; + + while ($implementation =~ /^#\s*define\s+(\w+)\s/mg) { + next if grep { $1 eq $_ } @no_parameters; + next if grep { $1 eq $_->{'name'} } @embeds; + next unless grep { $1 eq $_ } @provided; + push @no_parameters, $1; + } +} + +my @out = 'Am|void|sv_magic_portable|NN SV* sv|NULLOK SV* obj|int how|NULLOK const char* name|I32 namlen'; +push @out, @non_public_provided; +push @out, map { "Amn|void|$_" } @no_parameters; + +@out = sort sort_api_lines @out; + +my $out = "parts/ppport.fnc"; +open OUT, ">", $out or die "Could open '$out' for writing: $!"; + +print OUT < that +: ships with the Perl source code. +: +: Since these are used only to provide the argument types, it's ok to have the +: return value be void for some where it's an issues + +EOF + +print OUT join "\n", @out; +print OUT "\n"; + +close OUT; diff --git a/dist/Devel-PPPort/devel/regenerate b/dist/Devel-PPPort/devel/regenerate index 22f0828..5348277 100755 --- a/dist/Devel-PPPort/devel/regenerate +++ b/dist/Devel-PPPort/devel/regenerate @@ -38,7 +38,7 @@ unless (-e 'parts/embed.fnc' and -e 'parts/apidoc.fnc') { quit_now(); } -ask_or_quit("Are you sure you have updated parts/embed.fnc and parts/apidoc.fnc?"); +ask_or_quit("Are you SURE you have:\n1) updated parts/embed.fnc to latest blead?\n2) run devel/mkapidoc.sh to update parts/apidoc.fnc?\n3) run devel/mkppport_fnc.pl to update parts/ppport.fnc?\n"); my %files = map { ($_ => [glob "parts/$_/5*"]) } qw( base todo ); diff --git a/dist/Devel-PPPort/parts/apicheck.pl b/dist/Devel-PPPort/parts/apicheck.pl index 6804fd6..9818c27 100644 --- a/dist/Devel-PPPort/parts/apicheck.pl +++ b/dist/Devel-PPPort/parts/apicheck.pl @@ -235,7 +235,9 @@ for $f (@f) { # Loop through all the tests to add my $unique = "$f->{'name'}$sep$f->{'cond'}"; $ignore{$unique} and next; - $f->{'flags'}{'A'} or next; # only public API members + # only public API members, except those in ppport.fnc are there because we + # want them to be tested even if non-public. + $f->{'flags'}{'A'} or $f->{'ppport_fnc'} or next; $ignore{$unique} = 1; # ignore duplicates diff --git a/dist/Devel-PPPort/parts/ppport.fnc b/dist/Devel-PPPort/parts/ppport.fnc index efa648f..667e09f 100644 --- a/dist/Devel-PPPort/parts/ppport.fnc +++ b/dist/Devel-PPPort/parts/ppport.fnc @@ -1,5 +1,7 @@ :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: : +: !!!! Do NOT edit this file directly! -- Edit devel/mkppport_fnc.pl instead. !!!! +: : Perl/Pollution/Portability : :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: @@ -12,12 +14,250 @@ : modify it under the same terms as Perl itself. : :::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: - : : This file lists all API functions/macros that are provided purely -: by Devel::PPPort. It is in the same format as the F that +: by Devel::PPPort, or that are unXXX It is in the same format as the F that : ships with the Perl source code. : +: Since these are used only to provide the argument types, it's ok to have the +: return value be void for some where it's an issues -Am |void |sv_magic_portable|NN SV* sv|NULLOK SV* obj|int how|NULLOK const char* name \ - |I32 namlen +Amn|void|_aMY_CXT +Amn|void|aMY_CXT +Amn|void|aMY_CXT_ +Amn|void|aTHX +Amn|void|aTHX_ +Amn|void|aTHXR +Amn|void|aTHXR_ +Amn|void|AvFILLp +Amn|void|DEFSV +Amn|void|dMY_CXT +Amn|void|dMY_CXT_SV +Amn|void|dNOOP +Amn|void|dTHR +Amn|void|dTHX +Amn|void|dTHXR +Amn|void|dVAR +Amn|void|dXSTARG +Amn|void|END_EXTERN_C +Amn|void|EXTERN_C +Amn|void|G_METHOD +Amn|void|GV_NOADD_MASK +Amn|void|IN_PERL_COMPILETIME +Amn|void|IS_NUMBER_GREATER_THAN_UV_MAX +Amn|void|IS_NUMBER_INFINITY +Amn|void|IS_NUMBER_IN_UV +Amn|void|IS_NUMBER_NAN +Amn|void|IS_NUMBER_NEG +Amn|void|IS_NUMBER_NOT_INT +Amn|void|IVdf +Amn|void|IVSIZE +Amn|void|MY_CXT +Amn|void|MY_CXT_CLONE +Amn|void|MY_CXT_INIT +Amn|void|NOOP +Amn|void|NVef +Amn|void|NVff +Amn|void|NVgf +Amn|void|NVTYPE +Amn|void|PERL_BCDVERSION +Amn|void|PERL_INT_MAX +Amn|void|PERL_INT_MIN +Amn|void|PERL_LOADMOD_DENY +Amn|void|PERL_LOADMOD_IMPORT_OPS +Amn|void|PERL_LOADMOD_NOIMPORT +Amn|void|PERL_LONG_MAX +Amn|void|PERL_LONG_MIN +Amn|void|PERL_MAGIC_arylen +Amn|void|PERL_MAGIC_backref +Amn|void|PERL_MAGIC_bm +Amn|void|PERL_MAGIC_collxfrm +Amn|void|PERL_MAGIC_dbfile +Amn|void|PERL_MAGIC_dbline +Amn|void|PERL_MAGIC_defelem +Amn|void|PERL_MAGIC_env +Amn|void|PERL_MAGIC_envelem +Amn|void|PERL_MAGIC_ext +Amn|void|PERL_MAGIC_fm +Amn|void|PERL_MAGIC_glob +Amn|void|PERL_MAGIC_isa +Amn|void|PERL_MAGIC_isaelem +Amn|void|PERL_MAGIC_mutex +Amn|void|PERL_MAGIC_nkeys +Amn|void|PERL_MAGIC_overload +Amn|void|PERL_MAGIC_overload_elem +Amn|void|PERL_MAGIC_overload_table +Amn|void|PERL_MAGIC_pos +Amn|void|PERL_MAGIC_qr +Amn|void|PERL_MAGIC_regdata +Amn|void|PERL_MAGIC_regdatum +Amn|void|PERL_MAGIC_regex_global +Amn|void|PERL_MAGIC_shared +Amn|void|PERL_MAGIC_shared_scalar +Amn|void|PERL_MAGIC_sig +Amn|void|PERL_MAGIC_sigelem +Amn|void|PERL_MAGIC_substr +Amn|void|PERL_MAGIC_sv +Amn|void|PERL_MAGIC_taint +Amn|void|PERL_MAGIC_tied +Amn|void|PERL_MAGIC_tiedelem +Amn|void|PERL_MAGIC_tiedscalar +Amn|void|PERL_MAGIC_utf8 +Amn|void|PERL_MAGIC_uvar +Amn|void|PERL_MAGIC_uvar_elem +Amn|void|PERL_MAGIC_vec +Amn|void|PERL_MAGIC_vstring +Amn|void|PERL_PV_ESCAPE_ALL +Amn|void|PERL_PV_ESCAPE_FIRSTCHAR +Amn|void|PERL_PV_ESCAPE_NOBACKSLASH +Amn|void|PERL_PV_ESCAPE_NOCLEAR +Amn|void|PERL_PV_ESCAPE_QUOTE +Amn|void|PERL_PV_ESCAPE_RE +Amn|void|PERL_PV_ESCAPE_UNI +Amn|void|PERL_PV_ESCAPE_UNI_DETECT +Amn|void|PERL_PV_PRETTY_DUMP +Amn|void|PERL_PV_PRETTY_ELLIPSES +Amn|void|PERL_PV_PRETTY_LTGT +Amn|void|PERL_PV_PRETTY_NOCLEAR +Amn|void|PERL_PV_PRETTY_QUOTE +Amn|void|PERL_PV_PRETTY_REGPROP +Amn|void|PERL_QUAD_MAX +Amn|void|PERL_QUAD_MIN +Amn|void|PERL_REVISION +Amn|void|PERL_SCAN_ALLOW_UNDERSCORES +Amn|void|PERL_SCAN_DISALLOW_PREFIX +Amn|void|PERL_SCAN_GREATER_THAN_UV_MAX +Amn|void|PERL_SCAN_SILENT_ILLDIGIT +Amn|void|PERL_SHORT_MAX +Amn|void|PERL_SHORT_MIN +Amn|void|PERL_SIGNALS_UNSAFE_FLAG +Amn|void|PERL_SUBVERSION +Amn|void|PERL_UCHAR_MAX +Amn|void|PERL_UCHAR_MIN +Amn|void|PERL_UINT_MAX +Amn|void|PERL_UINT_MIN +Amn|void|PERL_ULONG_MAX +Amn|void|PERL_ULONG_MIN +Amn|void|PERL_UNUSED_CONTEXT +Amn|void|PERL_UNUSED_DECL +Amn|void|PERL_UQUAD_MAX +Amn|void|PERL_UQUAD_MIN +Amn|void|PERL_USE_GCC_BRACE_GROUPS +Amn|void|PERL_USHORT_MAX +Amn|void|PERL_USHORT_MIN +Amn|void|PERL_VERSION +Amn|void|PL_bufend +Amn|void|PL_bufptr +Amn|void|PL_compiling +Amn|void|PL_copline +Amn|void|PL_DBsignal +dmn|SV *|PL_DBsingle +dmn|GV *|PL_DBsub +dmn|SV *|PL_DBtrace +Amn|void|PL_debstash +Amn|void|PL_diehook +Amn|void|PL_dirty +dmn|U8|PL_dowarn +Amn|void|PL_errgv +Amn|void|PL_error_count +Amn|void|PL_expect +Amn|void|PL_hexdigit +Amn|void|PL_hints +Amn|void|PL_in_my +Amn|void|PL_in_my_stash +Amn|void|PL_laststatval +Amn|void|PL_lex_state +Amn|void|PL_lex_stuff +Amn|void|PL_linestr +Amn|void|PL_mess_sv +Amn|void|PL_no_modify +Amn|void|PL_perldb +Amn|void|PL_ppaddr +Amn|void|PL_rsfp +Amn|void|PL_rsfp_filters +Amn|void|PL_stack_base +Amn|void|PL_stack_sp +Amn|void|PL_statcache +Amn|void|PL_stdingv +Amn|void|PL_Sv +Amn|void|PL_sv_arenaroot +Amn|void|PL_tainted +Amn|void|PL_tainting +Amn|void|PL_tokenbuf +Amn|void|_pMY_CXT +Amn|void|pMY_CXT +Amn|void|pMY_CXT_ +Amn|void|pTHX +Amn|void|pTHX_ +Amn|void|PTRV +Amn|void|SAVE_DEFSV +Amn|void|START_EXTERN_C +Amn|void|START_MY_CXT +Amn|void|SV_CONST_RETURN +Amn|void|SV_COW_DROP_PV +Amn|void|SV_COW_SHARED_HASH_KEYS +Amn|void|SVf +Amn|void|SVf_UTF8 +Amn|void|SV_GMAGIC +Amn|void|SV_HAS_TRAILING_NUL +Amn|void|SV_IMMEDIATE_UNREF +Am|void|sv_magic_portable|NN SV* sv|NULLOK SV* obj|int how|NULLOK const char* name|I32 namlen +Amn|void|SV_MUTABLE_RETURN +Amn|void|SV_NOSTEAL +Amn|void|SV_SMAGIC +Amn|void|SV_UTF8_NO_ENCODING +Amn|void|UTF8_MAXBYTES +Amn|void|UVof +Amn|void|UVSIZE +Amn|void|UVTYPE +Amn|void|UVuf +Amn|void|UVXf +Amn|void|UVxf +Amn|void|WARN_ALL +Amn|void|WARN_AMBIGUOUS +Amn|void|WARN_ASSERTIONS +Amn|void|WARN_BAREWORD +Amn|void|WARN_CLOSED +Amn|void|WARN_CLOSURE +Amn|void|WARN_DEBUGGING +Amn|void|WARN_DEPRECATED +Amn|void|WARN_DIGIT +Amn|void|WARN_EXEC +Amn|void|WARN_EXITING +Amn|void|WARN_GLOB +Amn|void|WARN_INPLACE +Amn|void|WARN_INTERNAL +Amn|void|WARN_IO +Amn|void|WARN_LAYER +Amn|void|WARN_MALLOC +Amn|void|WARN_MISC +Amn|void|WARN_NEWLINE +Amn|void|WARN_NUMERIC +Amn|void|WARN_ONCE +Amn|void|WARN_OVERFLOW +Amn|void|WARN_PACK +Amn|void|WARN_PARENTHESIS +Amn|void|WARN_PIPE +Amn|void|WARN_PORTABLE +Amn|void|WARN_PRECEDENCE +Amn|void|WARN_PRINTF +Amn|void|WARN_PROTOTYPE +Amn|void|WARN_QW +Amn|void|WARN_RECURSION +Amn|void|WARN_REDEFINE +Amn|void|WARN_REGEXP +Amn|void|WARN_RESERVED +Amn|void|WARN_SEMICOLON +Amn|void|WARN_SEVERE +Amn|void|WARN_SIGNAL +Amn|void|WARN_SUBSTR +Amn|void|WARN_SYNTAX +Amn|void|WARN_TAINT +Amn|void|WARN_THREADS +Amn|void|WARN_UNINITIALIZED +Amn|void|WARN_UNOPENED +Amn|void|WARN_UNPACK +Amn|void|WARN_UNTIE +Amn|void|WARN_UTF8 +Amn|void|WARN_VOID +Amn|void|XSprePUSH -- 1.8.3.1