The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/usr/bin/perl -w
#
# t/hdf_vdata.t
#
# Tests Vdata features of the HDF library.
#
# 29 March 2006
# Judd Taylor, USF IMaRS
#
use strict;
use PDL;
use Test::More;

BEGIN
{    
    use PDL::Config;
    if ( $PDL::Config{WITH_HDF} ) 
    {
        eval( " use PDL::IO::HDF; " );
        if( $@ )
        {
            plan skip_all => "PDL::IO::HDF module compiled, but not available.";
        }  
        else
        {
            plan tests => 21;
        }
    }
    else
    {
        plan skip_all => "PDL::IO::HDF module not compiled.";
    }
}

sub tapprox
{
    my $a = shift;
    my $b = shift;
    my $d = abs($a - $b);
    #ok( all($d < 1.0e-5) );
    return all($d < 1.0e-5);
}

use PDL::IO::HDF;
use PDL::IO::HDF::VS;

# Vdata test suite
use PDL::Config;
my $tmpdir = $PDL::Config{TEMPDIR};

my $testfile = "$tmpdir/vdata.hdf";

# creating

# TEST 1:
my $Hid = PDL::IO::HDF::VS::_Hopen( $testfile, PDL::IO::HDF->DFACC_CREATE, 2);
ok( $Hid != PDL::IO::HDF->FAIL );

PDL::IO::HDF::VS::_Vstart( $Hid );
my $vdata_id = PDL::IO::HDF::VS::_VSattach( $Hid, -1, "w" );
PDL::IO::HDF::VS::_VSsetname( $vdata_id, 'vdata_name' );
PDL::IO::HDF::VS::_VSsetclass( $vdata_id, 'vdata_class' );

# TEST 2:
my $vdata_ref = PDL::IO::HDF::VS::_VSgetid( $Hid, -1 );
ok( $vdata_ref != PDL::IO::HDF->FAIL );

# TEST 3:
my $name = "";
PDL::IO::HDF::VS::_VSgetname( $vdata_id, $name );
ok( $name eq "vdata_name" );

# TEST 4:
my $class = "";
PDL::IO::HDF::VS::_VSgetclass( $vdata_id, $class );
ok( $class eq "vdata_class" );

my $data = PDL::float sequence(10);
my $HDFtype = $PDL::IO::HDF::SDtypeTMAP->{$data->get_datatype()};

# TEST 5:
ok( PDL::IO::HDF::VS::_VSfdefine( $vdata_id, 'PX', $HDFtype, 1) );

# TEST 6:
ok( PDL::IO::HDF::VS::_VSsetfields( $vdata_id, 'PX') );

# TEST 7:
ok( PDL::IO::HDF::VS::_VSwrite( $vdata_id, $data, 10, PDL::IO::HDF->FULL_INTERLACE ) );

PDL::IO::HDF::VS::_VSdetach( $vdata_id );
PDL::IO::HDF::VS::_Vend( $Hid );

# TEST 8:
ok( PDL::IO::HDF::VS::_Hclose( $Hid ) );

# TEST 9:
undef( $Hid );
$Hid = PDL::IO::HDF::VS::_Hopen( $testfile, PDL::IO::HDF->DFACC_READ, 2 );
ok( $Hid != PDL::IO::HDF->FAIL );

PDL::IO::HDF::VS::_Vstart( $Hid );

# TEST 10:
$vdata_ref = PDL::IO::HDF::VS::_VSfind( $Hid, 'vdata_name' );
ok( $vdata_ref != PDL::IO::HDF->FAIL );

# TEST 11:
$vdata_id = PDL::IO::HDF::VS::_VSattach( $Hid, $vdata_ref, "r" );
ok( $vdata_id != PDL::IO::HDF->FAIL );

# TEST 12:
my $vdata_size = 0;
my $n_records = 0;
my $interlace = 0;
my $fields = "";
my $vdata_name = "";
ok( PDL::IO::HDF::VS::_VSinquire( $vdata_id, $n_records, $interlace, $fields, $vdata_size, $vdata_name) );

# TEST 13:
my @tfields = split(",",$fields);
my $data_type = PDL::IO::HDF::VS::_VFfieldtype( $vdata_id, 0 );
$data = ones( $PDL::IO::HDF::SDinvtypeTMAP2->{$data_type}, 10 );
ok( PDL::IO::HDF::VS::_VSread( $vdata_id, $data, $n_records, $interlace ) );

# TEST 14:
my $expected_data = sequence(10);
ok( sub { tapprox( $data, $expected_data ) } );

PDL::IO::HDF::VS::_VSdetach( $vdata_id );
PDL::IO::HDF::VS::_Vend( $Hid );

# TEST 15:
ok( PDL::IO::HDF::VS::_Hclose( $Hid ) );

# TEST 16:
my $vdataOBJ = PDL::IO::HDF::VS->new( $testfile );
ok( defined( $vdataOBJ ) );

# TEST 17:
my @vnames = $vdataOBJ->VSgetnames();
ok( scalar( @vnames ) > 0 );

foreach my $name ( @vnames ) 
{
    # TEST 18:
    my @fields = $vdataOBJ->VSgetfieldnames( $name );
    ok( scalar( @fields ) > 0 );    
    
    foreach my $field ( @fields ) 
    {
        # TEST 19:
        my $data = $vdataOBJ->VSread( $name, $field );
        ok( defined( $data ) );
    }
}

# TEST 20:
ok( $vdataOBJ->close() );
undef( $vdataOBJ );

# TEST 21:
$vdataOBJ=PDL::IO::HDF::VS->new( $testfile );
foreach my $name ( $vdataOBJ->VSgetnames() ) 
{ 
    print "name: $name\n";
    foreach my $field ( $vdataOBJ->VSgetfieldsnames( $name ) ) 
    {
        print "   $field\n";
        my $data = $vdataOBJ->VSread( $name, $field );
        print "     " . $data->info() . "\n";
        print "        $data\n";
    }
}
ok( 1 );

# Remove the testfile:
unlink( $testfile );

exit(0);