devel/mktodo.pl: Add ability to dump generated file

[perl5.git] / dist / Devel-PPPort / devel / mktodo.pl

diff --git a/dist/Devel-PPPort/devel/mktodo.pl b/dist/Devel-PPPort/devel/mktodo.pl
index a57029a..32c284b 100644 (file)
--- a/dist/Devel-PPPort/devel/mktodo.pl
+++ b/dist/Devel-PPPort/devel/mktodo.pl
@@ -30,8 +30,7 @@ our %opt = (
   base    => 0,
   verbose => 0,
   check   => 1,
-  todo    => "",    # If no --todo, this is a blead perl, and the make should
-                    # work without error
+  todo    => "",  # If no --todo, this is a blead perl
   shlib   => 'blib/arch/auto/Devel/PPPort/PPPort.so',
 );
 
@@ -48,7 +47,7 @@ chomp $fullperl;
 
 $ENV{SKIP_SLOW_TESTS} = 1;
 
-regen_all();
+regen_Makefile();
 
 my %stdsym = map { ($_ => 1) } qw (
   strlen
@@ -73,7 +72,7 @@ for (`$Config{nm} $fullperl`) {
 }
 keys %sym >= 50 or die "less than 50 symbols found in $fullperl\n";
 
-my %all = %{load_todo($opt{todo}, $opt{version})} if $opt{todo};
+my %todo = %{load_todo($opt{todo}, $opt{version})} if $opt{todo};
 my @recheck;
 
 my $symmap = get_apicheck_symbol_map();
@@ -84,10 +83,11 @@ for (;;) {
   regen_apicheck();
 
 retry:
-  my(@new, @tmp, %seen);
+  my(@new, @already_in_sym, %seen);
 
   my $r = run(qw(make));
-  $r->{didnotrun} and die "couldn't run make: $!\n";
+  $r->{didnotrun} and die "couldn't run make: $!\n" .
+        join('', @{$r->{stdout}})."\n---\n".join('', @{$r->{stderr}});
 
   # If there were warnings, we ask the user before continuing when creating
   # the base files of blead.  This leads to a potential early exit when things
@@ -112,7 +112,7 @@ retry:
       if (!$seen{$1}++) {
         my @s = grep { exists $sym{$_} } $1, "Perl_$1", "perl_$1";
         if (@s) {
-          push @tmp, [$1, "E (@s)"];
+          push @already_in_sym, [$1, "E (@s)"];
         }
         else {
           push @new, [$1, "E"];
@@ -133,7 +133,8 @@ retry:
 
     unless (@u) {
       $r = run(qw(make test));
-      $r->{didnotrun} and die "couldn't run make test: $!\n";
+      $r->{didnotrun} and die "couldn't run make test: $!\n" .
+        join('', @{$r->{stdout}})."\n---\n".join('', @{$r->{stderr}});
       $r->{status} == 0 and last;
 
       for my $l (@{$r->{stderr}}) {
@@ -155,16 +156,16 @@ retry:
     }
   }
 
-  @new = grep !$all{$_->[0]}, @new;
+  @new = grep !$todo{$_->[0]}, @new;
 
   unless (@new) {
-    @new = grep !$all{$_->[0]}, @tmp;
+    @new = grep !$todo{$_->[0]}, @already_in_sym;
   }
 
   unless (@new) {
     if ($retry > 0) {
       $retry--;
-      regen_all();
+      regen_Makefile();
       goto retry;
     }
     print Dumper($r);
@@ -175,11 +176,11 @@ retry:
   push @recheck, map { $_->[0] } grep { $_->[1] !~ /^U/ } @new;
 
   for (@new) {
-    sym('new', @$_);
-    $all{$_->[0]} = $_->[1];
+    display_sym('new', @$_);
+    $todo{$_->[0]} = $_->[1];
   }
 
-  write_todo($opt{todo}, $opt{version}, \%all);
+  write_todo($opt{todo}, $opt{version}, \%todo);
 }
 
 if ($opt{check}) {
@@ -188,12 +189,12 @@ if ($opt{check}) {
 
   RECHECK: for my $i (0 .. $#recheck) {
     my $sym = $recheck[$i];
-    my $cur = delete $all{$sym};
+    my $cur = delete $todo{$sym};
 
-    sym('chk', $sym, $cur, sprintf(" [$ifmt/$ifmt, ETA %s]",
+    display_sym('chk', $sym, $cur, sprintf(" [$ifmt/$ifmt, ETA %s]",
                $i + 1, scalar @recheck, eta($t0, $i, scalar @recheck)));
 
-    write_todo($opt{todo}, $opt{version}, \%all);
+    write_todo($opt{todo}, $opt{version}, \%todo);
 
     if ($cur eq "E (Perl_$sym)") {
       # we can try a shortcut here
@@ -202,34 +203,38 @@ if ($opt{check}) {
       my $r = run(qw(make test));
 
       if (!$r->{didnotrun} && $r->{status} == 0) {
-        sym('del', $sym, $cur);
+        display_sym('del', $sym, $cur);
         next RECHECK;
       }
     }
 
     # run the full test
-    regen_all();
+    regen_Makefile();
 
     my $r = run(qw(make test));
 
-    $r->{didnotrun} and die "couldn't run make test: $!\n";
+    # This regenerated apicheck.c
+    dump_apicheck() if $opt{debug};
+
+    $r->{didnotrun} and die "couldn't run make test: $!\n" .
+        join('', @{$r->{stdout}})."\n---\n".join('', @{$r->{stderr}});
 
     if ($r->{status} == 0) {
-      sym('del', $sym, $cur);
+      display_sym('del', $sym, $cur);
     }
     else {
-      $all{$sym} = $cur;
+      $todo{$sym} = $cur;
     }
   }
 }
 
-write_todo($opt{todo}, $opt{version}, \%all);
+write_todo($opt{todo}, $opt{version}, \%todo);
 
 run(qw(make realclean));
 
 exit 0;
 
-sub sym
+sub display_sym
 {
   my($what, $sym, $reason, $extra) = @_;
   $extra ||= '';
@@ -244,15 +249,18 @@ sub sym
          $opt{version}, $what, $sym, $reason, $extra;
 }
 
-sub regen_all
+sub regen_Makefile
 {
   my @mf_arg = ('--with-apicheck', 'OPTIMIZE=-O0 -w');
   push @mf_arg, qw( DEFINE=-DDPPP_APICHECK_NO_PPPORT_H ) if $opt{base};
 
   # just to be sure
   run(qw(make realclean));
-  run($fullperl, "Makefile.PL", @mf_arg)->{status} == 0
-      or die "cannot run Makefile.PL: $!\n";
+  my $r = run($fullperl, "Makefile.PL", @mf_arg);
+  unless ($r->{status} == 0) {
+      die "cannot run Makefile.PL: $!\n" .
+          join('', @{$r->{stdout}})."\n---\n".join('', @{$r->{stderr}});
+  }
 }
 
 sub regen_apicheck
@@ -260,6 +268,23 @@ sub regen_apicheck
   unlink qw(apicheck.c apicheck.o);
   runtool({ out => '/dev/null' }, $fullperl, 'apicheck_c.PL', map { "--api=$_" } @_)
       or die "cannot regenerate apicheck.c\n";
+  dump_apicheck() if $opt{debug};
+}
+
+sub dump_apicheck
+{
+    my $apicheck = "apicheck.c";
+    my $f = new IO::File $apicheck or die "cannot open $apicheck: $!\n";
+    my @lines = <$f>;
+    print STDERR __FILE__, ": ", __LINE__, ": $apicheck (",
+                                           scalar @lines,
+                                           " lines) for $fullperl";
+    print STDERR " and '" if @_;
+    print STDERR join "', '", @_;
+    print STDERR "'" if @_;
+    print STDERR ":\n";
+    my $n = 1;
+    print STDERR $n++, " ", $_ for @lines;
 }
 
 sub load_todo
@@ -330,7 +355,8 @@ sub read_sym
   my $r = run($Config{nm}, @{$opt{options}}, $opt{file});
 
   if ($r->{didnotrun} or $r->{status}) {
-    die "cannot run $Config{nm}";
+    die "cannot run $Config{nm}" .
+          join('', @{$r->{stdout}})."\n---\n".join('', @{$r->{stderr}});
   }
 
   my %sym;
@@ -351,22 +377,26 @@ sub get_apicheck_symbol_map
   my $r;
 
   while (1) {
+
+    # Create apicheck.i
     $r = run(qw(make apicheck.i));
 
+    # Quit the loop if it succeeded
     last unless $r->{didnotrun} or $r->{status};
 
+    # Get the list of macros that it failed on
     my %sym = map { /error: macro "(\w+)" (?:requires|passed) \d+ argument/ ? ($1 => 'A') : () }
               @{$r->{stderr}};
 
     if (keys %sym) {
       for my $s (sort dictionary_order keys %sym) {
-        sym('new', $s, $sym{$s});
-        $all{$s} = $sym{$s};
+        display_sym('new', $s, $sym{$s});
+        $todo{$s} = $sym{$s};
       }
-      write_todo($opt{todo}, $opt{version}, \%all);
+      write_todo($opt{todo}, $opt{version}, \%todo);
       regen_apicheck();
     }
-    else {
+    else {  # It failed for some other reason: give up
       die "cannot run make apicheck.i ($r->{didnotrun} / $r->{status}):\n".
           join('', @{$r->{stdout}})."\n---\n".join('', @{$r->{stderr}});
     }