Ticket #1044: tracetwobranches.pl

File tracetwobranches.pl, 2.2 KB (added by jkeenan, 4 years ago)

Program used to compare branches

Line 
1#!/usr/local/bin/perl
2# tracetwobranches.pl
3use strict;
4use warnings;
5use 5.10.0;
6use Carp;
7use File::Temp;
8use Getopt::Long;
9use lib qw( /home/jimk/gitwork/parrot/lib );
10use Parrot::Configure::Trace;
11
12my $topdir = q{/home/user};
13my $sandbox = qq{$topdir/gitwork/parrot};
14chdir $sandbox or croak "Unable to change to $sandbox: $!";
15my (@branches, @els);
16my $max_step = '';
17GetOptions(
18    'branch=s' => \@branches,
19    'max-step=i' => \$max_step,
20    'el=s' => \@els,
21) or exit(1);
22
23croak "Must provide 2 branches as command-line arguments"
24    unless (@branches == 2);
25croak "Must provide at least 1 Parrot::Configure 'data' element"
26    unless @els;
27my @outputs;
28foreach my $br (@branches) {
29    push @outputs, traceformatteddiff($br, \@els, $max_step);
30}
31
32say $_ for @outputs;
33prepare_run($branches[0]);
34
35sub traceformatteddiff {
36    my ($br, $elsref, $max_step) = @_;
37    my $rv = prepare_run($br);
38    my $output = '';
39    $output .= "Working on branch $br\n";
40    croak "prepare_run() did not exit properly" unless $rv;
41    system(qq{$^X Configure.pl --configure_trace})
42        and croak "Unable to configure";
43    croak ".configure_trace.sto not found"
44        unless (-e './.configure_trace.sto');
45    my $obj = Parrot::Configure::Trace->new();
46    croak "Parrot::Configure::Trace object undefined"
47        unless defined $obj;
48    foreach my $el (@$elsref) {
49        $output .= "Element: $el\n";
50        my $attr = $obj->diff_data_c( {
51            attr        => $el,
52        } );
53        foreach my $step (@$attr) {
54            my $human_step = $step->{number} + 1;
55            unless ($max_step and $human_step > $max_step) {
56                $output .= sprintf("# %2d  %s\n" =>
57                    ($human_step, $step->{name})
58                );
59                $output .= "  before: '$step->{before}'\n";
60                $output .= "   after: '$step->{after}'\n";
61            }
62        }
63        $output .= "\n";
64    }
65
66    return $output;
67}
68
69sub prepare_run {
70    my $br = shift;
71    if (-e 'Makefile') {
72        system(q{make realclean --quiet 1>/dev/null})
73            and croak "Unable to make realclean";
74    }
75    system(qq{git checkout $br})
76        and croak "Unable to checkout $br";
77    return 1;
78}