#!/usr/bin/perl -l
# $Id: test.pl,v 1.22 2004/09/08 02:25:59 trammell Exp $
# vim: set ai expandtab ts=4 :

use strict;
use warnings;
use Data::Dumper;
use File::Basename 'basename';
use Getopt::Long;
use Test::More;
use Time::HiRes qw/gettimeofday tv_interval/;

sub usage {
    die <<USAGE;
@_
  usage: $0 correct [-n N] script ...
         $0 time [-n N] [-r|--reps=count] script ...
         $0 memory [-n N] script ...
USAGE
}


# read command-line options
our $MAX_N = 12;
our $REPS = 3;
GetOptions("n=i" => \$MAX_N, "r|reps=i" => \$REPS) or usage();


# generate cache of Catalan numbers
my %cat = map { $_, catalan($_) } 0 .. $MAX_N;


# run test(s) based on command-line options
my $option = shift;
my %map = (
    correct => \&test_correct,
    'time' => \&test_time,
    memory => \&test_memory,
);
usage() unless $option && exists $map{ $option };
$map{ $option }->($_) for @ARGV;


# routine to test correctness of output
sub test_correct {
    my $script = shift;
    my $incorrect = 0;
    warn "# ===== testing script $script, 0 .. $MAX_N =====\n";
    foreach my $i ( 0 .. $MAX_N ) {
        my @lines = `perl $script $i`;
        for (@lines) { y/()//cd; }
        unless (@lines == $cat{$i}) {
            warn "#! $script, n=$i: got @{[ scalar @lines ]} lines, should be $cat{$i}\n" if $incorrect < 20;
            ++$incorrect;
        }
        if (my $d = dupes_exist(@lines)) {
            warn "#! $script, n=$i: found duplicate: '$d'\n" if $incorrect < 20;
            ++$incorrect;
        }
        unless (lines_are_sorted(@lines)) {
            warn "#! $script, n=$i: output isn't in lexicographic order\n" if $incorrect < 20;
            ++$incorrect;
        }
        for (@lines) {
            next if line_is_balanced($_);
            warn "#! $script, n=$i: got unbalanced line: '$_'\n" if $incorrect < 20;
            ++$incorrect;
        }
    }
    if ($incorrect) {
        warn "# script $script had $incorrect problems.\n";
    }
    else {
        warn "# script $script generated the correct output.\n";
    }
}


# routine to generate timing data
sub test_time {
    my $script = shift;

    warn "# testing script $script\n";

# step 1: time the creation code; save data for verification

	my $teststarttime = [gettimeofday];
    my @timing;

    foreach my $i ( 0 .. $MAX_N ) {
        for (1 .. $REPS) {
            my $repstarttime = [gettimeofday];
            my $foo = `perl $script $i > /dev/null`;
            push @{$timing[$i]}, tv_interval($repstarttime);
        }
    }

	my $totalelapsed = tv_interval($teststarttime);

# report timing to STDOUT in CSV format

    $script = basename $script;
    foreach my $i ( 0 .. $MAX_N ) {
        my $avg = sprintf "%.6f", average(@{$timing[$i]});
        print "$script, $i, $avg";
    }
    print "$script, total, $totalelapsed";
}


sub test_memory {
    my $script = shift;
    warn "# calculatng maximum memory for script $script\n";

# step 1: time the creation code; save data for verification

    my @mem;
    foreach my $i ( 0 .. $MAX_N ) {
        my $foo = `time - perl $script $i > /dev/null`;
        $mem[$i] = 'foo';
    }

# report memory usage to STDOUT in CSV format

    $script = basename $script;
    foreach my $i ( 0 .. $MAX_N ) {
        print "$script, $i, $mem[$i]";
    }
}


sub line_is_balanced {
    (my $x = $_[0]) =~ y/()//cd;
    1 while $x =~ s/\(\)//;
    return length($x) == 0;
}


# thanks to Daniel Martin for the binom() and catalan() subs
sub binom {
    my ($n, $k) = @_;
    if ($n < 1 or $k < 1 or $k >= $n) { return 1; }
    binom($n-1,$k-1) * $n / $k;
}

sub catalan {
    binom(2*$_[0], $_[0]) / ($_[0]+1);
}

sub dupes_exist { 
    my %seen;
    for (@_) {
        return $_ if $seen{ $_ }++;
    }
    return 0;
}

sub lines_are_sorted {
    my @lines = @_;
    my @sorted = sort @lines;
    return Test::More::eq_array(\@lines, \@sorted); 
}

sub average {
    return unless @_;
    my $sum;
    $sum += $_ for @_;
    return $sum / @_;
}