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
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
|
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;
|
