(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 |
|---|
"Fossies" - the Fresh Open Source Software Archive 