use strict;
use Test;
use Carp;
use Crypt::PBC;

if( defined $ENV{SKIP_ALL_BUT} ) { unless( $0 =~ m/\Q$ENV{SKIP_ALL_BUT}\E/ ) { plan tests => 1; skip(1); exit 0; } }

my $curve = new Crypt::PBC("params_d.txt");
my @e = ( $curve->init_G1, $curve->init_G2, $curve->init_GT, $curve->init_Zr, 1, new Math::BigInt(19) );
my @i = ( 0 .. $#e ); # the indicies for permute()

if( -f "slamtest.log" ) {
    unlink "slamtest.log" or die "couldn't remove old logfile: $!";
}

my %slam_these = (
    pairing_apply => 2,

    random => 1, # technically these should be 0, but this test is not set up for no-args
    square => 1,
    double => 1,
    halve  => 1,
    neg    => 1,
    invert => 1,

    add => 2,
    Sub => 2,
    mul => 2,
    div => 2,

    mul_zn     => 2,
    mul_int    => 2,
    mul_bigint => 2,

    pow_zn  => 2,
    pow2_zn => 4,
    pow3_zn => 6,

    pow_bigint  => 2,
    pow2_bigint => 4,
    pow3_bigint => 6,

    is0    => 1,
    is1    => 1,
    is_eq  => 1,
    is_sqr => 1,

    set0   => 1,
    set1   => 1,

    set_to_hash   => 1,
    set_to_bytes  => 1,
    set_to_int    => 1,
    set_to_bigint => 1,
    set           => 1,
);

#### This test may need some explaining... We wish to pass all
#### possible all the wrong things and make sure we catch all the
#### potential sagfaults with perl croak() errors.

plan tests => int keys %slam_these;

my %huge_cache = ();

my $start_time = time;
my $total_per  = 0;
my $last_time  = 0;

$ENV{MAX_PERM_TIME} = 0.05 unless defined $ENV{MAX_PERM_TIME} and $ENV{MAX_PERM_TIME} >= 0;
warn "\n\t$0 is set to truncate all tests longer than $ENV{MAX_PERM_TIME} second(s) (env MAX_PERM_TIME)\n" if $ENV{MAX_PERM_TIME} < 120;
eval 'use Time::HiRes qw(time)'; # does't matter if this fails...
warn "\t$0 gives more accurate calls/s estimates if Time::HiRes is installed...\n" if $@;

my $shh = $ENV{MAX_PERM_TIME} < 15;

for my $function (sort slam_sort keys %slam_these) {
    my @a = &permute( $slam_these{$function} => @i );

    # warn " WARN($function, " . (int @a) . ")";

    if( $total_per > 0 and (my $delta_t = time - $start_time) > 0 ) {
        my $v = "";
           $v = ($delta_t / $total_per);
        my $t = ($v >= 1 ? sprintf('%0.2f s/call', $v) : sprintf('%0.2f calls/s', 1/$v));

        my $m = int @a;
        if( my $total = ($v * $m) > $ENV{MAX_PERM_TIME} ) {
            my $mpti = int ($ENV{MAX_PERM_TIME}/$v);
               $mpti = 1 if $mpti < 1;

            @a = sort { (rand 1) <=> (rand 1) } @a;
            @a = @a[ 0 .. $mpti ];

            my $nc = int @a;

            $m = "$nc (reduced randomly from $m)";
        }
         
        unless( $shh ) {
            warn " testing $m argument permutations for $function() $t\n" if $last_time != time;
        }
        $last_time = time;
    }

    for my $a (@a) {
        my $key = "@$a";
        my $args = $huge_cache{$key};
           $args = [map { ( ref $e[$_] and $e[$_]->isa("Crypt::PBC::Element") ? $e[$_]->clone->random : $e[$_]) } @$a]
               if not defined $args;
        $huge_cache{$key} = $args;

        for my $e (@e) {
            next unless ref $e and $e->isa("Crypt::PBC::Element");

            ## DEBUG ## open OUTPUT, ">>slamtest.log" or die $!;
            ## DEBUG ## print OUTPUT "e=$e; function=$function; args=[@$args];\n";
            ## DEBUG ## close OUTPUT;

            eval '$e->random->' . $function . '(@$args)';

            # We are just looking for segmentation faults for now
            # so we ignore most $@ entirely.

            if( $@ and not $@ =~ m/(?:SCALAR ref|HASH ref|provide something|same group|int.provided.*accept|RHS|LHS|is not a bigint|must be.*(?:G1|G2|GT|Zr))/ ) {
                open OUTPUT, ">>slamtest.log" or die $!;
                warn " [logged] \$@=$@";
                print OUTPUT " function=$function; \$@=$@";
                close OUTPUT;
            }
        }
    }

    $total_per += (int @a);

    ok( 1 );
}

# _permute {{{
sub _permute {
    my $num = shift;
    my $arr = shift;
    my $src = shift;

    unshift @$_, $src->[0] for @$arr;

    my $e = $#{ $arr };
    for my $i (1 .. $#$src) {
        for my $j (0 .. $e) {
            my $t = [@{ $arr->[$j] }];
            
            $t->[0] = $i;

            push @$arr, $t;
        }
    }

    &_permute( $num-1, $arr, $src ) if $num > 1;
}
# }}}
# permute {{{
sub permute {
    my $anum = shift; croak "dumb number" unless $anum > 0;
    my @ret = ();

    for my $num ( 1 .. $anum ) {
        my @a = map {[$_]} @_;

        &_permute( $num-1, \@a, \@_ ) if $num > 1;

        push @ret, @a;
    }

    return @ret;
}
# }}}
# slam_sort {{{
sub slam_sort {
    my ($c, $d) = ($slam_these{$a}, $slam_these{$b});

    return $c <=> $d if $c != $d;
    return $a cmp $b;
}
# }}}