"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "t/01-pptest.t" between
PDL-2.074.tar.gz and PDL-2.075.tar.gz

About: PDL (Perl Data Language) aims to turn perl into an efficient numerical language for scientific computing (similar to IDL and MatLab).

01-pptest.t  (PDL-2.074):01-pptest.t  (PDL-2.075)
skipping to change at line 126 skipping to change at line 126
$b() = tmp;' $b() = tmp;'
); );
# test to set named dim with 'OtherPar' # test to set named dim with 'OtherPar'
pp_deft('setdim', pp_deft('setdim',
Pars => '[o] a(n)', Pars => '[o] a(n)',
OtherPars => 'int ns => n', OtherPars => 'int ns => n',
Code => 'loop(n) %{ $a() = n; %}', Code => 'loop(n) %{ $a() = n; %}',
); );
pp_deft("gelsd",
Pars => '[io,phys]A(m,n); [io,phys]B(p,q); [phys]rcond(); [o,phys]s(r);
int [o,phys]rank();int [o,phys]info()',
RedoDimsCode => '$SIZE(r) = PDLMIN($SIZE(m),$SIZE(n));',
GenericTypes => ['F'],
Code => '$CROAK("croaking");'
);
pp_deft('fooseg', pp_deft('fooseg',
Pars => 'a(n); [o]b(n);', Pars => 'a(n); [o]b(n);',
Code => ' Code => '
loop(n) %{ $b() = $a(); %} loop(n) %{ $b() = $a(); %}
'); ');
# adapted from PDL::NDBin: if in=null and b is a scalar, was SEGV-ing # adapted from PDL::NDBin: if in=null and b is a scalar, was SEGV-ing
pp_deft( '_flatten_into', pp_deft( '_flatten_into',
Pars => "in(m); indx b(m); [o] idx(m)", Pars => "in(m); indx b(m); [o] idx(m)",
Code => ' Code => '
skipping to change at line 164 skipping to change at line 171
GenericTypes => ['F'], GenericTypes => ['F'],
Code => 'tinplace_c2($SIZE(n),$P(a),$P(b));', Code => 'tinplace_c2($SIZE(n),$P(a),$P(b));',
); );
pp_deft('fooflow3', pp_deft('fooflow3',
Pars => '[o,nc]a(n);[o,nc]b(n);[o,nc]c(n)', Pars => '[o,nc]a(n);[o,nc]b(n);[o,nc]c(n)',
GenericTypes => ['F'], GenericTypes => ['F'],
Code => 'tinplace_c3($SIZE(n),$P(a),$P(b),$P(c));', Code => 'tinplace_c3($SIZE(n),$P(a),$P(b),$P(c));',
); );
pp_deft( 'threadloop_continue', pp_deft( 'broadcastloop_continue',
Pars => 'in(); [o] out()', Pars => 'in(); [o] out()',
Code => q[ Code => q[
int cnt = 0; int cnt = 0;
threadloop %{ threadloop %{
if ( ++cnt %2 ) if ( ++cnt %2 )
continue; continue;
$out() = $in(); $out() = $in();
%} %}
skipping to change at line 247 skipping to change at line 254
pp_done; pp_done;
# this tests the bug with a trailing comment and *no* newline # this tests the bug with a trailing comment and *no* newline
EOF EOF
't/all.t' => <<'EOF', 't/all.t' => <<'EOF',
use strict; use strict;
use warnings; use warnings;
use Test::More; use Test::More;
use Test::Warn; use Test::Warn;
BEGIN { $ENV{PDL_AUTOPTHREAD_TARG} = 1 } # for continue-in-threadloop test BEGIN { $ENV{PDL_AUTOPTHREAD_TARG} = 1 } # for continue-in-broadcastloop test
use PDL::LiteF; use PDL::LiteF;
use PDL::Types; use PDL::Types;
use PDL::Dbg; use PDL::Dbg;
BEGIN { BEGIN {
warning_like{ require PDL::Tests; PDL::Tests->import; } warning_like{ require PDL::Tests; PDL::Tests->import; }
qr/deprecated.*PDL::Test::Fancy/, qr/deprecated.*PDL::Test::Fancy/,
"PP deprecation should emit warnings"; "PP deprecation should emit warnings";
} }
skipping to change at line 310 skipping to change at line 317
$x = ones($_,3000); $x = ones($_,3000);
test_nsumover($x,($y=null)); test_nsumover($x,($y=null));
is( $y->get_datatype, (($PDL_L > $_->[0]) ? $PDL_L : $_->[0]) ); is( $y->get_datatype, (($PDL_L > $_->[0]) ? $PDL_L : $_->[0]) );
is( $y->at, 3000 ); is( $y->at, 3000 );
} }
test_setdim(($x=null),10); test_setdim(($x=null),10);
is( join(',',$x->dims), "10" ); is( join(',',$x->dims), "10" );
ok( tapprox($x,sequence(10)) ); ok( tapprox($x,sequence(10)) );
{
my @msg;
local $SIG{__WARN__} = sub { push @msg, @_ };
eval { nan(2,2)->test_gelsd(nan(2,2), -3) };
like $@, qr/croaking/, 'right error message';
is_deeply \@msg, [], 'no warnings' or diag explain \@msg;
}
# this used to segv under solaris according to Karl # this used to segv under solaris according to Karl
{ {
my $ny=7; my $ny=7;
$x = double xvals zeroes (20,$ny); $x = double xvals zeroes (20,$ny);
test_fooseg $x, $y=null; test_fooseg $x, $y=null;
ok( 1 ); # if we get here at all that is alright ok( 1 ); # if we get here at all that is alright
ok( tapprox($x,$y) ) ok( tapprox($x,$y) )
or diag($x, "\n", $y); or diag($x, "\n", $y);
} }
eval { test__flatten_into(null, 2) }; eval { test__flatten_into(null, 2) };
ok 1; #was also segfaulting ok 1; #was also segfaulting
# test the bug alluded to in the comments in # test the bug alluded to in the comments in pdl_changed (pdlapi.c)
# pdl_changed (pdlapi.c)
# used to segfault # used to segfault
my $xx=ones(float,3,4); my $xx=ones(float,3,4);
my $sl1 = $xx->slice('(0)'); my $sl1 = $xx->slice('(0)');
my $sl11 = $sl1->slice(''); my $sl11 = $sl1->slice('');
my $sl2 = $xx->slice('(1)'); my $sl2 = $xx->slice('(1)');
my $sl22 = $sl2->slice(''); my $sl22 = $sl2->slice('');
test_fooflow2($sl11, $sl22); test_fooflow2($sl11, $sl22);
ok(all $xx->slice('(0)') == 599); ok(all $xx->slice('(0)') == 599);
ok(all $xx->slice('(1)') == 699); ok(all $xx->slice('(1)') == 699);
# test that continues in a threadloop work # test that continues in a broadcastloop work
{ {
my $in = sequence(10); my $in = sequence(10);
my $got = $in->zeroes; my $got = $in->zeroes;
my $exp = $in->copy; my $exp = $in->copy;
my $tmp = $exp->where( ! ($in % 2) ); my $tmp = $exp->where( ! ($in % 2) );
$tmp .= 0; $tmp .= 0;
test_threadloop_continue( $in, $got ); test_broadcastloop_continue( $in, $got );
ok( tapprox( $got, $exp ), "continue works in threadloop" ) ok( tapprox( $got, $exp ), "continue works in broadcastloop" )
or do { diag "got : $got"; diag "expected: $exp" }; or do { diag "got : $got"; diag "expected: $exp" };
} }
test_Cpow(sequence(2), 1); test_Cpow(sequence(2), 1);
test_polyfill_pp(zeroes(5,5), ones(2,3), 1); test_polyfill_pp(zeroes(5,5), ones(2,3), 1);
is test_succ(2)."", 3, 'test pp_add_macros works'; is test_succ(2)."", 3, 'test pp_add_macros works';
done_testing; done_testing;
skipping to change at line 468 skipping to change at line 482
*/ */
/* Sanity check */ /* Sanity check */
$b() = $a() + 1; $b() = $a() + 1;
%} %}
}, },
); );
# make sure that if the word "threadloop" appears, later automatic threadloops # make sure that if the word "broadcastloop" appears, later automatic broadcastl
# will not be generated, even if the original threadloop was commented-out oops
# will not be generated, even if the original broadcastloop was commented-out
pp_def('testinc2', pp_def('testinc2',
Pars => 'a(); [o] b()', Pars => 'a(); [o] b()',
Code => q{ Code => q{
/* emulate user debugging */ /* emulate user debugging */
/* Why doesn't this work???!!!! */ /* Why doesn't this work???!!!! */
/* threadloop %{ /* threadloop %{
printf(" %f, %f\r", $a(), $b()); printf(" %f, %f\r", $a(), $b());
printf(" Here\n"); printf(" Here\n");
skipping to change at line 504 skipping to change at line 518
use Test::More; use Test::More;
use PDL::LiteF; use PDL::LiteF;
use_ok 'PDL::ThreadTest'; use_ok 'PDL::ThreadTest';
my $x = sequence(3,3); my $x = sequence(3,3);
my $y = $x->testinc; my $y = $x->testinc;
ok(all ($y == $x+1), 'Sanity check runs correctly'); ok(all ($y == $x+1), 'Sanity check runs correctly');
# Test the inability to comment-out a threadloop. This is documented on the # Test the inability to comment-out a broadcastloop. This is documented on the
# 11th page of the PDL::PP chapter of the PDL book. If somebody ever fixes this # 11th page of the PDL::PP chapter of the PDL book. If somebody ever fixes this
# wart, this test will fail, in which case the book's text should be updated. # wart, this test will fail, in which case the book's text should be updated.
$y = $x->testinc2; $y = $x->testinc2;
TODO: { TODO: {
# Note: This test appears to fail on Cygwin and some flavors of Linux. # Note: This test appears to fail on Cygwin and some flavors of Linux.
local $TODO = 'This test inexplicably passes on some machines'; local $TODO = 'This test inexplicably passes on some machines';
ok(not (all $y == $x + 1), 'WART: commenting out a threadloop does not w ork') ok(not (all $y == $x + 1), 'WART: commenting out a broadcastloop does no t work')
or diag("\$x is $x and \$y is $y"); or diag("\$x is $x and \$y is $y");
} }
done_testing; done_testing;
EOF EOF
); );
do_tests(\%THREADTESTFILES); do_tests(\%THREADTESTFILES);
do_tests(\%PPTESTFILES); do_tests(\%PPTESTFILES);
 End of changes. 11 change blocks. 
11 lines changed or deleted 27 lines changed or added

Home  |  About  |  Features  |  All  |  Newest  |  Dox  |  Diffs  |  RSS Feeds  |  Screenshots  |  Comments  |  Imprint  |  Privacy  |  HTTP(S)