1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
|
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";
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]a(n); byte [o,phys]b(n)',
GenericTypes => [B],
Code => 'ppcp($P(b),$P(a),$SIZE(n));',
);
# double qualifier
pp_deft(
'dsumover',
Pars => 'a(n); double [o]b();',
Code => 'PDL_Double tmp = 0;
loop(n) %{ tmp += $a(); %}
$b() = tmp;'
);
# float qualifier
pp_deft(
'fsumover',
Pars => 'a(n); float [o]b();',
Code => 'PDL_Float tmp = 0;
loop(n) %{ tmp += $a(); %}
$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_done;
|
