"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "t/core.t" between
PDL-2.082.tar.gz and PDL-2.083.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.082):core.t  (PDL-2.083)
skipping to change at line 26 skipping to change at line 26
ok defined pdl($type, 0), "constructing PDL of type $type"; ok defined pdl($type, 0), "constructing PDL of type $type";
} }
{ {
my $p = sequence(100); # big enough to not fit in "value" field my $p = sequence(100); # big enough to not fit in "value" field
my $ref = $p->get_dataref; my $ref = $p->get_dataref;
$p->reshape(3); # small enough now $p->reshape(3); # small enough now
$p->upd_data; $p->upd_data;
} }
for (@PDL::Core::EXPORT_OK) {
next if $_ eq 'mslice'; # bizarrely, this is callable but not "defined"
no strict 'refs';
ok defined &{"PDL::Core::$_"}, "PDL::Core-exported $_ exists";
}
is sequence(3,2)->dup(0, 2).'', ' is sequence(3,2)->dup(0, 2).'', '
[ [
[0 1 2 0 1 2] [0 1 2 0 1 2]
[3 4 5 3 4 5] [3 4 5 3 4 5]
] ]
', 'dup'; ', 'dup';
is sequence(3,2)->dupN(2, 3).'', ' is sequence(3,2)->dupN(2, 3).'', '
[ [
[0 1 2 0 1 2] [0 1 2 0 1 2]
skipping to change at line 222 skipping to change at line 228
is $@, ''; is $@, '';
ok all(pdl($y->dims)==pdl(2,1,1,2)), "concatenating an empty and a scalar on the right works"; ok all(pdl($y->dims)==pdl(2,1,1,2)), "concatenating an empty and a scalar on the right works";
eval { $y = pdl(5,$x) }; eval { $y = pdl(5,$x) };
is $@, ''; is $@, '';
ok all(pdl($y->dims)==pdl(2,1,1,2)), "concatenating an empty and a scalar 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");
# 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'); isnt($@, '', '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));
eval {cat(pdl(1,2,3,4,5), $two_dim_array, pdl(1,2,3,4,5), pdl(1,2,3))}; eval {cat(pdl(1,2,3,4,5), $two_dim_array, pdl(1,2,3,4,5), pdl(1,2,3))};
ok ($@ ne '', 'cat barfs on mismatched ndarrays'); isnt($@, '', 'cat barfs on mismatched ndarrays');
like($@, qr/The dimensions of arguments 1 and 3 do not match/ like($@, qr/The dimensions of arguments 1 and 3 do not match/
, 'cat identifies all ndarrays with differing dimensions'); , 'cat identifies all ndarrays with differing dimensions');
like ($@, qr/\(argument 0\)/, 'cat identifies the first actual ndarray in the ar g list'); like ($@, qr/\(argument 0\)/, 'cat identifies the first actual ndarray in the ar g list');
$@ = '';
eval {cat(pdl(1,2,3), pdl(1,2))}; eval {cat(pdl(1,2,3), pdl(1,2))};
like($@, qr/The dimensions of argument 1 do not match/ like($@, qr/The dimensions of argument 1 do not match/
, 'cat uses good grammar when discussing ndarray dimension mismatches'); , 'cat uses good grammar when discussing ndarray dimension mismatches');
$@ = '';
eval {cat(1, pdl(1,2,3), $two_dim_array, 4, {}, pdl(4,5,6), pdl(7))}; eval {cat(1, pdl(1,2,3), $two_dim_array, 4, {}, pdl(4,5,6), pdl(7))};
ok ($@ ne '', 'cat barfs combined screw-ups'); isnt($@, '', '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));};
is($@, '', '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'); is_deeply [$x->dims], [2,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=sequence(float,5)+float(0.2); # 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);
is($c2->type,'float','concatenating different datatypes returns the highest type '); is($c2->type,'float','concatenating different datatypes returns the highest type ');
ok(all($_==shift @list),"cat/dog symmetry for values") for $c2->dog; ok(all($_==shift @list),"cat/dog symmetry for values") for $c2->dog;
my ($dogcopy) = $c2->dog({Break=>1}); my ($dogcopy) = $c2->dog({Break=>1});
$dogcopy++; $dogcopy++;
ok all($dogcopy != $c2->slice(':,(0)')), 'Break means copy'; # not lo as cat no flow ok all($dogcopy != $c2->slice(':,(0)')), 'Break means copy'; # not lo as cat no flow
my ($dogslice) = $c2->dog; my ($dogslice) = $c2->dog;
$dogslice->dump; $dogslice->dump;
 End of changes. 12 change blocks. 
11 lines changed or deleted 11 lines changed or added

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