The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use PDL::LiteF;

sub ok {
	my $no = shift ;
	my $result = shift ;
	print "not " unless $result ;
	print "ok $no\n" ;
}

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

$debug = $debug = 0;
$PDL::debug = 1;
print "1..5\n";

$a = sequence(3,4);
$b = yvals(zeroes(4,3)) + sequence(4);
$c = $a->xchg(0,1)->slice(':,-1:0');

# not very useful examples but simple and test the essentials
thread_define 'tline(a(n);b(n))', over {
    $_[0] .= $_[1];
};

thread_define 'tassgn(a(n,m);[o] b())', over {
    # sumover($_[0],$_[1]);
    $_[1] .= $_[0]->sum;
};

thread_define 'ttext(a(n=3)), NOtherPars => 1', over {
    ${$_[1]} .= sprintf("%.3f %.3f %.3f,\n",$_[0]->list);
  #join(' ',$_[0]->list) . ",\n";
};

thread_define 'tprint(a(n);b(n)), NOtherPars => 1', over {
	${$_[2]} .= "$_[1]";
};

PDL::Core::set_debugging(1) if $debug;
tline($c,$b);

print $a;
print $b;

ok(1,tapprox($c,$b));

$c = ones(5); # produce an error
eval('tline($a,$c)');
print "Error was : $@\n";
ok(2,$@ =~ /conflicting/);

$a = ones(2,3,4)*sequence(4)->slice('*,*,:');
print $a;
tassgn($a,($b=null));
print "$b\n";
$b->dump;
ok(3,tapprox($b,6*sequence(4)));

# test if setting named dim with '=' raises error
# correctly at runtime
$a = sequence(4,4);
$text="";
eval('ttext($a, \$text)');
print "Error was : $@\n";
ok(4,$@ =~ /conflicting/);

# test if dim=1 -> threaddim
print "testing tprint\n";
$a = sequence(3);
$b = pdl [1];
$text = "";
tprint($a, $b, \$text);
ok(5,$text eq '[1 1 1]');