"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "t/core.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).

[ To the main PDL source changes report ]

core.t  (PDL-2.074):core.t  (PDL-2.075)
skipping to change at line 120 skipping to change at line 120
} while(0); } while(0);
############## ##############
# Funky constructor cases # Funky constructor cases
# pdl of a pdl # pdl of a pdl
$x = pdl(pdl(5)); $x = pdl(pdl(5));
ok all( $x== pdl(5)), "pdl() can piddlify an ndarray"; ok all( $x== pdl(5)), "pdl() can piddlify an ndarray";
$x = pdl(null); $x = pdl(null);
is_deeply [$x->dims], [0], 'pdl(null) gives empty' or diag "x(", $x->info, ")"; ok $x->isnull, 'pdl(null) gives null' or diag "x(", $x->info, ")";
ok !$x->isnull, 'pdl(null) gives non-null' or diag "x(", $x->info, ")";
$x = pdl(null, null); $x = pdl(null, null);
is_deeply [$x->dims], [0,2], 'pdl(null, null) gives empty' or diag "x(", $x->inf o, ")"; is_deeply [$x->dims], [0,2], 'pdl(null, null) gives empty' or diag "x(", $x->inf o, ")";
ok !$x->isnull, 'pdl(null, null) gives non-null' or diag "x(", $x->info, ")"; ok !$x->isnull, 'pdl(null, null) gives non-null' or diag "x(", $x->info, ")";
# pdl of mixed-dim pdls: pad within a dimension # pdl of mixed-dim pdls: pad within a dimension
$x = pdl( zeroes(5), ones(3) ); $x = pdl( zeroes(5), ones(3) );
ok all($x == pdl([0,0,0,0,0],[1,1,1,0,0])),"Piddlifying two ndarrays concatenate s them and pads to length" or diag("x=$x\n"); ok all($x == pdl([0,0,0,0,0],[1,1,1,0,0])),"Piddlifying two ndarrays concatenate s them and pads to length" or diag("x=$x\n");
# pdl of mixed-dim pdls: pad a whole dimension # pdl of mixed-dim pdls: pad a whole dimension
skipping to change at line 160 skipping to change at line 159
ok all($c == pdl([1,0,0],[2,3,4])), "implicit, undefval of undef falls back to 0" or diag("c=$c\n"); ok all($c == pdl([1,0,0],[2,3,4])), "implicit, undefval of undef falls back to 0" or diag("c=$c\n");
$PDL::undefval = inf; $PDL::undefval = inf;
$c = pdl undef; $c = pdl undef;
ok all($c == inf), "explicit, undefval of PDL scalar works" or diag("c=$c\n" ); ok all($c == inf), "explicit, undefval of PDL scalar works" or diag("c=$c\n" );
$c = pdl [1], [2,3,4]; $c = pdl [1], [2,3,4];
ok all($c == pdl([1,inf,inf],[2,3,4])), "implicit, undefval of a PDL scalar works" or diag("c=$c\n"); ok all($c == pdl([1,inf,inf],[2,3,4])), "implicit, undefval of a PDL scalar works" or diag("c=$c\n");
} while(0); } while(0);
# empty pdl cases # empty pdl cases
eval {$x = zeroes(2,0,1);}; eval {$x = zeroes(2,0,1);};
ok(!$@,"zeroes accepts empty PDL specification"); is($@, '', "zeroes accepts empty PDL specification");
eval { $y = pdl($x,sequence(2,0,1)); }; eval { $y = pdl($x,sequence(2,0,1)); };
ok((!$@ and all(pdl($y->dims) == pdl(2,0,1,2))), "concatenating two empties give is $@, '';
s an empty"); ok all(pdl($y->dims) == pdl(2,0,1,2)), "concatenating two empties gives an empty
";
eval { $y = pdl($x,sequence(2,1,1)); }; eval { $y = pdl($x,sequence(2,1,1)); };
ok((!$@ and all(pdl($y->dims) == pdl(2,1,1,2))), "concatenating an empty and a n is $@, '';
onempty treats the empty as a filler"); ok all(pdl($y->dims) == pdl(2,1,1,2)), "concatenating an empty and a nonempty tr
eats the empty as a filler";
eval { $y = pdl($x,5) }; eval { $y = pdl($x,5) };
ok((!$@ and all(pdl($y->dims)==pdl(2,1,1,2))), "concatenating an empty and a sca is $@, '';
lar on the right works"); ok all(pdl($y->dims)==pdl(2,1,1,2)), "concatenating an empty and a scalar on the
ok( all($y==pdl([[[0,0]]],[[[5,0]]])), "concatenating an empty and a scalar on t right works";
he right gives the right answer");
eval { $y = pdl(5,$x) }; eval { $y = pdl(5,$x) };
ok((!$@ and all(pdl($y->dims)==pdl(2,1,1,2))), "concatenating an empty and a sca is $@, '';
lar on the left works"); ok all(pdl($y->dims)==pdl(2,1,1,2)), "concatenating an empty and a scalar on the
left works";
ok( all($y==pdl([[[5,0]]],[[[0,0]]])), "concatenating an empty and a scalar on t he left gives the right answer"); ok( all($y==pdl([[[5,0]]],[[[0,0]]])), "concatenating an empty and a scalar on t he left gives the right answer");
# end
# cat problems # cat problems
eval {cat(1, pdl(1,2,3), {}, 6)}; eval {cat(1, pdl(1,2,3), {}, 6)};
ok ($@ ne '', 'cat barfs on non-ndarray arguments'); ok ($@ ne '', 'cat barfs on non-ndarray arguments');
like ($@, qr/Arguments 0, 2 and 3 are not ndarrays/, 'cat correctly identifies n on-ndarray arguments'); like ($@, qr/Arguments 0, 2 and 3 are not ndarrays/, 'cat correctly identifies n on-ndarray arguments');
$@ = ''; $@ = '';
eval {cat(1, pdl(1,2,3))}; eval {cat(1, pdl(1,2,3))};
like($@, qr/Argument 0 is not an ndarray/, 'cat uses good grammar when discussin g non-ndarrays'); like($@, qr/Argument 0 is not an ndarray/, 'cat uses good grammar when discussin g non-ndarrays');
$@ = ''; $@ = '';
my $two_dim_array = cat(pdl(1,2), pdl(1,2)); my $two_dim_array = cat(pdl(1,2), pdl(1,2));
skipping to change at line 209 skipping to change at line 209
ok ($@ ne '', 'cat barfs combined screw-ups'); ok ($@ ne '', 'cat barfs combined screw-ups');
like($@, qr/Arguments 0, 3 and 4 are not ndarrays/ like($@, qr/Arguments 0, 3 and 4 are not ndarrays/
, 'cat properly identifies non-ndarrays in combined screw-ups'); , 'cat properly identifies non-ndarrays in combined screw-ups');
like($@, qr/arguments 2 and 6 do not match/ like($@, qr/arguments 2 and 6 do not match/
, 'cat properly identifies ndarrays with mismatched dimensions in combine d screw-ups'); , 'cat properly identifies ndarrays with mismatched dimensions in combine d screw-ups');
like($@, qr/\(argument 1\)/, like($@, qr/\(argument 1\)/,
'cat properly identifies the first actual ndarray in combined screw-ups') ; 'cat properly identifies the first actual ndarray in combined screw-ups') ;
$@ = ''; $@ = '';
eval {$x = cat(pdl(1),pdl(2,3));}; eval {$x = cat(pdl(1),pdl(2,3));};
ok(!$@, 'cat(pdl(1),pdl(2,3)) succeeds'); is($@, '', 'cat(pdl(1),pdl(2,3)) succeeds');
ok( ($x->ndims==2 and $x->dim(0)==2 and $x->dim(1)==2), 'weird cat case has the right shape'); ok( ($x->ndims==2 and $x->dim(0)==2 and $x->dim(1)==2), 'weird cat case has the right shape');
ok( all( $x == pdl([1,1],[2,3]) ), "cat does the right thing with catting a 0-pd l and 2-pdl together"); ok( all( $x == pdl([1,1],[2,3]) ), "cat does the right thing with catting a 0-pd l and 2-pdl together");
$@=''; $@='';
my $lo=sequence(long,5)+32766; my $lo=sequence(long,5)+32766;
my $so=sequence(short,5)+32766; my $so=sequence(short,5)+32766;
my $fl=float(sequence(5)+0.2); # different as 0.2 is an NV so now a double my $fl=float(sequence(5)+0.2); # different as 0.2 is an NV so now a double
my $by=sequence(byte,5)+253; my $by=sequence(byte,5)+253;
my @list = ($lo,$so,$fl,$by); my @list = ($lo,$so,$fl,$by);
my $c2 = cat(@list); my $c2 = cat(@list);
skipping to change at line 260 skipping to change at line 260
$y = $x->new_or_inplace("float,long"); $y = $x->new_or_inplace("float,long");
ok($y->type eq 'float',"new_or_inplace returns the first type in case of no matc h"); ok($y->type eq 'float',"new_or_inplace returns the first type in case of no matc h");
$y = $x->inplace->new_or_inplace; $y = $x->inplace->new_or_inplace;
$y++; $y++;
ok(all($y==$x),"new_or_inplace returns the original thing if inplace is set"); ok(all($y==$x),"new_or_inplace returns the original thing if inplace is set");
ok(!($y->is_inplace),"new_or_inplace clears the inplace flag"); ok(!($y->is_inplace),"new_or_inplace clears the inplace flag");
# check reshape and dims. While we're at it, check null & empty creation too. # check reshape and dims. While we're at it, check null & empty creation too.
my $empty = zeroes(0); my $empty = empty();
is $empty->type->enum, 0, 'empty() gives lowest-numbered type';
is empty(float)->type, 'float', 'empty(float) works';
ok($empty->nelem==0,"you can make an empty PDL with zeroes(0)"); ok($empty->nelem==0,"you can make an empty PDL with zeroes(0)");
ok("$empty" =~ m/Empty/, "an empty PDL prints 'Empty'"); ok("$empty" =~ m/Empty/, "an empty PDL prints 'Empty'");
my $null = null; my $null = null;
is $null->info, 'PDL->null', "null ndarray's info is 'PDL->null'"; is $null->info, 'PDL->null', "null ndarray's info is 'PDL->null'";
my $mt_info = $empty->info; my $mt_info = $empty->info;
$mt_info =~m/\[([\d,]+)\]/; $mt_info =~m/\[([\d,]+)\]/;
my $mt_info_dims = pdl("$1"); my $mt_info_dims = pdl("$1");
ok(any($mt_info_dims==0), "empty ndarray's info contains a 0 dimension"); ok(any($mt_info_dims==0), "empty ndarray's info contains a 0 dimension");
ok($null->isnull, "a null ndarray is null"); ok($null->isnull, "a null ndarray is null");
ok($null->isempty, "a null ndarray is empty") or diag $null->info; ok($null->isempty, "a null ndarray is empty") or diag $null->info;
ok(!$empty->isnull, "an empty ndarray is not null"); ok(!$empty->isnull, "an empty ndarray is not null");
ok($empty->isempty, "an empty ndarray is empty"); ok($empty->isempty, "an empty ndarray is empty");
$x = short pdl(3,4,5,6); $x = short pdl(3,4,5,6);
eval { $x->reshape(2,2);}; eval { $x->reshape(2,2);};
ok(!$@,"reshape succeeded in the normal case"); is($@, '', "reshape succeeded in the normal case");
ok( ( $x->ndims==2 and $x->dim(0)==2 and $x->dim(1)==2 ), "reshape did the right thing"); ok( ( $x->ndims==2 and $x->dim(0)==2 and $x->dim(1)==2 ), "reshape did the right thing");
ok(all($x == short pdl([[3,4],[5,6]])), "reshape moved the elements to the right place"); ok(all($x == short pdl([[3,4],[5,6]])), "reshape moved the elements to the right place");
$y = $x->slice(":,:"); $y = $x->slice(":,:");
eval { $y->reshape(4); }; eval { $y->reshape(4); };
ok( $@ !~ m/Can\'t/, "reshape doesn't fail on a PDL with a parent" ); ok( $@ !~ m/Can\'t/, "reshape doesn't fail on a PDL with a parent" );
{ {
my $pb = double ones(2,3); my $pb = double ones(2,3);
my $ind = 1; my $ind = 1;
 End of changes. 10 change blocks. 
18 lines changed or deleted 19 lines changed or added
To the Perl Test Programs section of the PDL source changes report or the top of this page
Mainly generated by pkgdiff using rfcdiff
Home  |  About  |  Features  |  All  |  Newest  |  Dox  |  Diffs  |  RSS Feeds  |  Screenshots  |  Comments  |  Imprint  |  Privacy  |  HTTP(S)