# Test routine for PDL::IO::Misc module

use strict; 

use PDL::LiteF;
use PDL::IO::Misc;

use PDL::Core ':Internal'; # For howbig()
use PDL::Config;

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

use Test;
BEGIN { plan tests => 16; }

sub tapprox {
        my($a,$b) = @_;
        my $c = abs($a-$b);
        my $d = max($c);
        $d < 0.0001;
}

require File::Spec;
my $fs = 'File::Spec';
sub cdir { return $fs->catdir(@_)}
sub cfile { return $fs->catfile(@_)}

my $tempd = $PDL::Config{TEMPDIR} or
  die "TEMPDIR not found in %PDL::Config";
my $file = cfile $tempd, "iotest$$";

############# Test rcols with filename and pattern #############

open(OUT, ">$file") || die "Can not open $file for writing\n";
print OUT <<EOD;
1 2
2 33 FOO
3 7
4 9  FOO
5 66
EOD
close(OUT);

($a,$b) = rcols $file,0,1;
$a = long($a); $b=long($b);

ok( (sum($a)==15 && max($b)==66 && $b->getdim(0)==5), 1, "rcols with filename" );

($a,$b) = rcols $file, "/FOO/",0,1;
$a = long($a);
$b=long($b);

ok( (sum($a)==6 && max($b)==33 && $b->getdim(0)==2), 1, "rcols with filename + pattern" );

############### Test rgrep with FILEHANDLE #####################

open(OUT, ">$file") || die "Can not open $file for writing\n";
print OUT <<EOD;
foo"1" -2-
foo"2"  Test -33-
foo"3" jvjtvbjktrbv -7-
foo"4" -9-
fjrhfiurhe foo"5" jjjj -66-
EOD
close(OUT);

open(OUT, $file) || die "Can not open $file for reading\n";
($a,$b) = rgrep {/foo"(.*)".*-(.*)-/} *OUT;
$a = long($a); $b=long($b);
close(OUT);

ok( (sum($a)==15 && max($b)==66 && $b->getdim(0)==5), 1, "rgrep" );

########### Explicit test of byte swapping #################

$a = short(3); $b = long(3); # $c=long([3,3]);
bswap2($a); bswap4($b);
ok(sum($a)==768 && sum($b)==50331648,1,"bswap2");

############# Test rasc  #############

open(OUT, ">$file") || die "Can not open $file for writing\n";
print OUT <<EOD;
0.231862613
0.20324005
0.067813045
0.040103501
0.438047631
0.283293628
0.375427346
0.195821617
0.189897617
0.035941205
0.339051483
0.096540854
0.25047197
0.579782013
0.236164184
0.221568561
0.009776015
0.290377604
0.785569601
0.260724391

EOD
close(OUT);

$a = PDL->null;
$a->rasc($file,20);
ok( abs($a->sum - 5.13147) < .01, 1, "rasc on null piddle" );
 
$b = zeroes(float,20,2);
$b->rasc($file);
ok( abs($b->sum - 5.13147) < .01, 1, "rasc on existing piddle" );

eval '$b->rasc("file_that_does_not_exist")';
ok( $@, qr/Can't open/, "rasc on non-existant file" );

unlink $file; # clean up

#######################################################
# Tests of rcols() options
#   EXCLUDE/INCLUDE/LINES/DEFTYPE/TYPES

open(OUT, ">$file") || die "Can not open $file for writing\n";
print OUT <<EOD;
1 2
# comment line
3 4
-5 6
7 8
EOD
close(OUT);

($a,$b) = rcols $file,0,1;
ok( $a->nelem==4 && sum($a)==6 && sum($b)==20, 1,
    "rcols: default" );

($a,$b) = rcols $file,0,1, { INCLUDE => '/^-/' };
ok( $a->nelem==1 && $a->at(0)==-5 && $b->at(0)==6, 1,
    "rcols: include pattern" );

($a,$b) = rcols $file,0,1, { LINES => '-2:0' };
ok( $a->nelem==3 && tapprox($a,pdl(-5,3,1)) && tapprox($b,pdl(6,4,2)), 1,
    "rcols: lines option" );

use PDL::Types;
($a,$b) = rcols $file, { DEFTYPE => long };
ok( $a->nelem==4 && $a->get_datatype==$PDL_L && $b->get_datatype==$PDL_L, 1,
    "rcols: deftype option" );

($a,$b) = rcols $file, { TYPES => [ ushort ] };
ok( $a->nelem==4 && $a->get_datatype==$PDL_US && $b->get_datatype==$PDL_D, 1,
    "rcols: types option" );

ok( UNIVERSAL::isa($PDL::IO::Misc::deftype,"PDL::Type"), 1,
    "PDL::IO::Misc::deftype is a PDL::Type object" );
ok( $PDL::IO::Misc::deftype->[0], double->[0],
    "PDL::IO::Misc::deftype check" );

$PDL::IO::Misc::deftype = short;
($a,$b) = rcols $file;
ok( $a->get_datatype, short->[0], "rcols: can read in as 'short'" );

unlink $file;

eval { wcols $a, $b };
ok(!$@,1, "wcols" );

1;