The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use Test::More;
use Config;

sub inpath {
  my ($prog) = @_;
  for ( split $Config{path_sep}, $ENV{PATH} ) {
    return 1 if -x "$_/$prog$Config{exe_ext}"
  }
  return;
}

BEGIN {
   eval "use Convert::UU;";
   my $hasuuencode = !$@ || (inpath('uuencode') && inpath('uudecode'));

   if ($hasuuencode) {
      plan tests => 16;
   } else {
      plan skip_all => "Skip neither uuencode/decode nor Convert:UU is available\n";
   }

   use PDL;
}

########### First test the load...
use_ok('PDL::IO::Dumper');

########### Dump several items and make sure we get 'em back...
# a: trivial
# b: 0-d
# c: inline
# d: advanced expr

my ( $s, $a );

eval '$s = sdump({a=>3,b=>pdl(4),c=>xvals(3,3),d=>xvals(4,4)});';
ok(!$@, 'Call sdump()')
   or diag("Call sdump() output string:\n$s\n");
$a = eval $s;
ok(!$@, 'Can eval dumped data code') or diag("The output string was '$s'\n");
ok(ref $a eq 'HASH', 'HASH was restored');
ok(($a->{a}==3), 'SCALAR value restored ok');
ok(((ref $a->{b} eq 'PDL') && ($a->{b}==4)), '0-d PDL restored ok');
ok(((ref $a->{c} eq 'PDL') && ($a->{c}->nelem == 9) 
      && (sum(abs(($a->{c} - xvals(3,3))))<0.0000001)), '3x3 PDL restored ok');
ok(((ref $a->{d} eq 'PDL') && ($a->{d}->nelem == 16)
      && (sum(abs(($a->{d} - xvals(4,4))))<0.0000001)), '4x4 PDL restored ok');

########## Dump a uuencoded expr and try to get it back...
# e: uuencoded expr
eval '$s = sdump({e=>xvals(25,25)});';
ok(!$@, 'sdump() of 25x25 PDL to test uuencode dumps');

#diag $s,"\n";

$a = eval $s;
ok(!$@, 'Can eval dumped 25x25 PDL');

# $s and $@ can be long so try and make things a bit clearer in the
# output
#
if ( $@ ) {
   diag "--- ERROR ---\n";
   diag "--Error message start:\n";
   diag $@;
   diag "\n--Error message end:\n";
   diag "String was:\n$s\n";
   diag "--- ERROR (end) ---\n";
}

ok((ref $a eq 'HASH'), 'HASH structure for uuencoded 25x25 PDL restored');
ok(((ref $a->{e} eq 'PDL') 
      && ($a->{e}->nelem==625)
      && (sum(abs(($a->{e} - xvals(25,25))))<0.0000001)), 'Verify 25x25 PDL restored data');

########## Check header dumping...
eval '$a = xvals(2,2); $a->sethdr({ok=>1}); $a->hdrcpy(1); $b = xvals(25,25); $b->sethdr({ok=>2}); $b->hdrcpy(0); $s = sdump([$a,$b,yvals(25,25)]);';
ok(!$@, 'Check header dumping');

$a = eval $s;
ok((!$@ && (ref $a eq 'ARRAY')), 'ARRAY can restore');

ok(eval('$a->[0]->hdrcpy() == 1 && $a->[1]->hdrcpy() == 0'), 'Check hdrcpy()\'s persist');
ok(eval('($a->[0]->gethdr()->{ok}==1) && ($a->[1]->gethdr()->{ok}==2)'), 'Check gethdr() values persist');

# end