# These tests check for proper deferred handling of barf and warn messages when pthreading.
#
use PDL::LiteF;
use PDL::Image2D;
use Test::More;
use strict;
if (PDL::Core::pthreads_enabled) {
plan tests => 2;
} else {
plan tests => 2;
diag "Control test: pthreads not enabled";
}
## Check Handling of barf messages when pthreading ###
# These statements will cause pthread to happen in two pthreads
set_autopthread_targ(2);
set_autopthread_size(0);
# Because of the duplicate 8's interpolates barf (in the PPcode) will get
# called. This should not cause a segfault
my $x = float( [1, 2, 3, 4, 5, 8, 9, 10], [1, 2, 3, 4, 5, 8, 8, 8] );
my $y = ($x * 3) * ($x - 2);
# Setup to silence warning messages
local $SIG{__WARN__} = sub { };
# Catch barf messages by running in eval:
eval{
my ( $ans, $err ) = interpolate(8.5, $x, $y );
};
ok( $@ =~ /identical abscissas/ , "interpolate barf" )
or diag "Error message should be 'identical abscissas': got\n>>>$@<<<\n";
## Now Check Warning Messages with pthreading ###
# Create an array of 2 bogus polygon indexes (bogus due to negative indexes)
# Thes will make polyfill emit a warning message.
# Single polygon
my $poly = pdl([-1,1], [0,0]);
$poly = $poly->reorder(1,0);
# make second polygon have same indexes
my $poly2 = $poly->copy;
$poly = cat $poly, $poly2;
my $mask = zeroes(5,5);
#kill 'INT',$$;
# Because of the negative indexes, a warning message
# will be printed, which will cause segfault wheen pthreaded, if messages not deferred
# properly
# Setup to catch warning messages
local $SIG{__WARN__} = sub { die $_[0] };
eval{
polyfill($mask, $poly, 1);
};
ok( $@ =~ /errors during polygonfilling/ , "polyfill barf" )
or diag "Error message should be 'errors during polygonfilling': got\n>>>$@<<<\n";