#
# 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.
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
$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
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;
}
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:
}
}
+ # 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}++) {
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;
}
}
+ # 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--;
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));
$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;
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" .
}
}
-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=$_" } @_)
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) = @_;
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;
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 )]);
# 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: $!";
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 /^}$/;
}
}
https://perl5.git.perl.org / perl5.git / commitdiff