#!/usr/bin/perl
## -*- mode: Perl -*-
##
## Copyright (c) 2012, 2013, 2014, 2015, 2016 The University of Utah
## All rights reserved.
##
## This file is distributed under the University of Illinois Open Source
## License.  See the file COPYING for details.

######################################################################
#
# This is a generic Delta debugger that is parameterized by an
# interestingness test implemented as a shell script and a collection
# of transformation operators implemented as Perl modules.
#
####################################################################

use strict;
use warnings;
require 5.10.0;

use FindBin;
use lib $FindBin::Bin, '/usr/share/creduce/perl';
use Exporter::Lite;
use File::Basename;
use File::Compare;
use File::Which;
use Getopt::Tabular;
use POSIX;
use Regexp::Common;
use File::Spec;
use File::Temp;
use File::Copy;

# Load and use the Term::ReadKey module if available, don't complain otherwise
my $SKIP_KEY_OFF = 0;
$SKIP_KEY_OFF = 1 unless eval { require Term::ReadKey; };

if ($^O eq "MSWin32") {
    eval { require Win32::Process; Win32::Process->import(); };
}

use creduce_config qw(PACKAGE_STRING);
use creduce_utils;

my $NPROCS = nprocs();

######################################################################

my $MAX_CRASH_DIRS = 10;
my $MAX_EXTRA_DIRS = 25000;
my $GIVEUP_CONSTANT = 50000;
my $PRINT_DIFF = 0;
my $SANITIZE = 0;
my $SKIP_FIRST;
my $SAVE_TEMPS;
my $SLLOOWW = 0;
my $NODEFAULT;
my $TIMING = 0;
my $DEBUG_SMP = 0;
my $DIE_ON_PASS_BUG = 0;
my $SILENT_PASS_BUGS = 0;
my $TIDY = 0;
my $ALSO_INTERESTING = -1;
my $NOKILL = 0;
my $MAX_WIN;

my @options = (
    ["--n",                    "integer", 1, \$NPROCS,          "Number of cores to use; C-Reduce tries to automatically pick a good setting but its choice may be too low or high for your situation", "<N>"],
    ["--tidy",                "const",   1, \$TIDY,            "Do not make a backup copy of each file to reduce as file.orig"],
    ["--shaddap",             "const",   1, \$SILENT_PASS_BUGS, "Suppress output about non-fatal internal errors"],
    ["--die-on-pass-bug",     "const",   1, \$DIE_ON_PASS_BUG, "Terminate C-Reduce if a pass encounters an otherwise non-fatal problem"],
    ["--sanitize",            "const",   1, \$SANITIZE,        "Attempt to obscure details from the original source file"],
    ["--sllooww",             "const",   1, \$SLLOOWW,         "Try harder to reduce, but perhaps take a long time to do so"],
    ["--also-interesting",    "integer", 1, \$ALSO_INTERESTING, "A process exit code (somewhere in the range 64-113 would be usual) that, when returned by the interestingness test, will cause C-Reduce to save a copy of the variant", "<exitcode>"],
    ["--debug",               "const",   1, \$DEBUG,           "Print debug information"],
    ["--nokill",              "const",   1, \$NOKILL,          "Wait for parallel instances to terminate on their own instead of killing them (only useful for debugging)"],
    ["--no-give-up",          "const",   0, \$GIVEUP_CONSTANT, "Don't give up on a pass that hasn't made progress for ${GIVEUP_CONSTANT} iterations"],
    ["--print-diff",          "const",   1, \$PRINT_DIFF,      "Show changes made by transformations, for debugging"],
    ["--save-temps",          "const",   1, \$SAVE_TEMPS,      "Don't delete /tmp/creduce-xxxxxx directories on termination"],
    ["--skip-initial-passes", "const",   1, \$SKIP_FIRST,      "Skip initial passes (useful if input is already partially reduced)"],
    ["--timing",              "const",   1, \$TIMING,          "Print timestamps about reduction progress"],
    ["--no-default-passes",   "const",   1, \$NODEFAULT,       "Start with an empty pass schedule"],
    ["--add-pass",            "call",    0, \&add_pass,        "Add the specified pass to the schedule", "<pass> <sub-pass> <priority>"],
    ["--skip-key-off",        "const",   1, \$SKIP_KEY_OFF,    "Disable skipping the rest of the current pass when \"s\" is pressed"],
    ["--max-improvement",      "integer", 1, \$MAX_WIN,         "Largest improvement in file size from a single transformation that C-Reduce should accept (useful only to slow C-Reduce down)", "<bytes>"],
);

@options = sort { return @{$a}[0] cmp @{$b}[0]; } @options;

my $PKG = creduce_config::PACKAGE_STRING;
my $COMMIT = creduce_config::GIT_HASH;
my $help = <<HELP;
$PKG ($COMMIT) -- a C and C++ program reducer

C-Reduce requires an "interestingness test" and one or more files to
reduce, which must be writable. The interestingness test is an
executable program (usually a shell script) that returns 0 when a
partially reduced file is interesting (a candidate for further
reduction) and returns non-zero when a partially reduced file is not
interesting (not a candidate for further reduction -- all
uninteresting files are discarded).

C-Reduce runs the interestingness test in a fresh temporary directory
containing only the partially reduced file(s). Thus, when the
interestingness test examines a partially reduced file, it must do so
using a relative path to the current working directory. On the other
hand, when the interestingness test refers to any file that is not
being reduced, this should be done using an absolute path.

The interestingness test should not expect any command line arguments.
It should be deterministic and might want to enforce resource limits
on sub-commands that it invokes (e.g. using ulimit). In particular,
C-Reduce is known to sometimes introduce an infinite loop into the
program being reduced. Therefore, if the interestingness test runs the
compiled program, it probably should do so under a timeout.

As a quick example, if you consider a file to be interesting if GCC's
vectorizer fires while compiling it, you might use this
interestingness test:

  gcc -w -O3 foo.c -S &&
  grep xmm foo.s

To see if your interestingness test is working, try running these
commands:

  DIR=\`mktemp -d\`
  cp file_to_reduce [optionally, more files to reduce] \$DIR
  cd \$DIR
  /path/to/interestingness_test
  echo \$\?

This should result in "0" being echoed to the terminal. If this does
not happen, the interestingness test is flawed and C-Reduce won't be
able to make use of it.

If you haven\'t written an interestingness test before, please refer to
this tutorial for additional guidance:

  https://embed.cs.utah.edu/creduce/using/

If at all possible, run C-Reduce on preprocessed code, generated for
example using:

  gcc -E -P file.c

If you cannot reduce preprocessed code, you can either reduce just the
non-preprocessed file or else perform a multi-file reduction on the
file and its transitive includes (or any subset of them). In the first case
you need to set the CREDUCE_INCLUDE_PATH environment variable to a colon-
separated list of include directories in order for clang_delta to find them.

If your interestingness test involves a cross compiler and the characteristics
of the cross target differs from the host you will need to set
CREDUCE_TARGET_TRIPLE to match the cross target. This is particularly important
if you are working with non-preprocessed code and use CREDUCE_INCLUDE_PATH.

Press "s" at any time to skip to the next pass (this feature is
disabled unless the Perl module Term::ReadKey is available on your
system).
HELP

my $usage_text = <<USAGE;
usage: creduce [options] interestingness_test file_to_reduce [optionally, more files to reduce]
       creduce --help for more information

USAGE

sub usage() {
    print $usage_text;
    exit(1);
}

Getopt::Tabular::SetHelp ($help, $usage_text);
Getopt::Tabular::SetOptionPatterns qw|(--)([\w-]+) (-)(\w+)|;
Getopt::Tabular::SetHelpOption("--help");
GetOptions(\@options, \@ARGV) or exit(1);
usage() unless (@ARGV >= 2);

my @custom_methods;

sub add_pass {
    my ($opt, $args, $dest) = @_;
    my $name = shift @$args;
    my $subpass = shift @$args;
    my $pri = shift @$args;
    return 0 unless defined $name && defined $subpass && defined $pri;
    my %pass = ();
    $pass{"name"} = $name;
    $pass{"arg"} = $subpass;
    $pass{"pri"} = $pri;
    push @custom_methods, \%pass;
    return 1;
}

######################################################################

my $total_file_size = 0;
my $orig_total_file_size = 0;

# these are set at startup time and never change
my $test;
my $orig_dir;

my @toreduce;
my %fileonly;
my %suffix;

######################################################################

sub print_pct () {
    my $s = 0;
    foreach my $f (@toreduce) {
	$s += -s $f;
    }
    my $pct = 100 - ($s * 100.0 / $orig_total_file_size);
    printf "(%.1f %%, $s bytes)\n", $pct;
}

my @tmpdirs;

sub make_tmpdir () {
    my $dir = File::Temp::tempdir("creduce-XXXXXX", 
				  $SAVE_TEMPS ? (CLEANUP => 0) : (CLEANUP => 1), 
				  DIR => File::Spec->tmpdir);
    push @tmpdirs, $dir;
    return $dir;
}

sub remove_tmpdirs () {
    return if $SAVE_TEMPS;
    while (my $dir = shift(@tmpdirs)) {
	File::Path::remove_tree ($dir, {verbose => 0, safe => 0, error => \my $err});
    }
}

sub create_extra_dir() {
    my $dir;
    for (my $i=0; $i<$MAX_EXTRA_DIRS; $i++) {
	$dir = File::Spec->catfile($orig_dir, sprintf "creduce_extra_%05d", $i);
	last unless -d $dir;
    }
    # just bail if we've already created enough of these dirs, no need
    # to clutter things up even more...
    return if -d $dir;
    mkdir $dir or die;
    my @files = glob "*";
    foreach my $f (@files) {
	File::Copy::move($f, $dir) or die "Could not move file\n";
    }
    print "created extra directory '$dir' for you to look at later\n";
}

# returns true if interesting, false otherwise
sub delta_test () {
    my $res;
    if ($DEBUG) {
	$res = runit ("$test");
    } else {
        if($^O eq "MSWin32") {
            $res = runit ("$test > NUL 2>&1");
        } else {
            $res = runit ("$test > /dev/null 2>&1");
        }
    }
    create_extra_dir() if ($ALSO_INTERESTING != -1 && $res == $ALSO_INTERESTING);
    return ($res == 0);
}

sub copy_files_here() {
    foreach my $f (@toreduce) {
	File::Copy::copy($f,$fileonly{$f}) or die;
    }
}

sub sanity_check () {
    print "sanity check... " if $DEBUG;
    my $tmpdir = make_tmpdir();
    print "tmpdir = $tmpdir\n" if ($DEBUG);
    chdir $tmpdir or die;
    copy_files_here();
    if (!delta_test()) {
	chdir $orig_dir;
	my $stuff = "";
	foreach my $f (sort keys %fileonly) {
	    $stuff .= " $f";
	}
	print <<"EOT";

C-Reduce cannot run because the interestingness test does not return
zero. Please ensure that it does so not only in the directory where
you are invoking C-Reduce, but also in an arbitrary temporary
directory containing only the files that are being reduced. In other
words, running these commands:

  DIR=\`mktemp -d\`
  cp$stuff \$DIR
  cd \$DIR
  $test
  echo \$\?

should result in "0" being echoed to the terminal.

See "creduce --help" for more information.

EOT
        exit(1);
    }
    print "successful\n" if $DEBUG;
    chdir $orig_dir or die;
    remove_tmpdirs();
}

my $old_len = 1000000000;

sub call_prereq_check ($) {
    (my $method) = @_;
    my $str = $method."::check_prereqs";
    no strict "refs";
    &${str}() or die "prereqs not found for pass $method";
    print "successfully checked prereqs for $method\n" if $DEBUG;
}

sub call_new ($$$) {
    (my $method,my $fn,my $arg) = @_;
    my $str = $method."::new";
    no strict "refs";
    return &${str}($fn,$arg);
}

sub call_advance ($$$$) {
    (my $method,my $fn,my $arg,my $state) = @_;
    my $str = $method."::advance";
    no strict "refs";
    return &${str}($fn,$arg,$state);
}

sub call_advance_on_success ($$$$) {
    (my $method,my $fn,my $arg,my $state) = @_;
    my $str = $method."::advance_on_success";
    no strict "refs";
    return &${str}($fn,$arg,$state);
}

sub call_transform ($$$$) {
    (my $method,my $fn,my $arg,my $state) = @_;
    my $str = $method."::transform";
    no strict "refs";
    return &${str}($fn,$arg,$state);
}

# @variants is the list of variants that we're currently considering;
# it is speculative by assuming that each subsequent variant is
# uninteresting; once an interesting variant is found, the speculation
# is incorrect and we have to empty out this list using killem() and
# start again; elements of this list are tuples where the first
# element is the pid of the child process (if running) or -1 (if we've
# already waited for that child)
my @variants = ();
my @procs = ();
my $num_running = 0;

sub killem() {
    if($^O eq "MSWin32") {
        while (scalar(@procs) > 0) {
            my $proc = shift @procs;
            # Kill process group
            # Win32::Process::Info might be an alternative
            # $proc->Kill(1); #does not kill the children
            my $pid = $proc->GetProcessID();
            system "TASKKILL /F /T /PID $pid > NUL 2>&1"
		unless $NOKILL;
            $proc->Wait(Win32::Process::INFINITE());
            $num_running--;
        }
        while (scalar(@variants) > 0) {
	    my $kidref = shift @variants;
	    die unless (scalar(@{$kidref})==5);
	    (my $pid, my $newsh, my $tmpdir, my $tmpfn, my $result) = @{$kidref};
	    File::Path::remove_tree ($tmpdir, {verbose => 0, safe => 0, error => \my $err})
		unless $SAVE_TEMPS;
        }
    } else {
        while (scalar(@variants) > 0) {
	    my $kidref = shift @variants;
	    die unless (scalar(@{$kidref})==5);
	    (my $pid, my $newsh, my $tmpdir, my $tmpfn, my $result) = @{$kidref};
	    if ($pid != -1) {
		# kill the whole group
		kill ('TERM', -$pid)
		    unless $NOKILL;
		waitpid ($pid, 0);
		$num_running--;
	    }
	    File::Path::remove_tree ($tmpdir, {verbose => 0, safe => 0, error => \my $err})
		unless $SAVE_TEMPS;
        }
    }
}

sub fork_helper($) {
    (my $tmpfn) = @_;
    if ($^O eq "MSWin32") {
        my $cmd = which("cmd.exe");
        my $cmdline = qq{/C "$test" $tmpfn};
        $cmdline .= " > NUL 2>&1" unless $DEBUG;

        my $proc;
        Win32::Process::Create($proc,
                               $cmd,
                               $cmdline,
                               0,
                               Win32::Process::NORMAL_PRIORITY_CLASS() |
                               Win32::Process::CREATE_NEW_PROCESS_GROUP(),
                               ".") || die;
        push @procs, $proc;
        return $proc->GetProcessID();
    } else {
        my $pid = fork();
        die unless ($pid >= 0);
        if ($pid == 0) {
            # put this process (the child) into a process group named by
            # its pid so that we'll be able to kill its entire subtree
            # later
            setpgrp();
	    # flip the T/F flag back into a 0/1
            my $res = delta_test();
	    print "delta_test() returned $res\n" if $DEBUG;
            my $exitcode = $res ? 0 : 1;
	    print "forked child exiting with $exitcode (1 == uninteresting, 0 == interesting)\n" if $DEBUG_SMP;
	    exit($exitcode);
        }
        return $pid;
    }
}

sub wait_helper() {
    if ($^O eq "MSWin32") {
        return -1 if @procs == 0;

        while(1) {
            my $proc = shift @procs;
            $proc->Wait(Win32::Process::INFINITE());

            my $exit_code;
            if ($proc->GetExitCode($exit_code) != Win32::Process::STILL_ACTIVE()) {
                $? = ($exit_code == 0) ? 1 << 8 : 0;
                return $proc->GetProcessID();
            }
            push @procs, $proc;
        }
    } else {
        my $cpid = wait();
	die if ($cpid == -1);
	return $cpid;
    }
}

sub check_for_nonzero_size() {
    my $nonzero = 0;
    foreach my $fn (@toreduce) {
	if (-s $fn != 0) {
	    $nonzero = 1;
	    last;
	}
    }
    if (!$nonzero) {
	print "\n";
	if (scalar(@toreduce) > 1) {
	    print "All files being reduced have reached zero size; ";
	} else {
	    print "The file being reduced has reached zero size; ";
	}
	print <<EOT;
our work here is done.

If you did not want a zero size file, you must help C-Reduce out by
making sure that your interestingness test does not find files like
this to be interesting.

EOT
	exit(1);
    }
}

sub report_pass_bug($$$) {
    (my $delta_method, my $delta_arg, my $prob) = @_;
    if (!$SILENT_PASS_BUGS) {
	my $dir;
	for (my $i=0; $i<$MAX_CRASH_DIRS; $i++) {
	    $dir = File::Spec->catfile($orig_dir, sprintf "creduce_bug_%03d", $i);
	    last unless -d $dir;
	}
	# just bail if we've already created enough of these dirs, no need
	# to clutter things up even more...
	return if -d $dir;
	mkdir $dir or die;
	chdir $dir or die;
	copy_files_here();
	my $cont = $DIE_ON_PASS_BUG ? "" :
	    "\nThis bug is not fatal, C-Reduce will continue to execute.\n";
	my $MSG = <<"EOT";

***************************************************

${delta_method}::${delta_arg} has encountered a bug:
${prob}

Please consider tarring up ${dir}
and mailing it to creduce-bugs\@flux.utah.edu and we will try to fix
the bug.
${cont}
***************************************************

EOT
	open OF, ">PASS_BUG_INFO.TXT";
	print OF "$PKG\n";
	print OF "$COMMIT\n";
	my @l = POSIX::uname();
	foreach my $s (@l) {
	    print OF "$s\n";
	}
	print OF "$MSG";
	close OF;
	print $MSG;
    }
    if ($DIE_ON_PASS_BUG) {
	print "Exiting upon request due to pass bug.\n";
	exit(1);
    }
}

my $pass_num = 0;
my %method_worked = ();
my %method_failed = ();

# invariant: parallel execution does not escape this function
#
# the parallelization strategy is described here:
#   http://blog.regehr.org/archives/749
sub delta_pass ($) {
    (my $mref) = @_;
    my $delta_method = ${$mref}{"name"};
    my $delta_arg = ${$mref}{"arg"};
    my $skip = 0;

    die unless (scalar(@variants)==0);
    die unless ($num_running==0);

    check_for_nonzero_size();

    print "\n" if $DEBUG;
    print "===< $delta_method :: $delta_arg >===\n";

    @toreduce = sort bysize @toreduce;
    foreach my $fn (@toreduce) {
	next unless (-s $fn > 0);
	my $state = call_new ($delta_method,$fileonly{$fn},$delta_arg);
	my $since_success = 0;
	my $stopped = 0;

      AGAIN:

	# create child processes until either:
	# 1. we exhaust the concurrency budget
	# 2. the pass tells us to STOP
	# 3. $SKIP_KEY_OFF is not set and the "s" key on the terminal is pressed
	if (!$SKIP_KEY_OFF) {
	    Term::ReadKey::ReadMode(3);
	    my $key = Term::ReadKey::ReadKey(-1);
	    Term::ReadKey::ReadMode(0);
	    if (defined($key) && $key eq "s") {
		print "\n****** skipping the rest of this pass ******\n\n";
		$skip = 1;
	    }
	}
	while (!($stopped || $skip) && $num_running < $NPROCS) {
	    my $tmpdir = make_tmpdir();
	    chdir $tmpdir or die;
	    copy_files_here();
	    # creating the variant is done in the parent, it's only
	    # testing variants that happens in parallel
	    my $variant = File::Spec->catfile($tmpdir, $fileonly{$fn});
	    (my $delta_res, $state) = call_transform ($delta_method,$variant,$delta_arg,$state);
	    if ($delta_res != $OK && $delta_res != $STOP) {
		report_pass_bug($delta_method, $delta_arg,
				($delta_res == $ERROR) ? $state :
				"unknown return code");
	    }
	    if ($delta_res == $STOP || $delta_res == $ERROR) {
		chdir $orig_dir or die;
		$stopped = 1;
	    } else {
		system "diff $fn $variant" if ($PRINT_DIFF);
		if (compare ($fn, $variant) == 0) {
		    report_pass_bug($delta_method, $delta_arg,
				    "pass failed to modify the variant");
		    chdir $orig_dir or die;
		    $stopped = 1;
		} else {
		    my $pid = fork_helper ($variant);
		    my @l = ($pid, $state, $tmpdir, $variant, -99);
		    push @variants, \@l;
		    chdir $orig_dir or die;
		    $num_running++;
		    print "forked $pid, num_running = ${num_running}\n" if $DEBUG_SMP;
		    $state = call_advance ($delta_method, $variant, $delta_arg, $state);
		}
	    }
	}

	if ($num_running > 0) {
	    print "parent is waiting\n" if $DEBUG_SMP;
	    my $xpid = wait_helper();
	    # UNIX 0/1 back to Perl T/F
	    my $delta_result = (($? >> 8) == 0) ? 1 : 0;
	    print "child $xpid had delta_result ${delta_result} (0 == uninteresting, 1 == interesting)\n"
		if $DEBUG_SMP;
	    $num_running--;
	    my $found = 0;
	    my $len = scalar (@variants);
	    for (my $k=0; $k<scalar(@variants); $k++) {
		my $kidref = $variants[$k];
		die unless (scalar(@{$kidref})==5);
		(my $pid,my $newsh,my $tmpdir,my $var,my $res) = @{$kidref};
		if ($xpid == $pid) {
		    $found = 1;
		    my @l = (-1,$newsh,$tmpdir,$var,$delta_result);
		    splice (@variants, $k, 1, \@l);
		    last;
		}
	    }
	    die unless $found;
	    die unless ($len == scalar (@variants));
	}

	# starting at the front of the list, peel off all variants that
	# aren't backed up by a running subprocess
	while (scalar (@variants) > 0) {
	    (my $pid,my $newsh,my $tmpdir,my $variant,my $delta_result) = @{$variants[0]};
	    last unless ($pid == -1);
	    my $trash = shift @variants;
	    if ($delta_result &&
		(!defined $MAX_WIN || ((-s $fn) - (-s $variant) < $MAX_WIN))) {
		# now that the delta test succeeded, this becomes our
		# new best version

		# nuke all ongoing speculation
		killem ();

		# here is where we actually accept the new result: we
		# need to grab both the file and the pass state
		$state = call_advance_on_success ($delta_method, $variant, $delta_arg, $newsh);
		File::Copy::copy ($variant, $fn) or die;

		# we don't want to be stopped by a speculative transformation
		$stopped = 0;
		
		$since_success = 0;
		$method_worked{$delta_method}{$delta_arg}++;
		print "delta test success " if $DEBUG;
		print_pct();
		print "timestamp ".time()." size ".(-s $fn)."\n"
		    if $TIMING;
	    } else {
		print "delta test failure\n" if $DEBUG;
		$since_success++;
		$method_failed{$delta_method}{$delta_arg}++;
	    }
	    print "[${pass_num} ${delta_method} :: ${delta_arg}] " if $DEBUG;
	    File::Path::remove_tree ($tmpdir, {verbose => 0, safe => 0, error => \my $err})
		unless $SAVE_TEMPS;
	}

	# nasty heuristic for avoiding getting stuck by buggy passes
	# that keep reporting success w/o making progress -- FIXME
	# report a bug here
	if ($GIVEUP_CONSTANT != 0 && ($since_success > $GIVEUP_CONSTANT)) {
	    killem();
	    report_pass_bug($delta_method, $delta_arg, "pass got stuck");
	    remove_tmpdirs();
	    next;
	}

	# termination condition for this pass
	if (($skip || $stopped) && scalar(@variants)==0) {
	    remove_tmpdirs();
	    next;
	}

	goto AGAIN;
    }
}

sub line_delta_pass ($) {
    (my $n) = @_;
    my $line = { "name" => "pass_lines", "arg" => "$n", };
    delta_pass ($line);
}

my @all_methods = (
    { "name" => "pass_include_includes", "arg" => "0",               "pri" => 100, },
    { "name" => "pass_includes", "arg" => "0",                                      "first_pass_pri" =>  0, },
    { "name" => "pass_unifdef",  "arg" => "0",                       "pri" => 450,  "first_pass_pri" =>  0, },
    { "name" => "pass_comments", "arg" => "0",                       "pri" => 451,  "first_pass_pri" =>  0, },
    { "name" => "pass_blank",    "arg" => "0",                                      "first_pass_pri" =>  1, },
    { "name" => "pass_clang_binsrch",    "arg" => "replace-function-def-with-decl", "first_pass_pri" =>  2, },
    { "name" => "pass_clang_binsrch",    "arg" => "remove-unused-function",         "first_pass_pri" =>  3, },

    { "name" => "pass_lines",    "arg" => "0",                      "pri" => 410,  "first_pass_pri" =>  20,   "last_pass_pri" => 999, },
    { "name" => "pass_lines",    "arg" => "0",                                     "first_pass_pri" =>  21, },
    #{ "name" => "pass_lines",    "arg" => "0",                                     "first_pass_pri" =>  22, },
    { "name" => "pass_lines",    "arg" => "1",                      "pri" => 411,  "first_pass_pri" =>  23, },
    { "name" => "pass_lines",    "arg" => "1",                                     "first_pass_pri" =>  24, },
    #{ "name" => "pass_lines",    "arg" => "1",                                     "first_pass_pri" =>  25, },
    { "name" => "pass_lines",    "arg" => "2",                      "pri" => 412,  "first_pass_pri" =>  27, },
    { "name" => "pass_lines",    "arg" => "2",                                     "first_pass_pri" =>  28, },
    #{ "name" => "pass_lines",    "arg" => "2",                                     "first_pass_pri" =>  29, },
    { "name" => "pass_lines",    "arg" => "10",                     "pri" => 413,  "first_pass_pri" =>  30, },
    { "name" => "pass_lines",    "arg" => "10",                                    "first_pass_pri" =>  31, },
    #{ "name" => "pass_lines",    "arg" => "10",                                    "first_pass_pri" =>  32, },

    { "name" => "pass_clang_binsrch",    "arg" => "replace-function-def-with-decl", "first_pass_pri" => 33, },
    { "name" => "pass_clang_binsrch",    "arg" => "remove-unused-function",         "first_pass_pri" => 34, },

    { "name" => "pass_lines",    "arg" => "0",                                     "first_pass_pri" =>  35, },
    { "name" => "pass_lines",    "arg" => "1",                                     "first_pass_pri" =>  36, },
    { "name" => "pass_lines",    "arg" => "2",                                     "first_pass_pri" =>  37, },
    { "name" => "pass_lines",    "arg" => "10",                                    "first_pass_pri" =>  38, },

    { "name" => "pass_special",      "arg" => "a",                                 "first_pass_pri" => 110, },
    { "name" => "pass_special",      "arg" => "b",                  "pri" => 555,  "first_pass_pri" => 110, },
    { "name" => "pass_special",      "arg" => "c",                  "pri" => 555,  "first_pass_pri" => 110, },
    { "name" => "pass_ternary",  "arg" => "b",                      "pri" => 104,  },
    { "name" => "pass_ternary",  "arg" => "c",                      "pri" => 105,  },
    { "name" => "pass_balanced", "arg" => "curly",                  "pri" => 110,  "first_pass_pri" =>  41, },
    { "name" => "pass_balanced", "arg" => "curly2",                 "pri" => 111,  "first_pass_pri" =>  42, },
    { "name" => "pass_balanced", "arg" => "curly3",                 "pri" => 112,  "first_pass_pri" =>  43, },
    { "name" => "pass_balanced", "arg" => "parens",                 "pri" => 113,  },
    { "name" => "pass_balanced", "arg" => "angles",                 "pri" => 114,  },
    { "name" => "pass_balanced", "arg" => "curly-only",             "pri" => 150,  },
    { "name" => "pass_balanced", "arg" => "parens-only",            "pri" => 151,  },
    { "name" => "pass_balanced", "arg" => "angles-only",            "pri" => 152,  },
    { "name" => "pass_clang",    "arg" => "remove-namespace",       "pri" => 200,  },
    { "name" => "pass_clang",    "arg" => "aggregate-to-scalar",    "pri" => 201,  },
   #{ "name" => "pass_clang",    "arg" => "binop-simplification",   "pri" => 201,  },
    { "name" => "pass_clang",    "arg" => "local-to-global",        "pri" => 202,  },
    { "name" => "pass_clang",    "arg" => "param-to-global",        "pri" => 203,  },
    { "name" => "pass_clang",    "arg" => "param-to-local",         "pri" => 204,  },
    { "name" => "pass_clang",    "arg" => "remove-nested-function", "pri" => 205,  },
    { "name" => "pass_clang",    "arg" => "rename-fun",                            "last_pass_pri" => 207,  },
    { "name" => "pass_clang",    "arg" => "union-to-struct",        "pri" => 208,  },
    { "name" => "pass_clang",    "arg" => "rename-param",                          "last_pass_pri" => 209,  },
    { "name" => "pass_clang",    "arg" => "rename-var",                            "last_pass_pri" => 210,  },
    { "name" => "pass_clang",    "arg" => "rename-class",                          "last_pass_pri" => 211,  },
    { "name" => "pass_clang",    "arg" => "rename-cxx-method",                     "last_pass_pri" => 212,  },
    { "name" => "pass_clang",    "arg" => "return-void",            "pri" => 212,  },
    { "name" => "pass_clang",    "arg" => "simple-inliner",         "pri" => 213,  },
    { "name" => "pass_clang",    "arg" => "reduce-pointer-level",   "pri" => 214,  },
    { "name" => "pass_clang",    "arg" => "lift-assignment-expr",   "pri" => 215,  },
    { "name" => "pass_clang",    "arg" => "copy-propagation",       "pri" => 216,  },
    { "name" => "pass_clang",    "arg" => "callexpr-to-value",      "pri" => 217,  "first_pass_pri" => 49, },
    { "name" => "pass_clang",    "arg" => "replace-callexpr",       "pri" => 218,  "first_pass_pri" => 50, },
    { "name" => "pass_clang",    "arg" => "simplify-callexpr",      "pri" => 219,  "first_pass_pri" => 51, },
    { "name" => "pass_clang",    "arg" => "remove-unused-function", "pri" => 220,  "first_pass_pri" => 40, },
    { "name" => "pass_clang",    "arg" => "remove-unused-enum-member", "pri" => 221, "first_pass_pri" => 51, },
    { "name" => "pass_clang",    "arg" => "remove-enum-member-value", "pri" => 222, "first_pass_pri" => 52, },
    { "name" => "pass_clang",    "arg" => "remove-unused-var",      "pri" => 223,  "first_pass_pri" => 53, },
    { "name" => "pass_clang",    "arg" => "simplify-if",            "pri" => 224,  },
    { "name" => "pass_clang",    "arg" => "reduce-array-dim",       "pri" => 225,  },
    { "name" => "pass_clang",    "arg" => "reduce-array-size",      "pri" => 226,  },
    { "name" => "pass_clang",    "arg" => "move-function-body",     "pri" => 227,  },
    { "name" => "pass_clang",    "arg" => "simplify-comma-expr",    "pri" => 228,  },
    { "name" => "pass_clang",    "arg" => "simplify-dependent-typedef",   "pri" => 229,  },
    { "name" => "pass_clang",    "arg" => "replace-simple-typedef", "pri" => 230,  },
    { "name" => "pass_clang",    "arg" => "replace-dependent-typedef",     "pri" => 231,  },
    { "name" => "pass_clang",    "arg" => "replace-one-level-typedef-type",     "pri" => 232,  },
    { "name" => "pass_clang",    "arg" => "remove-unused-field",    "pri" => 233,  },
    { "name" => "pass_clang",    "arg" => "instantiate-template-type-param-to-int",  "pri" => 234,  },
    { "name" => "pass_clang",    "arg" => "instantiate-template-param",    "pri" => 235,  },
    { "name" => "pass_clang",    "arg" => "template-arg-to-int",    "pri" => 236,  },
    { "name" => "pass_clang",    "arg" => "template-non-type-arg-to-int", "pri" => 237,  },
    { "name" => "pass_clang",    "arg" => "reduce-class-template-param",  "pri" => 238,  },
    { "name" => "pass_clang",    "arg" => "remove-trivial-base-template", "pri" => 239,  },
    { "name" => "pass_clang",    "arg" => "class-template-to-class",      "pri" => 240,  },
    { "name" => "pass_clang",    "arg" => "remove-base-class",      "pri" => 241,  },
    { "name" => "pass_clang",    "arg" => "replace-derived-class",  "pri" => 242,  },
    { "name" => "pass_clang",    "arg" => "remove-unresolved-base", "pri" => 243,  },
    { "name" => "pass_clang",    "arg" => "remove-ctor-initializer","pri" => 244,  },
    { "name" => "pass_clang",    "arg" => "replace-class-with-base-template-spec","pri" => 245,  },
    { "name" => "pass_clang",    "arg" => "simplify-nested-class",  "pri" => 246,  },
    { "name" => "pass_clang",    "arg" => "remove-unused-outer-class",    "pri" => 247,  },
    { "name" => "pass_clang",    "arg" => "empty-struct-to-int",    "pri" => 248,  },
    { "name" => "pass_clang",    "arg" => "remove-pointer",         "pri" => 249,  },
    { "name" => "pass_clang",    "arg" => "remove-pointer-pairs",   "pri" => 250,  },
    { "name" => "pass_clang",    "arg" => "remove-array",           "pri" => 251,  },
    { "name" => "pass_clang",    "arg" => "remove-addr-taken",      "pri" => 252,  },
    { "name" => "pass_clang",    "arg" => "simplify-struct",        "pri" => 253,  },
    { "name" => "pass_clang",    "arg" => "replace-undefined-function",   "pri" => 254,  },
    { "name" => "pass_clang",    "arg" => "replace-array-index-var",      "pri" => 255,  },
    { "name" => "pass_clang",    "arg" => "replace-dependent-name", "pri" => 256,  },
    { "name" => "pass_clang",    "arg" => "simplify-recursive-template-instantiation",       "pri" => 257, },
    { "name" => "pass_clang",    "arg" => "combine-global-var",                    "last_pass_pri" => 990, },
    { "name" => "pass_clang",    "arg" => "combine-local-var",                     "last_pass_pri" => 991, },
    { "name" => "pass_clang",    "arg" => "simplify-struct-union-decl",            "last_pass_pri" => 992, },
    { "name" => "pass_clang",    "arg" => "move-global-var",                       "last_pass_pri" => 993, },
    { "name" => "pass_clang",    "arg" => "unify-function-decl",                   "last_pass_pri" => 994, },
    { "name" => "pass_peep",     "arg" => "a",                      "pri" => 500,  },
    { "name" => "pass_ints",     "arg" => "a",                      "pri" => 600,  },
    { "name" => "pass_ints",     "arg" => "b",                      "pri" => 601,  },
    { "name" => "pass_ints",     "arg" => "c",                      "pri" => 602,  },
    { "name" => "pass_ints",     "arg" => "d",                      "pri" => 603,  },
    { "name" => "pass_ints",     "arg" => "e",                      "pri" => 603,  },
    { "name" => "pass_indent",   "arg" => "regular",                "pri" => 1000, },
    { "name" => "pass_clex",     "arg" => "delete-string",                         "last_pass_pri" => 1001, },
    { "name" => "pass_indent",   "arg" => "final",                                 "last_pass_pri" => 9999, },
    { "name" => "pass_clex", "arg" => "rm-toks-1",              "pri" => 9031, },
    { "name" => "pass_clex", "arg" => "rm-toks-2",              "pri" => 9030, },
    { "name" => "pass_clex", "arg" => "rm-toks-3",              "pri" => 9029, },
    { "name" => "pass_clex", "arg" => "rm-toks-4",              "pri" => 9028, },
    { "name" => "pass_clex", "arg" => "rm-toks-5",              "pri" => 9027, },
    { "name" => "pass_clex", "arg" => "rm-toks-6",              "pri" => 9026, },
    { "name" => "pass_clex", "arg" => "rm-toks-7",              "pri" => 9025, },
    { "name" => "pass_clex", "arg" => "rm-toks-8",              "pri" => 9024, },
    { "name" => "pass_clex", "arg" => "rm-toks-9",              "pri" => 9023, },
    { "name" => "pass_clex", "arg" => "rm-toks-10",             "pri" => 9022, },
    { "name" => "pass_clex", "arg" => "rm-toks-11",             "pri" => 9021, },
    { "name" => "pass_clex", "arg" => "rm-toks-12",             "pri" => 9020, },
    { "name" => "pass_clex", "arg" => "rm-toks-13",             "pri" => 9019, },
    { "name" => "pass_clex", "arg" => "rm-toks-14",             "pri" => 9018, },
    { "name" => "pass_clex", "arg" => "rm-toks-15",             "pri" => 9017, },
    { "name" => "pass_clex", "arg" => "rm-toks-16",             "pri" => 9016, },
    );

if ($SANITIZE) {
    push @all_methods, (
	{ "name" => "pass_clex", "arg" => "rename-toks",            "last_pass_pri" => 1000, },
        { "name" => "pass_clex", "arg" => "delete-string",          "pri" => 1001, },
        { "name" => "pass_clex", "arg" => "remove-asm-line",        "pri" => 1002, },
        { "name" => "pass_clex", "arg" => "remove-asm-comment",     "pri" => 1003, },
        { "name" => "pass_clex", "arg" => "shorten-string",         "pri" => 1010, },
        { "name" => "pass_clex", "arg" => "x-string",               "pri" => 1011, },
	# not helpful
	# { "name" => "pass_clex", "arg" => "collapse-toks",          "pri" => 5000, },
    );
}

if ($SLLOOWW) {
    push @all_methods, (
	{ "name" => "pass_clex", "arg" => "rm-tok-pattern-8",       "pri" => 9100, },
	{ "name" => "pass_clex", "arg" => "rm-toks-17",             "pri" => 9015, },
	{ "name" => "pass_clex", "arg" => "rm-toks-18",             "pri" => 9014, },
	{ "name" => "pass_clex", "arg" => "rm-toks-19",             "pri" => 9013, },
	{ "name" => "pass_clex", "arg" => "rm-toks-20",             "pri" => 9012, },
	{ "name" => "pass_clex", "arg" => "rm-toks-21",             "pri" => 9011, },
	{ "name" => "pass_clex", "arg" => "rm-toks-22",             "pri" => 9010, },
	{ "name" => "pass_clex", "arg" => "rm-toks-23",             "pri" => 9009, },
	{ "name" => "pass_clex", "arg" => "rm-toks-24",             "pri" => 9008, },
	{ "name" => "pass_clex", "arg" => "rm-toks-25",             "pri" => 9007, },
	{ "name" => "pass_clex", "arg" => "rm-toks-26",             "pri" => 9006, },
	{ "name" => "pass_clex", "arg" => "rm-toks-27",             "pri" => 9005, },
	{ "name" => "pass_clex", "arg" => "rm-toks-28",             "pri" => 9004, },
	{ "name" => "pass_clex", "arg" => "rm-toks-29",             "pri" => 9003, },
	{ "name" => "pass_clex", "arg" => "rm-toks-30",             "pri" => 9002, },
	{ "name" => "pass_clex", "arg" => "rm-toks-31",             "pri" => 9001, },
	{ "name" => "pass_clex", "arg" => "rm-toks-32",             "pri" => 9000, },
        { "name" => "pass_peep", "arg" => "b",                      "pri" => 9500,  },
    );
} else {
    push @all_methods, (
	{ "name" => "pass_clex", "arg" => "rm-tok-pattern-4",       "pri" => 9100, },
    );
}

if ($NODEFAULT) {
    if (scalar(@custom_methods) < 1) {
	print <<EOT;

Since you asked for no default passes and added no extra passes
explicitly, C-Reduce doesn't have anything to do. Exiting.

EOT
       exit(1);
    }
    @all_methods = ();
}

foreach my $r (@custom_methods) {
    push @all_methods, $r;
}

my $which;

sub bypri {
    my %aa = %{$a};
    my %bb = %{$b};
    return $aa{$which} <=> $bb{$which};
}

sub pass_iterator ($) {
    ($which) = @_;
    my @l = ();
    foreach my $href (@all_methods) {
	my %pass = %{$href};
	if (defined $pass{$which}) {
	    push @l, $href;
	}
    }
    my @sorted_list = sort bypri @l;
    return sub {
	return (shift @sorted_list);
    }
}

my %file_attr_to_error = (
    e => "not found",
    f => "is not a plain file",
    r => "is not readable",
    w => "is not writable",
    x => "is not executable",
);

sub check_file_attributes($$$) {
    my ($prefix, $file, $attrs) = @_;
    for my $attr (split //, $attrs) {
        if (eval '! -' . $attr . ' $file') {
            print "$prefix '$file' $file_attr_to_error{$attr}\n";
            usage();
        }
    }
}

############################### main #################################

# no buffering
$| = 1;

my @normal_signals = qw(TERM INT HUP PIPE);
use sigtrap 'handler', \&sigHandler, 'normal-signals';

my $root_process_pid = $$;

sub sigHandler {
    my ($sigName) = @_;
    exit(1) unless ($$ == $root_process_pid);
    killem();
    chdir $orig_dir;
    remove_tmpdirs();
    die "$sigName caught, terminating $$\n";
}

my %prereqs_checked;
foreach my $mref (@all_methods) {
    my %method = %{$mref};
    my $mname = $method{"name"};
    die unless defined ($mname);
    next if defined ($prereqs_checked{$mname});
    # FIXME supposedly we can just require $mname; (without the eval)
    # here but that doesn't work...
    eval "require $mname";
    die $@ if $@;
    call_prereq_check($mname);
    $prereqs_checked{$mname} = 1;
}
print "\n" if $DEBUG;

$test = File::Spec->rel2abs(shift @ARGV);
usage() unless defined($test);
check_file_attributes("test script", $test, "efrx");

while (@ARGV) {
    my $f = File::Spec->rel2abs(shift @ARGV);
    push @toreduce, $f;
    check_file_attributes("file", $f, "efrw");
}

sub bysize {
    return (-s $b) <=> (-s $a);
}

sub byrsize {
    return (-s $a) <=> (-s $b);
}

foreach my $f (@toreduce) {
    my $s = -s $f;
    (my $fo) = fileparse($f);
    $fileonly{$f} = $fo;
    # optionally, make a backup of the file(s) we're reducing-- this
    # is useful when reductions go wrong
    if (!$TIDY && (! -e "${fo}.orig")) {
	File::Copy::copy($f,"${fo}.orig") or die;
    }
    $orig_total_file_size += -s $f;
    $total_file_size += -s $f;
}

$orig_dir = getcwd();

# no point proceeding if the test doesn't start out interesting
sanity_check();

print "===< $$ >===\n";
printf "running $NPROCS interestingness test%s in parallel\n",
    $NPROCS == 1 ? "" : "s";

# some passes we run first since they often make good headway quickliy
if (not $SKIP_FIRST) {
    print "INITIAL PASSES\n" if $DEBUG;
    my $next = pass_iterator("first_pass_pri");
    while (my $item = $next->()) {
        delta_pass ($item);
    }
}

# iterate to global fixpoint
print "MAIN PASSES\n" if $DEBUG;

while (1) {
    my $next = pass_iterator("pri");
    while (my $item = $next->()) {
	delta_pass ($item);
    }
    $pass_num++;
    my $s = 0;
    foreach my $f (@toreduce) {
	$s += -s $f;
    }
    print "Termination check: size was $total_file_size; now $s\n";
    last if ($s >= $total_file_size);
    $total_file_size = $s;
}

# some passes we run last since they work best as cleanup
print "CLEANUP PASS\n" if $DEBUG;
{
    my $next = pass_iterator("last_pass_pri");
    while (my $item = $next->()) {
	delta_pass ($item);
    }
}

print "===================== done ====================\n";

sub byworked {
    my $na = ${$a}{"name"};
    my $aa = ${$a}{"arg"};
    my $wa = $method_worked{$na}{$aa};
    $wa = 0 unless defined($wa);
    my $nb = ${$b}{"name"};
    my $ab = ${$b}{"arg"};
    my $wb = $method_worked{$nb}{$ab};
    $wb = 0 unless defined($wb);
    if ($wa == $wb) {
	if ($na eq $nb) {
	    return $aa cmp $ab;
	} else {
	    return $na cmp $nb;
	}
    } else {
	return $wa <=> $wb;
    }
}

print "\n";
print "pass statistics:\n";
foreach my $mref (sort byworked @all_methods) {
    my $method = ${$mref}{"name"};
    my $arg = ${$mref}{"arg"};
    my $w = $method_worked{$method}{$arg};
    $w = 0 unless defined($w);
    my $f = $method_failed{$method}{$arg};
    $f = 0 unless defined($f);
    print "  method $method :: $arg worked $w times and failed $f times\n";
}

foreach my $fn (sort byrsize @toreduce) {
    print "\n          ******** $fn ********\n\n";
    open INF, "<$fn" or die;
    while (<INF>) {
	print;
    }
    close INF;
}

######################################################################
