From bc24b511763dd2e6089c19a1adf7f9a65d1815d4 Mon Sep 17 00:00:00 2001 From: Karl Williamson Date: Tue, 2 Jul 2019 10:58:44 -0600 Subject: [PATCH] devel/mktodo.pl: Add some comments (cherry picked from commit 99f5969f6583102fb7bcf1f28e18b91324f208b7) Signed-off-by: Nicolas R --- dist/Devel-PPPort/devel/mktodo.pl | 162 ++++++++++++++++++++++++++++++++++---- 1 file changed, 146 insertions(+), 16 deletions(-) diff --git a/dist/Devel-PPPort/devel/mktodo.pl b/dist/Devel-PPPort/devel/mktodo.pl index e3cd3a3..15b69f1 100644 --- a/dist/Devel-PPPort/devel/mktodo.pl +++ b/dist/Devel-PPPort/devel/mktodo.pl @@ -3,6 +3,8 @@ # # mktodo.pl -- generate baseline and todo files # +# It makes the todo file for the single passed in perl binary. If --base is +# not specified it compiles with ppport.h. ################################################################################ # # Version 3.x, Copyright (C) 2004-2013, Marcus Holland-Moritz. @@ -26,8 +28,8 @@ require './devel/devtools.pl'; our %opt = ( blead => 0, # ? Is this perl blead - debug => 0, - base => 0, + debug => 0, # Adding --verbose increases the detail + base => 0, # Don't use ppport.h when generating verbose => 0, check => 1, todo => "", # If no --todo, this is a blead perl @@ -47,8 +49,10 @@ chomp $fullperl; $ENV{SKIP_SLOW_TESTS} = 1; +# Generate the Makefile using the passed in perl regen_Makefile(); +# List of functions that are never considered undefined. Add to as necessary my %stdsym = map { ($_ => 1) } qw ( strlen snprintf @@ -65,6 +69,8 @@ my %stdsym = map { ($_ => 1) } qw ( sprintf ); +# Initialize %sym so that the keys are all the Text symbols for this perl, +# output from the system's 'nm' my %sym; for (`$Config{nm} $fullperl`) { chomp; @@ -72,14 +78,41 @@ for (`$Config{nm} $fullperl`) { } keys %sym >= 50 or die "less than 50 symbols found in $fullperl\n"; +# %todo is initialized to be the symbols in the current todo file, like so: +# { +# 'UTF8_SAFE_SKIP' => 'U', +# 'newSVsv_flags' => 'U', +# 'newSVsv_nomg' => 'U', +# } +# +# The values are the outputs from nm, plus 'E' from us, for Error my %todo = %{load_todo($opt{todo}, $opt{version})} if $opt{todo}; + my @recheck; +# Get an exhaustive list from apicheck.i of symbols, what functions contain +# them, and how many in each function. +# symbol fcn count +# ------ --- ----- +# 'UV' => { +# 'SvUVX' => 1, +# 'toFOLD_uvchr' => 2, +# 'sv_uni_display' => 1, +# ... +# } my $symmap = get_apicheck_symbol_map(); +# In each iteration of the loop we create an apicheck.c. This will contain a +# generated wrapper function for each API function and macro. The wrapper +# contains one or more calls to its API element. Then we attempt to compile +# apicheck.c into apicheck.o. If it compiles, then every API element exists +# in this version of perl. If not, we figure out which ones were undefined, +# and set things up so that in the next iteration of the loop, the wrappers +# for those elements are #ifdef'd out. for (;;) { my $retry = 1; my $trynm = 1; + regen_apicheck(); retry: @@ -107,6 +140,9 @@ retry: } } + # Examine stderr. For each wrapper function listed in it, we create an + # 'E' (for error) entry. If the function (possibly prefixed by '[Pp]erl') + # is in %sym, it is added to @already_in_sym. Otherwise, @new. for my $l (@{$r->{stderr}}) { if ($l =~ /_DPPP_test_(\w+)/) { if (!$seen{$1}++) { @@ -125,18 +161,27 @@ retry: my @u; my @usym; + # Here, apicheck.o was successfully created. It likely will need + # functions from outside it in order to form a complete executable a.out. + # In the first iteration, look to see if all needed externs are available. + # (We don't actually try to create an a.out) if ($trynm) { @u = eval { find_undefined_symbols($fullperl, $opt{shlib}) }; warn "warning: $@" if $@; $trynm = 0; } + # If it didn't find any undefined symbols, everything should be working. + # Run the test suite. unless (@u) { $r = run(qw(make test)); $r->{didnotrun} and die "couldn't run make test: $!\n" . join('', @{$r->{stdout}})."\n---\n".join('', @{$r->{stderr}}); - $r->{status} == 0 and last; + $r->{status} == 0 and last; # It worked!! + + # Alas, something was wrong. Add any undefined symbols listed in the + # output to our list for my $l (@{$r->{stderr}}) { if ($l =~ /undefined symbol: (\w+)/) { push @u, $1; @@ -144,24 +189,37 @@ retry: } } + # For each undefined symbol for my $u (@u) { + + # If this is an API symbol, $symmap->{$u} will exist and be a hash of + # keys, being all the symbols referred to within it (with their values + # btw being the count of occurrences in the element). for my $m (keys %{$symmap->{$u}}) { if (!$seen{$m}++) { my $pl = $m; $pl =~ s/^[Pp]erl_//; my @s = grep { exists $sym{$_} } $pl, "Perl_$pl", "perl_$pl"; + + # The comment for this entry that goes into the file that gets + # written includes any [Pp]erl prefix. push @new, [$m, @s ? "U (@s)" : "U"]; } } } } + # Remove from @new all the current todo symbols @new = grep !$todo{$_->[0]}, @new; + # If none remain, start over with those we know about, minus the todo + # symbols. khw doesn't understand why this is necessary unless (@new) { @new = grep !$todo{$_->[0]}, @already_in_sym; } + # This retries once if nothing new was found (khw guesses that is just to + # be sure, or maybe it's because we ran nm the first time through) unless (@new) { if ($retry > 0) { $retry--; @@ -172,43 +230,79 @@ retry: die "no new TODO symbols found..."; } - # don't recheck undefined symbols reported by the dynamic linker + # recheck symbols except undefined ones reported by the dynamic linker push @recheck, map { $_->[0] } grep { $_->[1] !~ /^U/ } @new; + # Display each newly found undefined symbol, and add it to the list of todo + # symbols for (@new) { display_sym('new', @$_); $todo{$_->[0]} = $_->[1]; } + # Write the revised todo, so that apicheck.c when generated in the next + # iteration will have these #ifdef'd out write_todo($opt{todo}, $opt{version}, \%todo); -} +} # End of loop +# If we are to check our work, do so. This verifies that each symbol +# identified above is really a problem in this version. (khw doesn't know +# under what circumstances this becomes an issue) +# +# We go through each symbol on the @recheck list, and create an apicheck.c +# with it enabled. if ($opt{check}) { + + # Create something like '%3d' my $ifmt = '%' . length(scalar @recheck) . 'd'; + my $t0 = [gettimeofday]; RECHECK: for my $i (0 .. $#recheck) { my $sym = $recheck[$i]; + + # Assume it will work my $cur = delete $todo{$sym}; + # Give a progress report display_sym('chk', $sym, $cur, sprintf(" [$ifmt/$ifmt, ETA %s]", $i + 1, scalar @recheck, eta($t0, $i, scalar @recheck))); + # Write out the todo file without this symbol, meaning it will be enabled + # in the generated apicheck.c file write_todo($opt{todo}, $opt{version}, \%todo); + # E is not an nm symbol, but was added by us to indicate 'Error' if ($cur eq "E (Perl_$sym)") { - # we can try a shortcut here + + # We can try a shortcut here. Create an apicheck.c file for just this + # symbol. regen_apicheck($sym); my $r = run(qw(make test)); if (!$r->{didnotrun} && $r->{status} == 0) { + + # Shortcut indicated that this function compiles.. display_sym('del', $sym, $cur); next RECHECK; } + + # Here, the api file with just this entry failed to compile. (khw + # doesn't know why we just don't give up on it now, but we don't.) We + # drop down below to generate and compile a full apicheck.c with this + # symbol enabled. (XXX Perhaps we could look at stderr and if it + # contained things about parameter mismatch, (which is a common + # occurrence), we could skip the steps below.) } - # run the full test + # Either can't shortcut, or the shortcut indicated that the function + # doesn't compile in isolation. Create, compile and test with this + # function/symbol enabled. (Remember that this should have succeeded + # above to get to here when this symbol was disabled, so enabling just + # this one will tell us for sure that it works or doesn't work. (khw + # wonders if this is actually a DAG, or perhaps with cycles, so this is + # under it all, insufficient.) regen_Makefile(); my $r = run(qw(make test)); @@ -219,17 +313,19 @@ if ($opt{check}) { $r->{didnotrun} and die "couldn't run make test: $!\n" . join('', @{$r->{stdout}})."\n---\n".join('', @{$r->{stderr}}); - if ($r->{status} == 0) { + if ($r->{status} == 0) { # This symbol compiles and tests ok, so retain + # in this version display_sym('del', $sym, $cur); } - else { + else { # Revert to this symbol is bad in this version $todo{$sym} = $cur; } } -} +} # End of checking our work write_todo($opt{todo}, $opt{version}, \%todo); +# Clean up after ourselves run(qw(make realclean)); exit 0; @@ -251,11 +347,15 @@ sub display_sym sub regen_Makefile { + # We make sure to add rules for creating apicheck.c my @mf_arg = ('--with-apicheck', 'OPTIMIZE=-O0 -w'); + + # It doesn't include ppport.h if generating the base files. push @mf_arg, qw( DEFINE=-DDPPP_APICHECK_NO_PPPORT_H ) if $opt{base}; # just to be sure run(qw(make realclean)); + my $r = run($fullperl, "Makefile.PL", @mf_arg); unless ($r->{status} == 0) { die "cannot run Makefile.PL: $!\n" . @@ -263,7 +363,7 @@ sub regen_Makefile } } -sub regen_apicheck +sub regen_apicheck # Regeneration can also occur by calling 'make' { unlink qw(apicheck.c apicheck.o); runtool({ out => '/dev/null' }, $fullperl, 'apicheck_c.PL', map { "--api=$_" } @_) @@ -287,7 +387,8 @@ sub dump_apicheck print STDERR $n++, " ", $_ for @lines; } -sub load_todo +sub load_todo # Return entries from $file; skip if the first line + # isn't $expver (expected version) { my($file, $expver) = @_; @@ -314,7 +415,8 @@ nuke_file: return {}; } -sub write_todo +sub write_todo # Write out the todo file. The keys of %sym are known to not + # be in this version, hence are 'todo' { my($file, $ver, $sym) = @_; my $f; @@ -330,6 +432,11 @@ sub write_todo sub find_undefined_symbols { + # returns a list of undefined symbols in $shlib. To be considered + # undefined, it must also not be defined in $perl. Symbols that begin with + # underscore, or contain '@', or are some libc ones are not returned. + # Presumably, the list of libc could be expanded if necessary. + my($perl, $shlib) = @_; my $ps = read_sym(file => $perl, options => [qw( --defined-only )]); @@ -383,24 +490,31 @@ sub get_apicheck_symbol_map # Quit the loop if it succeeded last unless $r->{didnotrun} or $r->{status}; - # Get the list of macros that it failed on + # Get the list of macros that had parameter issues. These are marked as + # A, for absolute in nm terms my %sym = map { /error: macro "(\w+)" (?:requires|passed) \d+ argument/ ? ($1 => 'A') : () } @{$r->{stderr}}; + # Display these, and add them to the global %todo. if (keys %sym) { for my $s (sort dictionary_order keys %sym) { display_sym('new', $s, $sym{$s}); $todo{$s} = $sym{$s}; } + + # And rewrite the todo file, including these new symbols. write_todo($opt{todo}, $opt{version}, \%todo); + + # Regenerate apicheck.c for the next iteration regen_apicheck(); } - else { # It failed for some other reason: give up + else { # It failed for some other reason than parameter issues: give up die "cannot run make apicheck.i ($r->{didnotrun} / $r->{status}):\n". join('', @{$r->{stdout}})."\n---\n".join('', @{$r->{stderr}}); } } + # Here, have an apicheck.i. Read it in my $fh = IO::File->new('apicheck.i') or die "cannot open apicheck.i: $!"; @@ -411,13 +525,29 @@ sub get_apicheck_symbol_map while (<$fh>) { next if /^#/; - if (! defined $cur) { + # We only care about lines within one of our _DPPP_test_ functions. If + # we're in one, $cur is set to the name of the current one. + if (! defined $cur) { # Not within such a function; see if this starts + # one /_DPPP_test_(\w+)/ and $cur = $1; } else { + + # For anything that looks like a symbol, note it as a key, and as its + # value, the name of the function. Actually the value is another key, + # whose value is the count of this symbol's occurrences, so it looks + # like: + # 'UV' => { + # 'SvUVX' => 1, + # 'toFOLD_uvchr' => 2, + # 'sv_uni_display' => 1, + # ... + # } for my $sym (/\b([A-Za-z_]\w+)\b/g) { $symmap{$sym}{$cur}++; } + + # This line marks the end of this function, as constructed by us. undef $cur if /^}$/; } } -- 1.8.3.1