use Test::More tests => 24;
use Test::Warn;

use PDL::LiteF;
use PDL::Types;
use PDL::Dbg;

BEGIN
{
  warning_like{ require PDL::Tests; PDL::Tests->import; }
    qr/deprecated.*PDL::Test::Fancy/,
    "PP deprecation should emit warnings";
}


kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.

# Is there any good reason we don't use PDL's approx function?
sub tapprox {
    my($a,$b,$c,$d) = @_;
    $c = abs($a-$b);
    $d = max($c);
    return $d < 0.01;
}

$a = xvals(zeroes(byte, 2, 4));

# $P() affine tests
test_foop($a,($b=null));
ok( tapprox($a,$b) )
  or diag $b;

test_foop($a->xchg(0,1),($b=null));
ok( tapprox($a->xchg(0,1),$b) )
  or diag $b;

$vaff = $a->dummy(2,3)->xchg(1,2);
test_foop($vaff,($b=null));
ok( tapprox($vaff,$b) )
  or diag ($vaff, $vaff->dump);


# now in primitive.t
# double qualifier
#$a = ones(byte,3000);
#test_dsumover($a,($b=null));
#ok( $b->get_datatype, $PDL_D );
#ok( $b->at, 3000 );

# float qualifier
$a = ones(byte,3000);
test_fsumover($a,($b=null));
is( $b->get_datatype, $PDL_F );
is( $b->at, 3000 );

# int+ qualifier
for (byte,short,ushort,long,float,double) {
  $a = ones($_,3000);
  test_nsumover($a,($b=null));
  is( $b->get_datatype, (($PDL_L > $_->[0]) ? $PDL_L : $_->[0]) );
  is( $b->at, 3000 );
}

test_setdim(($a=null),10);
is( join(',',$a->dims), "10" );
ok( tapprox($a,sequence(10)) );

# this used to segv under solaris according to Karl
{ local $=0; # To suppress warnings of use of uninitialized value.
  $ny=7;
  $a = double xvals zeroes (20,$ny);
  test_fooseg $a, $b=null;

  ok( 1 );  # if we get here at all that is alright
  ok( tapprox($a,$b) )
    or diag($a, "\n", $b);
}


# test the bug alluded to in the comments in
# pdl_changed (pdlapi.c)
# used to segfault
$xx=ones(float,3,4);
$sl1 = $xx->slice('(0)');
$sl11 = $sl1->slice('');
$sl2 = $xx->slice('(1)');
$sl22 = $sl2->slice('');

test_fooflow2 $sl11, $sl22;

ok(all $xx->slice('(0)') == 599);
ok(all $xx->slice('(1)') == 699);