"Fossies" - the Fresh Open Source Software Archive  

Source code changes of the file "Basic/SourceFilter/t/niceslice.t" between
PDL-2.075.tar.gz and PDL-2.076.tar.gz

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

niceslice.t  (PDL-2.075):niceslice.t  (PDL-2.076)
use strict; use strict;
use warnings; use warnings;
use Test::More; use Test::More;
use PDL::LiteF; use PDL::LiteF;
#BEGIN { $PDL::NiceSlice::debug = $PDL::NiceSlice::debug_filter = 1 }
require PDL::NiceSlice; require PDL::NiceSlice;
# these are accessible inside sub # these are accessible inside sub
my $pa = sequence 10; my $pa = sequence 10;
my $pb = pdl(1); my $pb = pdl(1);
my $c = PDL->pdl(7,6); my $c = PDL->pdl(7,6);
my $idx = pdl 1,4,5; my $idx = pdl 1,4,5;
my $rg = pdl(2,7,2); my $rg = pdl(2,7,2);
require Filter::Simple;
require PDL::NiceSlice::FilterSimple;
my $fs_like = Filter::Simple::gen_std_filter_for(code_no_comments => \&PDL::Nice
Slice::FilterSimple::code_no_comments);
$fs_like = sub { $_ = PDL::NiceSlice::findslice($_, $PDL::NiceSlice::debug_filte
r) } if $::UC;
sub translate_and_run { sub translate_and_run {
local $Test::Builder::Level = $Test::Builder::Level + 1; local $Test::Builder::Level = $Test::Builder::Level + 1;
my ($txt, $expected_error) = @_; my ($txt, $expected_error) = @_;
$expected_error ||= qr/^$/; $expected_error ||= qr/^$/;
my $retval = eval { my $retval = eval {
my $etxt = PDL::NiceSlice::findslice($txt); local $_ = $txt;
note "$txt -> \n\t$etxt\n"; $fs_like->('main');
eval $etxt; my $etxt = $_;
# note "$txt -> \n\t$etxt\n";
$etxt =~ s/^\s*print\b/die/;
my $retval = eval $etxt;
die $@ if $@;
$retval;
}; };
like $@, $expected_error; like $@, $expected_error, 'error as expected';
$retval; $retval;
} }
$pb = translate_and_run '$pa((5));'; $pb = translate_and_run '$pa((5));';
cmp_ok($pb->at, '==', 5); cmp_ok($pb->at, '==', 5);
$pb = translate_and_run '$pa->((5));'; $pb = translate_and_run '$pa->((5));';
cmp_ok($pb->at, '==', 5); cmp_ok($pb->at, '==', 5);
$pb = translate_and_run '$pa(($c(1)->at(0)));'; $pb = translate_and_run '$pa(($c(1)->at(0)));';
skipping to change at line 129 skipping to change at line 140
# foreach and embedded expression # foreach and embedded expression
$pa = ''; $pa = '';
translate_and_run 'my $t = ones 10; foreach my $type ( $t(0)->list ) { $pa .= $t ype }'; translate_and_run 'my $t = ones 10; foreach my $type ( $t(0)->list ) { $pa .= $t ype }';
is($pa, '1'); is($pa, '1');
# block method access translation # block method access translation
$pa = pdl(5,3,2); $pa = pdl(5,3,2);
$c = translate_and_run 'my $method = "dim"; $pa->$method(0)'; $c = translate_and_run 'my $method = "dim"; $pa->$method(0)';
is($c, $pa->dim(0)); is($c, $pa->dim(0));
#$PDL::NiceSlice::debug_filter = 1; translate_and_run <<'EOF';
eval { require './t/bitshift.pm' }; sub f {
is $@, '', '<<= followed by >>= not blow up NiceSlice'; my ($pa, $pb) = @_;
$pa <<= 2;
$pb >>= 1;
}
EOF
pass '<<= followed by >>= not blow up NiceSlice';
# #
# todo ones # todo ones
# #
# whitespace tolerance # whitespace tolerance
$pa= sequence 10; $pa= sequence 10;
translate_and_run '$c = $pa (0)'; translate_and_run '$c = $pa (0)';
is($c, $pa->at(0)); is($c, $pa->at(0));
skipping to change at line 164 skipping to change at line 180
$c = $pa-> # comment $c = $pa-> # comment
# comment line 2 # comment line 2
(0); (0);
EOT EOT
is($c, $pa->at(0)); is($c, $pa->at(0));
$pa = ''; # foreach and whitespace + comments $pa = ''; # foreach and whitespace + comments
translate_and_run << 'EOT'; translate_and_run << 'EOT';
foreach my $pb # a random comment thrown in foreach my $pb # a random comment thrown in
(1,2,3,4) {$pa .= $pb;} (1,2,3,4) {$pa .= $pb;}
EOT EOT
is($pa, '1234'); is($pa, '1234');
# test for correct header propagation # test for correct header propagation
$pa = ones(10,10); $pa = ones(10,10);
my $h = {NAXIS=>2, my $h = {NAXIS=>2,
NAXIS1=>100, NAXIS1=>100,
NAXIS=>100, NAXIS=>100,
COMMENT=>"Sample FITS-style header"}; COMMENT=>"Sample FITS-style header"};
$pa->sethdr($h); $pa->sethdr($h);
$pa->hdrcpy(1); $pa->hdrcpy(1);
skipping to change at line 194 skipping to change at line 206
my (@bhkeys) = sort keys %bh; my (@bhkeys) = sort keys %bh;
my %hh = %{$h}; my %hh = %{$h};
my (@hhkeys) = sort keys %hh; my (@hhkeys) = sort keys %hh;
ok(join("",@bh{@bhkeys}) eq join("",@hh{@hhkeys})); ok(join("",@bh{@bhkeys}) eq join("",@hh{@hhkeys}));
} }
$pa = ones(10); $pa = ones(10);
my $ai = translate_and_run 'my $i = which $pa < 0; $pa($i);'; my $ai = translate_and_run 'my $i = which $pa < 0; $pa($i);';
ok(isempty $ai ); ok(isempty $ai );
translate_and_run <<'EOF';
my $p = {y => 1};
{ $pa=ones(3,3,3); my $f = do { my $i=1; my $v=$$p{y}-$i; $pb = $pa(,$i,) }; }
EOF
pass 'obscure bug where "y" treated as tr/// in 2-deep {}';
if (!$::UC) {
# this is broken in the FilterUtilCall module so don't test it
my $expected = q{
CREATE TABLE $table (
CHECK ( yr = $yr )
) INHERITS ($schema.master_table)
};
my $got = translate_and_run 'q{
CREATE TABLE $table (
CHECK ( yr = $yr )
) INHERITS ($schema.master_table)
}';
is $got, $expected, 'NiceSlice leaves strings along';
}
{ {
my $expected = q{
CREATE TABLE $table (
CHECK ( yr = $yr )
) INHERITS ($schema.master_table)
};
use PDL::NiceSlice; use PDL::NiceSlice;
my $got = q{ if (!$::UC) {
CREATE TABLE $table (
CHECK ( yr = $yr )
) INHERITS ($schema.master_table)
};
is $got, $expected, 'NiceSlice leaves strings along';
if (!($::UC = $::UC)) {
my $data = join '', <DATA>; my $data = join '', <DATA>;
like $data, qr/we've got data/, "we've got data"; like $data, qr/we've got data/, "we've got data";
} }
} }
done_testing; done_testing;
__DATA__ __DATA__
we've got data we've got data
 End of changes. 12 change blocks. 
24 lines changed or deleted 47 lines changed or added

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