"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).

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

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