This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Add script to regenerate ppport.fnc
authorKarl Williamson <khw@cpan.org>
Sat, 3 Aug 2019 22:47:40 +0000 (16:47 -0600)
committerNicolas R <atoomic@cpan.org>
Fri, 27 Sep 2019 22:51:27 +0000 (16:51 -0600)
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 <atoomic@cpan.org>
dist/Devel-PPPort/devel/mkppport_fnc.pl [new file with mode: 0644]
dist/Devel-PPPort/devel/regenerate
dist/Devel-PPPort/parts/apicheck.pl
dist/Devel-PPPort/parts/ppport.fnc

diff --git a/dist/Devel-PPPort/devel/mkppport_fnc.pl b/dist/Devel-PPPort/devel/mkppport_fnc.pl
new file mode 100644 (file)
index 0000000..d8b9b00
--- /dev/null
@@ -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 (<F>) {
+    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 (<F>) {
+    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 (<F>) {
+    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 <<EOF;
+::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
+:
+:  !!!! Do NOT edit this file directly! -- Edit devel/mkppport_fnc.pl instead. !!!!
+:
+:  Perl/Pollution/Portability
+:
+::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
+:
+:  Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz.
+:  Version 2.x, Copyright (C) 2001, Paul Marquess.
+:  Version 1.x, Copyright (C) 1999, Kenneth Albanowski.
+:
+:  This program is free software; you can redistribute it and/or
+:  modify it under the same terms as Perl itself.
+:
+::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
+:
+: This file lists all API functions/macros that are provided purely
+: by Devel::PPPort, or that are unXXX It is in the same format as the F<embed.fnc> 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;
index 22f0828..5348277 100755 (executable)
@@ -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 );
 
index 6804fd6..9818c27 100644 (file)
@@ -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
 
index efa648f..667e09f 100644 (file)
@@ -1,5 +1,7 @@
 ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
 :
+:  !!!! Do NOT edit this file directly! -- Edit devel/mkppport_fnc.pl instead. !!!!
+:
 :  Perl/Pollution/Portability
 :
 ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
 :  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<embed.fnc> that
+: by Devel::PPPort, or that are unXXX It is in the same format as the F<embed.fnc> 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