Skip to content

Commit

Permalink
capture (some) current DATACHANGED behaviour
Browse files Browse the repository at this point in the history
  • Loading branch information
mohawk2 committed Feb 9, 2024
1 parent 602e1a2 commit 0fd62df
Showing 1 changed file with 34 additions and 3 deletions.
37 changes: 34 additions & 3 deletions t/slice.t
Original file line number Diff line number Diff line change
Expand Up @@ -293,14 +293,45 @@ for my $start (0, 4, -4, 20, -20) {
}

{
my @METHODS = qw(datachgd allocated vaffine);
sub vafftest {
my ($all, $exp, $elabel) = @_[0..2];
local $Test::Builder::Level = $Test::Builder::Level + 1;
for (0..$#$all) {
my ($x, $name, $xexp) = (@{$all->[$_]}[0,1], $exp->[$_]);
is $x->${\$METHODS[$_]}, $xexp->[$_], "$elabel: $name $METHODS[$_]"
for 0..$#METHODS;
}
}
# Test vaffine optimisation
my $x = zeroes(100,100);
my $y = $x->slice('10:90,10:90');
my $y2 = $y->slice('5:8,5:8');
my $clump = $y2->clump(-1);
my $all = [[$y,'vaff'], [$y2,'child'], [$clump,'clumped']];
vafftest($all, [[1,0,0],[1,0,0],[1,0,0]], "start");
$y++;
ok( (not $y->allocated) ) ;
vafftest($all, [[1,0,1],[1,0,0],[1,0,0]], "vaff mutated");
$y2->make_physvaffine;
vafftest($all, [[1,0,1],[1,0,1],[1,0,0]], "child vaffed");
$y->make_physical;
vafftest($all, [[0,1,1],[1,0,1],[1,0,0]], "vaff physicalised");
$y2 += 1;
vafftest($all, [[1,1,1],[1,0,1],[1,0,0]], "child mutated");
$y->make_physvaffine;
vafftest($all, [[1,1,1],[1,0,1],[1,0,0]], "vaff physvaffined");
$clump++;
vafftest($all, [[1,1,1],[0,1,1],[0,1,0]], "clumped mutated");
$x->set(0,0,7);
vafftest($all, [[1,1,1],[0,1,1],[0,1,0]], "root set()ed");
$y->make_physvaffine;
vafftest($all, [[1,1,1],[0,1,1],[0,1,0]], "vaff physvaffined");
$y2->make_physvaffine;
vafftest($all, [[1,1,1],[0,1,1],[0,1,0]], "child physvaffined");
$clump->make_physvaffine;
vafftest($all, [[1,1,1],[0,1,1],[0,1,0]], "clumped physvaffined");
# Make sure that vaffining is properly working:
$x = zeroes 5,6,2;
$y = (xvals $x) + 0.1 * (yvals $x) + 0.01 * (zvals $x);
$y = xvals(5,6,2) + 0.1 * yvals(5,6,2) + 0.01 * zvals(5,6,2);
my $c = $y->copy->slice("2:3");
ok tapprox $c, $c->copy;
for ([0,1], [1,0], [1,1]) {
Expand Down

0 comments on commit 0fd62df

Please sign in to comment.