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

# 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";