# XXX SOME TESTS DISABLED
use PDL::LiteF;
kill INT,$$ if $ENV{UNDER_DEBUGGER}; # Useful for debugging.
sub ok {
my $no = shift ;
my $result = shift ;
if($ENV{PDL_T}) {
if($result) { print "ok $no\n";return }
my ($p,$f,$l) = caller;
print "FAILED TEST $no AT $p $f $l\n";
} else {
print "not " unless $result ;
print "ok $no\n" ;
}
}
# XXX
print "1..33\n";
if(1) {
{my ($a,$b,$c);
# 1. Test that changes do flow
$a = pdl 2,3,4;
$a->doflow;
$b = $a + $a;
ok(1,($b->at(0) == 4));
ok(2,($b->at(1) == 6));
$a->set(0,50);
ok(3,($b->at(0) == 100));
ok(4,($b->at(1) == 6));
# 2. If we don't want flow, we mustn't have it.
$a = pdl 2,3,4;
$b = $a + $a;
ok(5,($b->at(0) == 4));
ok(6,($b->at(1) == 6));
$a->set(0,50);
ok(7,($b->at(0) == 4));
ok(8,($b->at(1) == 6));
$ind = 9;
# 3. Test what happens when we assign to $b. (no coredumps allowed)
$a = pdl 2,3,4;
$a->doflow;
$b = $a + $a;
ok($ind++,($b->at(0) == 4));
ok($ind++,($b->at(1) == 6));
$b->set(0,50); # This must break the dataflow completely
ok($ind++,($b->at(0) == 50));
ok($ind++,($b->at(1) == 6));
ok($ind++,($a->at(0) == 2));
ok($ind++,($a->at(1) == 3));
$a->set(0,33);
ok($ind++,($b->at(0) == 50));
ok($ind++,($b->at(1) == 6));
ok($ind++,($a->at(0) == 33));
ok($ind++,($a->at(1) == 3));
# 4. Now a basic slice test. Once Incs etc. are back, need
# to do this also with other kinds of slices.
# This gets so hairy that we want to use strings for testing.
$a = pdl [2,3,4],[5,6,7];
ok($ind++, ("$a" eq <<END));
[
[2 3 4]
[5 6 7]
]
END
$b = $a->slice('1:2,:');
ok($ind++, ("$b" eq <<END));
[
[3 4]
[6 7]
]
END
$a->set(1,1,9);
ok($ind++, ("$a" eq <<END));
[
[2 3 4]
[5 9 7]
]
END
ok($ind++, ("$b" eq <<END));
[
[3 4]
[9 7]
]
END
$c = $a->slice('0:1,:');
ok($ind++, ("$c" eq <<END));
[
[2 3]
[5 9]
]
END
$b->set(0,0,8);
ok($ind++, ("$a" eq <<END));
[
[2 8 4]
[5 9 7]
]
END
ok($ind++, ("$b" eq <<END));
[
[8 4]
[9 7]
]
END
ok($ind++, ("$c" eq <<END));
[
[2 8]
[5 9]
]
END
}
# 5. Now, to the hairy stuff of generations and progenitors.
# XXX DISABLED
if(0) {my($a,$a2,$b,$c,$d,$e,$f,$g,@ps);
# We set up the following dependency graph:
#
# c
# ^
# |
# a -> b . . . > b' -> f
# | |
# V V
# d - - - > d'
# | |
# V V
# e . . . > e' -> g
#
# which, although it does not exercise *every* code path, still
# does a lot.
$a = pdl [2,3,4],[5,6,7];
$a->doflow;
$b = $a + 1;
ok($ind++, ("$b" eq <<END));
[
[3 4 5]
[6 7 8]
]
END
#print $b;
# $foo2 = pdl 2;
$c = $b * 2; # This should stay the same flowed structure.
ok($ind++, ("$c" eq <<END));
[
[ 6 8 10]
[12 14 16]
]
END
# print $c;
$d = $b->slice('1:2,:');
$e = $d->slice('1,:');
# NOW
#print "DDUMP1\n";
# $d->jdump();
$d += 0.5;
#print "DDUMP2\n";
# $d->jdump();
# print $d;
# $d->jdump();
$f = $b * 2;
# This checks whether the system realizes to look for the new $e.
$g = $e - 15;
# print $a,$b,$c,$d,$e,$f,$g;
$a->set(0,0,8);
$a->set(1,0,9);
$a->set(2,0,10);
@ps = ($a,$b,$c,$d,$e,$f,$g);
# print "PRINTS\n"; $b->jdump;
# $c->jdump;
#map {if($_) {# $_->jdump;
# print $_} else {print "FOO\n";}} @ps;
undef @ps;
ok($ind++, ("$a" eq <<END));
[
[ 8 9 10]
[ 5 6 7]
]
END
ok($ind++, ("$b" eq <<END));
[
[ 9 10.5 11.5]
[ 6 7.5 8.5]
]
END
ok($ind++, ("$c" eq <<END));
[
[18 20 22]
[12 14 16]
]
END
ok($ind++, ("$d" eq <<END));
[
[10.5 11.5]
[ 7.5 8.5]
]
END
ok($ind++, ("$e" eq <<END));
[
[11.5]
[ 8.5]
]
END
ok($ind++, ("$f" eq <<END));
[
[18 21 23]
[12 15 17]
]
END
ok($ind++, ("$g" eq <<END));
[
[-3.5]
[-6.5]
]
END
}
}
# 6. Now, what if the mutated one is actually the parent.
if(0) { # XXX DISABLED
my($a,$b,$c,$d);
$a = pdl 2,3,4;
$a->doflow;
$a2 = pdl 2;
$b = $a * $a2;
# print $b;
ok($ind++, ("$b" eq "[4 6 8]"));
# $b->jdump;
$c = pdl 1;
$b += $c;
# $b->jdump;
# $c->jdump;
# print $b;
ok($ind++, ("$b" eq "[5 7 9]"));
# $b->jdump;
# print "TOSETA\n";
$a->set(1,5);
# print "TODUMPA\n";
# $a->jdump();
# $b->jdump();
# print "TOPRINTB\n";
# print $b;
ok($ind++, ("$b" eq "[5 11 9]"));
# print "EXITING SCOPE\n";
}
#print "EXITED SCOPE\n";
# 7. What about axisvals:
{
my($a,$b);
$a = zeroes 5,3;
# print $a;
ok($ind++, ("$a" eq <<END));
[
[0 0 0 0 0]
[0 0 0 0 0]
[0 0 0 0 0]
]
END
# print "NEW_OR_INPLACE_NOW\n";
$b = PDL::Core::new_or_inplace($a);
# print "NEW_OR_INPLACE_DONE\n";
# $b->jdump();
$c = $b->xchg(0,1);
# $c->jdump();
$c->make_physical();
# $c->jdump();
axisvalues($c);
# print $c;
ok($ind++, ("$c" eq <<END));
[
[0 1 2]
[0 1 2]
[0 1 2]
[0 1 2]
[0 1 2]
]
END
# print $b;
ok($ind++, ("$b" eq <<END));
[
[0 0 0 0 0]
[1 1 1 1 1]
[2 2 2 2 2]
]
END
# print $a;
ok($ind++, ("$a" eq <<END));
[
[0 0 0 0 0]
[0 0 0 0 0]
[0 0 0 0 0]
]
END
# $b->jdump;
# print $b;
#
# $b = axisvalues($a);
#
# print $b;
# warn "Two tests disabled (31-32) as do not work\n";
if(1) { # These tests diaabled (do not work) XXX Do
$a = zeroes 5,5;
$b = $a->slice("1:3,1:3");
my $c = $b->slice("(1),(1)");
ok($ind++,($c->at() == 0));
$a .= 1;
ok($ind++,($c->at() == 1));
$a .= 2;
ok($ind++,($c->at() == 2));
}
}
exit 0;
# print "DONE\n";