verify.sh

#!/usr/bin/perl -w
################################################################################
#
# Test harness.
#
################################################################################

use threads;
use threads::shared;
use Thread::Semaphore;

# Shut off buffering.
select(STDOUT);
$| = 1;

#
# Parse command-line arguments.
#
use Getopt::Long;
Getopt::Long::config("bundling"); # Allow -hv rather than forcing -h -v.

# Set option defaults for optional arguments.
$opt_help = 0;
$opt_verbose = 0;
$opt_quiet = 0;
$opt_srcdir = ".";
$opt_objdir = ".";
$opt_command = '%1$s/%3$s';
$opt_ustats = 0;
$opt_zero = 0;
$opt_server = 0;
$opt_port = 8080;
$opt_home = ".";
$opt_threads = `cat /proc/cpuinfo | grep '^processor' | wc -l`;
if ($opt_threads > 20) {
    $opt_threads = 20;
}
$opt_reduce = "";
$opt_coverage = "";
$opt_hhvm = "hhvm";
$opt_cpu_time_limit = 0;
$opt_real_time_limit = 0;
$opt_no_exp = 0;

$opt_retval =
&GetOptions("h|help" => \$opt_help,
            "v|verbose" => \$opt_verbose,
            "q|quiet" => \$opt_quiet,
            "s|srcdir=s" => \$opt_srcdir,
            "o|objdir=s" => \$opt_objdir,
            "u|ustats" => \$opt_ustats,
            "c|command=s" => \$opt_command,
            "z|zero" => \$opt_zero,
            "server" => \$opt_server,
            "port:i" => \$opt_port,
            "home:s" => \$opt_home,
            "threads=i" => \$opt_threads,
            "r|reduce=s" => \$opt_reduce,
            "coverage=s" => \$opt_coverage,
            "no-exp" => \$opt_no_exp,
            "hhvm=s" => \$opt_hhvm,
            "cpu-time-limit=i" => \$opt_cpu_time_limit,
            "real-time-limit=i" => \$opt_real_time_limit,
            );

# Munge directory paths if necessary.
if (defined($opt_srcdir) && $opt_srcdir eq "")
{
    $opt_srcdir = ".";
}
if (defined($opt_objdir) && $opt_objdir eq "")
{
    $opt_objdir = ".";
}

if ($opt_help)
{
    &usage();
    exit(0);
}

if ($opt_retval == 0)
{
    &usage();
    exit 1;
}

if ($opt_verbose && $opt_quiet)
{
    print STDERR "-v and -q are incompatible\n";
    &usage();
    exit 1;
}

if ($#ARGV + 1 == 0)
{
    print STDERR "No tests specified\n";
    &usage();
    exit 1;
}

if ($opt_verbose)
{
    print STDERR "Option values: h:$opt_help, v:$opt_verbose, "
        . "s:\"$opt_srcdir\", o:\"$opt_objdir\" "
        . "q:$opt_quiet, u:$opt_ustats, z:$opt_zero\n";
    printf STDERR "Tests (%d total): @ARGV\n", $#ARGV + 1;
}

if ($opt_server)
{
  $command = sprintf ($opt_command, $opt_home, $opt_port);
  $server_pid = fork();
  if ($server_pid == 0)
  {
    `sudo $command 2>&1 > /dev/null`;
  }
  else
  {
    # wait for server to warm up
    `sleep 5`;
  }
}

if (!$opt_threads) {
    $opt_threads = 1;
}

#
# Create and print header.
#
@TSTATS =
(
 "--------------------------------------------------------------------------\n",
 "Test                                      c_user c_system c_total     chng\n",
 " passed/FAILED                            h_user h_system h_total   %% chng\n"
 );

if (!$opt_quiet)
{
    foreach $line (@TSTATS)
    {
        printf STDOUT "$line";
    }
}

#
# Run sequence test(s).
#
$total_utime = 0.0; # Total user time.
$total_stime = 0.0; # Total system time.
$total_hutime = 0.0; # Total historical user time.
$total_hstime = 0.0; # Total historical system time.
$total_ntime = 0.0; # Total time for tests that have historical data.

@test_buckets = ();
%tests_okay = ();
%tests_num_failed_subtests = ();
%tests_num_subtests = ();
%tests_utime = ();
%tests_stime = ();
# Extra debugging info generated by reduce or coverage.
# We store them in tests_extra_dbg instead of directly printing them out is
# that the output might be interleaved when the tests are run concurrently.
%tests_extra_dbg = ();
share(%tests_okay);
share(%tests_num_failed_subtests);
share(%tests_num_subtests);
share(%tests_utime);
share(%tests_stime);
share(%tests_extra_dbg);
# Try to construct the buckets so the test results are ready in approximately
# alphabetical order
for ($i = 0; $i < $opt_threads; $i++)
{
    push @test_buckets, [];
}
$i = 0;
foreach $test (@ARGV)
{
    push @{$test_buckets[$i]}, $test;
    $i = ($i + 1) % $opt_threads;
}

# Spawn off worker threads
for ($i = 0; $i < $opt_threads; $i++)
{
    threads->create(\&run_tests, $test_buckets[$i]);
}

foreach $test (@ARGV)
{
    # Strip out any whitespace in $test.
    $test =~ s/^\s*(.*)\s*$/$1/;

    $okay = 1;

    my (@TSTATS);
    my ($t_str);
    @TSTATS = ("--------------------------------------------------------------------------\n");

    $t_str = sprintf ("%s%s", $test, ' ' x (40 - length($test)));
    @TSTATS = (@TSTATS, $t_str);
    if (!$opt_quiet)
    {
        foreach $line (@TSTATS)
        {
            printf STDOUT "$line";
        }
    }

    ($okay, $num_failed_subtests, $num_subtests, $utime, $stime) = wait_for_test($test);
    #  num_failed_subtests and num_subtests will be zero in the diff mode.
    ($hutime, $hstime) = &print_stats($test, $okay, $num_failed_subtests, $num_subtests, $utime, $stime);
    {
        lock(%tests_okay);
        print $tests_extra_dbg{$test};
    }

    # Print coverage on success, or run reduce on failure.

    $total_hutime += $hutime;
    $total_hstime += $hstime;

    if ($okay)
    {
        $total_utime += $utime;
        $total_stime += $stime;
    }
    else
    {
        @FAILED_TESTS = (@FAILED_TESTS, $test);
    }

    # If there were historical data, add the run time to the total time to
    # compare against the historical run time.
    if (0 < ($hutime + $hstime))
    {
        $total_ntime += $utime + $stime;
    }
}

# Print summary stats.
$tt_str = sprintf ("%d / %d passed (%5.2f%%%%)",
                   ($#ARGV + 1) - ($#FAILED_TESTS + 1),
                   $#ARGV + 1,
                   (($#ARGV + 1) - ($#FAILED_TESTS + 1))
                   / ($#ARGV + 1) * 100);

$t_str = sprintf ("Totals                                   %7.2f  %7.2f %7.2f"
                  . "  %7.2f\n"
                  . " %s %7.2f  %7.2f %7.2f %7.2f%%%%\n",
                  $total_utime, $total_stime, $total_utime + $total_stime,
                  ($total_ntime - ($total_hutime + $total_hstime)),
                  $tt_str . ' ' x (40 - length($tt_str)),
                  $total_hutime, $total_hstime, $total_hutime + $total_hstime,
                  ($total_hutime + $total_hstime == 0.0) ? 0.0 :
                  (($total_ntime
                    - ($total_hutime + $total_hstime))
                   / ($total_hutime + $total_hstime) * 100));

$thread_warning = "";
if ($opt_threads > 1) {
    $thread_warning = "WARNING: Multiple threads were used. CPU times "
        . "are wildly inaccurate\n"
}

@TSTATS = ("--------------------------------------------------------------------------\n",
           $thread_warning,
           $t_str,
           "--------------------------------------------------------------------------\n"
           );
if (!$opt_quiet)
{
    foreach $line (@TSTATS)
    {
        printf STDOUT "$line";
    }
    if (@FAILED_TESTS) {
        printf STDOUT "failed tests:\n";
    }
    foreach $fail (@FAILED_TESTS)
    {
        printf STDOUT "%50s\n", $fail;
    }
}


if ($opt_server)
{
  kill 9, $server_pid;
  `ps aux | grep hphpi | grep -v perl | cut -c10-15 | sudo xargs kill -9 \\
     2>&1 >/dev/null`
}

if ($#FAILED_TESTS >= 0)
{
    # One or more tests failed, so return an error.
    exit 1;
}
# End of main execution.

sub run_tests
{
    foreach my $test (@{$_[0]})
    {
        my ($okay, $num_failed_subtests, $num_subtests, $utime, $stime, $extra_dbg) = run_test($test);
        {
            lock(%tests_okay);
            $tests_okay{$test} = $okay;
            $tests_num_failed_subtests{$test} = $num_failed_subtests;
            $tests_num_subtests{$test} = $num_subtests;
            $tests_utime{$test} = $utime;
            $tests_stime{$test} = $stime;
            $tests_extra_dbg{$test} = $extra_dbg;
            cond_signal(%tests_okay);
        }
    }
}

sub wait_for_test
{
    my ($test) = @_;
    while (1)
    {
        lock(%tests_okay);
        if (exists $tests_okay{$test}) {
            return ($tests_okay{$test},
                    $tests_num_failed_subtests{$test},
                    $tests_num_subtests{$test},
                    $tests_utime{$test},
                    $tests_stime{$test},
                    $tests_extra_dbg{$test});
        }
        cond_wait(%tests_okay);
    }
}

sub run_test
{
    my ($test) = @_;
    my ($okay) = 1;
    my ($num_failed_subtests) = 0;
    my ($num_subtests) = 0;
    my ($tutime, $tstime);
    my ($extra_dbg) = "";
    my ($utime, $stime, $cutime, $cstime);

    if ($opt_server)
    {
        $command = "GET http://localhost:" . $opt_port . "/" . $test;
    }
    else
    {
        $command = sprintf ($opt_command, $opt_srcdir, $opt_objdir, $test);
        if ($opt_cpu_time_limit)
        {
            $command = "(ulimit -t " . $opt_cpu_time_limit . "; "
                       . "timeout " . $opt_real_time_limit . " "
                       . $command . ")";
        }
    }
    ($utime, $stime, $cutime, $cstime) = times;
    my $default_filter = "$opt_srcdir/test/vm/default.filter";
    if (-e "$opt_srcdir/$test.filter") {
        `$command 2>&1 | $default_filter | $opt_srcdir/$test.filter > $opt_objdir/$test.out`;
    } else {
        `$command 2>&1 | $default_filter > $opt_objdir/$test.out`;
    }
    ($utime, $stime, $tutime, $tstime) = times;

    # Subtract the before time from the after time.
    $tutime -= $cutime;
    $tstime -= $cstime;

    if ($opt_zero)
    {
        if ($?)
        {
            $okay = 0;
            if ($opt_verbose)
            {
                print STDERR
                    "\"$opt_objdir/$test > $opt_objdir/$test.out 2>&1\" returned $?\n";
            }
        }
    }

    # Compare the results with the expected, and update "okay".
    if (!$opt_no_exp && -e "$opt_srcdir/$test.exp")
    {
        # Diff mode.
        if (-e "$opt_objdir/$test.out")
        {
            $diff_args = "--text -u";
            if ($opt_server)
            {
              `diff $diff_args -I HipHop $opt_srcdir/$test.exp $opt_objdir/$test.out \\
                 > $opt_objdir/$test.diff 2>&1`;
            }
            else
            {
              `diff $diff_args $opt_srcdir/$test.exp $opt_objdir/$test.out > $opt_objdir/$test.diff 2>&1`;
            }
            if ($?)
            {
                # diff returns non-zero if there is a difference.
                $okay = 0;
            }
        }
        else
        {
            $okay = 0;
            if ($opt_verbose)
            {
                print STDERR
                    "Nonexistent output file \"$opt_objdir/$test.out\"\n";
            }
        }
    }
    else
    {
        # Sequence mode.
        if (open (STEST_OUT, "<$opt_objdir/$test.out"))
        {
            $num_subtests = 0;
            $num_failed_subtests = 0;

            while (defined($line = <STEST_OUT>))
            {
                if ($line =~ /1\.\.(\d+)/)
                {
                    $num_subtests = $1;
                    last;
                }
            }
            if ($num_subtests == 0)
            {
                $okay = 0;
                if ($opt_verbose)
                {
                    print STDERR "Malformed or missing 1..n line\n";
                }
            }
            else
            {
                for ($subtest = 1; $subtest <= $num_subtests; $subtest++)
                {
                    while (defined($line = <STEST_OUT>))
                    {
                        if ($line =~ /^not\s+ok\s+(\d+)?/)
                        {
                            $not = 1;
                            $test_num = $1;
                            last;
                        }
                        elsif ($line =~ /^ok\s+(\d+)?/)
                        {
                            $not = 0;
                            $test_num = $1;
                            last;
                        }
                    }
                    if (defined($line))
                    {
                        if (defined($test_num) && ($test_num != $subtest))
                        {
                            # There was no output printed for one or more tests.
                            for (; $subtest < $test_num; $subtest++)
                            {
                                $num_failed_subtests++;
                            }
                        }
                        if ($not)
                        {
                            $num_failed_subtests++;
                        }
                    }
                    else
                    {
                        for (; $subtest <= $num_subtests; $subtest++)
                        {
                            $num_failed_subtests++;
                        }
                    }
                }

                if (0 < $num_failed_subtests)
                {
                    $okay = 0;
                }
            }
        }
        else
        {
            if (!$opt_quiet)
            {
                print STDERR "Cannot open output file \"$opt_objdir/$test.out\"\n";
            }
            exit 1;
        }
    }

    if ($okay == 0)
    {
        # Run reduce to pinpoint the tracelet that causes the error.
        # For now, reduce has to be run sequentially, because it copies the input
        # file to the same temporary place.
        if ($opt_reduce ne "")
        {
            $cmd = $opt_reduce . " '" .  $opt_hhvm . "' " . $test;
            if ($opt_cpu_time_limit)
            {
                $cmd = join(" ",
                            $cmd,
                            $opt_cpu_time_limit,
                            $opt_real_time_limit);
            }
            $extra_dbg = `$cmd 2> /dev/null`;
        }
    }
    else
    {
        # Print the coverage.
        # Need run the command again in the tracing mode.
        if ($opt_coverage ne "")
        {
            $command = sprintf($opt_command, $opt_srcdir, $opt_objdir, $test);
            # Need calculate # of spills, reloads, and pushes/pops
            # around natives which are logged in level 3.
            $command = join("", "TRACE=tx64:3 ",
                            "HPHP_TRACE_FILE=", $test, ".log ",
                            $command);
            `$command 2> /dev/null`;
            $extra_dbg = `$opt_coverage < $test.log 2> /dev/null`;
        }
    }

    return ($okay, $num_failed_subtests, $num_subtests, $tutime,
            $tstime, $extra_dbg);
}

sub print_stats
{
    my ($test, $okay, $failed_subtests, $subtests, $utime, $stime) = @_;
    my ($hutime, $hstime);
#    my (TEST_PERF);
    my (@TSTATS);
    my ($t_str, $pass_str);

    $pass_str = $okay ? "passed" : "*** FAILED ***";
    if ((0 != $subtests) && (!$okay))
    {
        $pass_str = $pass_str . " ($failed_subtests/$subtests failed)";
    }
    $pass_str = $pass_str . ' ' x (39 - length($pass_str));

    if (-r "$test.perf")
    {
        if (!open (TEST_PERF, "<$opt_objdir/$test.perf"))
        {
            print STDERR "Unable to open \"$opt_objdir/$test.perf\"\n";
            exit 1;
        }
        $_ = <TEST_PERF>;

        ($hutime, $hstime) = split;
        close TEST_PERF;

        $t_str = sprintf (" %7.2f  %7.2f %7.2f  %7.2f\n"
                          . " %s %7.2f  %7.2f %7.2f %7.2f%%%%\n",
                          $utime, $stime, $utime + $stime,
                          ($utime + $stime) - ($hutime + $hstime),
                          $pass_str,
                          $hutime, $hstime, $hutime + $hstime,
                          (($hutime + $hstime) == 0.0) ? 0.0 :
                          ((($utime + $stime) - ($hutime + $hstime))
                           / ($hutime + $hstime) * 100));
    }
    else
    {
        $hutime = 0.0;
        $hstime = 0.0;

        $t_str = sprintf (" %7.2f  %7.2f %7.2f        \n"
                          . " %s\n",
                          $utime, $stime, $utime + $stime,
                          $pass_str);
    }
    @TSTATS = ($t_str);
    if (!$opt_quiet)
    {
        foreach $line (@TSTATS)
        {
            printf STDOUT "$line";
        }
    }

    if ($okay && $opt_ustats)
    {
        if (!open (TEST_PERF, ">$opt_objdir/$test.perf"))
        {
            if (!$opt_quiet)
            {
                print STDERR "Unable to update \"$opt_objdir/$test.perf\"\n";
            }
        }
        else
        {
            print TEST_PERF "$utime $stime\n";
            close TEST_PERF;
        }
    }

    return ($hutime, $hstime);
}

sub usage
{
    print <<EOF;
$0 usage:
    $0 [<options>] <test>+

    Option        | Description
    --------------+-------------------------------------------------------------
    -h --help     | Print usage and exit.
    -v --verbose  | Verbose (incompatible with quiet).
    -q --quiet    | Quiet (incompatible with verbose).
    -s --srcdir   | Path to source tree (default is ".").
    -o --objdir   | Path to object tree (default is ".").
    -c --command  | Command template, where the following substitutions are
                  | performed:
                  |   %1\$s : srcdir (see --srcdir)
                  |   %2\$s : objdir (see --objdir)
                  |   %3\$s : <test>
                  | (default is '%1\$s/%3\$s').
    -r --reduce   | The path to the reduce tool.
                  | Do not run reduce if it is empty.
                  | (default is empty)
    --coverage    | The path to the coverage tool.
                  | Do not run coverage if it is empty.
                  | (default is empty)
    -t            | Set the time limit for each test case
                  | (default is unlimited).
    -u --ustats   | Update historical statistics (stored in "<test>.perf".
    -z --zero     | Consider non-zero exit code to be an error.
       --no-exp   | Don't diff with .exp files
    --------------+-------------------------------------------------------------

    If <test>.exp exists and --no-exp is not specified, <test>'s output is
    diff'ed with <test>.exp.  Any difference is considered failure.

    If <test>.exp does not exist or --no-exp is specified, output to stdout of
    the following form is expected:

        1..<n>
        {not }ok[ 1]
        {not }ok[ 2]
        ...
        {not }ok[ n]

    1 <= <n> < 2^31

    Lines which do not match the patterns shown above are ignored.
EOF
}
# vim:filetype=perl: