pp_addpm({At=>Top},<<'EOPM');
=head1 NAME
PDL::Tests - tests for some PP features
=head1 SYNOPSIS
use PDL::Tests;
<test code>
=head1 DESCRIPTION
This module provides some PP defined test functions that are
supposed to test some features/bugs of PDL::PP.
Strictly speaking this module shouldn't be installed with a
'make install' but I haven't yet worked out how to do it.
=cut
EOPM
sub pp_deft {
my ($name,%hash) = @_;
## $hash{Doc} = "=for ref\n\ninternal\n\nonly for internal testing purposes\n";
$hash{Doc} = undef;
$name = "test_$name"; # prepend test_ to name
pp_def($name,%hash);
}
pp_addhdr('
/* to test the $P vaffining */
void ppcp(PDL_Byte *dst, PDL_Byte *src, int len)
{
int i;
for (i=0;i<len;i++)
*dst++=*src++;
}
');
# test the $P vaffine behaviour
# when 'phys' flag is in.
pp_deft('foop',
Pars => 'byte [phys]a1(n); byte [o,phys]b(n)',
GenericTypes => [B],
Code => 'ppcp($P(b),$P(a1),$SIZE(n));',
);
# now in primitive.pd
#
# double qualifier
#pp_deft(
# 'dsumover',
# Pars => 'a1(n); double [o]b();',
# Code => 'PDL_Double tmp = 0;
# loop(n) %{ tmp += $a1(); %}
# $b() = tmp;'
#);
# float qualifier
# and also test if numerals in variable name work
pp_deft(
'fsumover',
Pars => 'a1(n); float [o]b();',
Code => 'PDL_Float tmp = 0;
loop(n) %{ tmp += $a1(); %}
$b() = tmp;'
);
# test GENERIC with type+ qualifier
pp_deft(
'nsumover',
Pars => 'a(n); int+ [o]b();',
Code => '$GENERIC(b) tmp = 0;
loop(n) %{ tmp += $a(); %}
$b() = tmp;'
);
# test to set named dim with 'OtherPar'
pp_deft('setdim',
Pars => '[o] a(n)',
OtherPars => 'int ns => n',
Code => 'loop(n) %{ $a() = n; %}',
);
# according to Karl this segvs with certain pdls
pp_deft('fooseg',
Pars => 'a(n); [o]b(n);',
Code => '
loop(n) %{ $b() = $a(); %}
');
pp_addhdr << 'EOH';
void tinplace_c1(int n, PDL_Float* data)
{
int i;
for (i=0;i<n;i++) {
data[i] = 599.0;
}
}
void tinplace_c2(int n, PDL_Float* data1, PDL_Float* data2)
{
int i;
for (i=0;i<n;i++) {
data1[i] = 599.0;
data2[i] = 699.0;
}
}
void tinplace_c3(int n, PDL_Float* data1, PDL_Float* data2, PDL_Float* data3)
{
int i;
for (i=0;i<n;i++) {
data1[i] = 599.0;
data2[i] = 699.0;
data3[i] = 799.0;
}
}
EOH
pp_deft('fooflow1',
Pars => '[o,nc]a(n)',
GenericTypes => ['F'],
Code => 'tinplace_c1($SIZE(n),$P(a));',
);
pp_deft('fooflow2',
Pars => '[o,nc]a(n);[o,nc]b(n)',
GenericTypes => ['F'],
Code => 'tinplace_c2($SIZE(n),$P(a),$P(b));',
);
pp_deft('fooflow3',
Pars => '[o,nc]a(n);[o,nc]b(n);[o,nc]c(n)',
GenericTypes => ['F'],
Code => 'tinplace_c3($SIZE(n),$P(a),$P(b),$P(c));',
);
pp_done;