Skip to content
Permalink

Comparing changes

This is a direct comparison between two commits made in this repository or its related repositories. View the default comparison for this range or learn more about diff comparisons.

Open a pull request

Create a new pull request by comparing changes across two branches. If you need to, you can also . Learn more about diff comparisons here.
base repository: PDLPorters/pdl
Failed to load repositories. Confirm that selected base ref is valid, then try again.
Loading
base: 5f7e3317fd4ad54a74fea6b2cca7d93f8445de6e
Choose a base ref
..
head repository: PDLPorters/pdl
Failed to load repositories. Confirm that selected head ref is valid, then try again.
Loading
compare: 08ab73539f4d2ceb66b310bfe7408789b3b178ce
Choose a head ref
Showing with 210 additions and 129 deletions.
  1. +1 −1 lib/PDL/Ops.pd
  2. +3 −2 lib/PDL/PP.pm
  3. +2 −2 lib/PDL/PP.pod
  4. +194 −124 t/pp_pod.t
  5. +10 −0 t/ufunc.t
2 changes: 1 addition & 1 deletion lib/PDL/Ops.pd
View file
Original file line number Diff line number Diff line change
@@ -128,7 +128,7 @@ EOF
}

my $bitwise = delete $extra{Bitwise};
my $export = delete $extra{Export};
my $export = delete $extra{Export};
pp_def($name,
Pars => 'a(); b(); [o]c();',
OtherPars => 'int $swap',
5 changes: 3 additions & 2 deletions lib/PDL/PP.pm
View file
Original file line number Diff line number Diff line change
@@ -870,6 +870,7 @@ sub pp_def {
PDL::PP::_pp_addpm_nolineno($obj{PMFunc}."\n") if defined $obj{PMFunc};

print "*** Leaving pp_def for $name\n" if $::PP_VERBOSE;
\%obj;
}

# marks this module as deprecated. This handles the user warnings, and adds a
@@ -1471,7 +1472,7 @@ EOF
).";",
["overloads the Perl '$op' operator"]
];
push @vals, ["\$$ins[0] $op= \$$ins[1];", []] if $mutator;
push @vals, ["\$$ins[0] $op= \$$ins[1];", []] if $mutator && !$one_arg;
\@vals;
}),
PDL::PP::Rule::Returns->new("OverloadDocValues", []),
@@ -1507,7 +1508,7 @@ EOF
} elsif ($argorder) {
my @allouts = grep $any_out{$_} || $outca{$_}, @args;
push @argsets, map [[ @inargs[0..$_] ], \@allouts, []],
($#inargs-$noptional)..$#inargs-@allouts;
($#inargs-$noptional)..$#inargs;
push @{$argsets[-1][2]}, 'all arguments given';
unshift @{$argsets[0][2]}, "using default$plural$override" if $override;
} else {
4 changes: 2 additions & 2 deletions lib/PDL/PP.pod
View file
Original file line number Diff line number Diff line change
@@ -1870,7 +1870,7 @@ supplied. This can be overridden by supplying C<InplaceDoc>.
Overload => ['atan2', 0, 0, 1], # prefix

Implements overloading of Perl operators. Documented automatically.
A C<true> fourth element (added in PDL 2.xxx) affects the
A C<true> fourth element (added in PDL 2.100) affects the
documentation only and signals a prefix operator on two operands.

Added in PDL 2.099. Will overload in the current C<pp_bless> package,
@@ -1890,7 +1890,7 @@ to the module's export list.
By specifying a C<true> value for C<NoExport> this behaviour can be
suppressed.

Added in PDL 2.xxx.
Added in PDL 2.100.

=head3 ParamDesc

318 changes: 194 additions & 124 deletions t/pp_pod.t
View file
Original file line number Diff line number Diff line change
@@ -3,135 +3,205 @@ use warnings;

use Test::More;
use PDL::PP qw(Foo::Bar Foo::Bar foobar);
#use Data::Dump;

pp_bless('Foo::Bar');

pp_def(foo_01 =>
Pars => 'a(n)',
);

pp_def(foo_02 =>
Pars => 'a(n)',
NoExport => 1,
);

pp_def(foo_03 =>
Pars => 'a(n); [o]b(n)',
);

pp_def(foo_04 =>
Pars => 'a(n); [o]b(n)',
OtherPars => 'int k',
);

pp_def(foo_05 =>
Pars => 'a(n); b(n); [o]c(n)',
Overload => '?:',
);

pp_def(foo_06 =>
Pars => 'a(n); b(n); [o]c(n)',
Overload => ['?:', 1],
Inplace => ['a'],
);

pp_def(foo_07 =>
Pars => 'a(n); b(n); [o]c(n)',
Inplace => ['a'],
NoExport => 1,
);

pp_def(foo_08 =>
Pars => 'a(n); b(n); [o]c(n)',
Overload => ['rho', 0, 0, 1],
);

pp_def(foo_09 =>
Pars => 'a(n); b(n); [o]c(n)',
OtherPars => 'int k',
ArgOrder => [qw(a b k c)],
);

pp_def(foo_10 =>
Pars => 'a(n); [o]b(n); [o]c(n)',
);

pp_def(foo_11 =>
Pars => 'a(n); [o]b(n); [o]c(n)',
OtherPars => 'int k',
ArgOrder => [qw(a k b c)],
);

pp_done;

unlink 'foobar.xs';

my %sect;

# read generated pm file and collect sections by name
open my $fh, '<', 'foobar.pm';
while (<$fh>) {
$1 && ($sect{$1} .= $_) if /^=head2 (\w+)/ .. /^=cut/;
use Data::Dumper;
$Data::Dumper::Indent = 0;
$Data::Dumper::Terse = 1;
$Data::Dumper::Sortkeys = 1;
$Data::Dumper::Quotekeys = 0;

my $DEBUG = 0;

# call pp_def and report args
sub call_pp_def {
my $name = shift;
my %def = @_;
local *::PDLPM;
my $obj = pp_def($name => %def);
note Dumper(\%def) =~ s/^\{(.*)\}$/$1/r;
diag $obj->{PdlDoc} if $DEBUG;
$obj;
}
close $fh;
unlink 'foobar.pm';

#dd \%sect;

# search pattern in pm file:
sub qout {
my $str = quotemeta shift;
qr/^\s+$str;/m;
# search and remove pattern in generated pod:
sub find_usage {
my ($obj, $str) = @_;
$obj->{PdlDoc} =~ s/^\s+\Q$str\E;.*?$//m;
}

note 'foo_01';
ok $sect{foo_01} =~ qout('foo_01($a)'), 'function call';
ok $sect{foo_01} =~ qout('$a->foo_01'), 'method call';

note 'foo_02';
ok $sect{foo_02} =~ qout('Foo::Bar::foo_02($a)'), 'no-exp function call';
ok $sect{foo_02} =~ qout('$a->foo_02'), 'no-exp exported method call';

note 'foo_03';
ok $sect{foo_03} =~ qout('$b = foo_03($a)'), 'function call w/ arg';
ok $sect{foo_03} =~ qout('foo_03($a, $b)'), 'all arguments given';
ok $sect{foo_03} =~ qout('$b = $a->foo_03'), 'method call';

note 'foo_04';
ok $sect{foo_04} =~ qout('$b = foo_04($a, $k)'), 'function call w/ arg';
ok $sect{foo_04} =~ qout('foo_04($a, $b, $k)'), 'all arguments given';
ok $sect{foo_04} =~ qout('$b = $a->foo_04($k)'), 'method call';

note 'foo_05';
ok $sect{foo_05} =~ qout('$c = $a ?: $b'), 'biop';

note 'foo_06';
ok $sect{foo_06} =~ qout('$a ?:= $b'), 'mutator';
ok $sect{foo_06} =~ qout('foo_06($a->inplace, $b)'), 'inplace function call';
ok $sect{foo_06} =~ qout('$a->inplace->foo_06($b)'), 'inplace method call';

note 'foo_07';
ok $sect{foo_07} =~ qout('Foo::Bar::foo_07($a->inplace, $b)'), 'inplace no-exp';

note 'foo_08';
ok $sect{foo_08} =~ qout('$c = rho $a, $b'), 'prefix biop';

note 'foo_09';
ok $sect{foo_09} =~ qout('$c = foo_09($a, $b, $k)'), 'argorder function call';
ok $sect{foo_09} =~ qout('$c = $a->foo_09($b, $k)'), 'argorder method call, all args';
# all checked?
sub all_seen {
my ($obj, $str) = @_;
! ($obj->{PdlDoc} =~ /^\V*$str\V*;\V*$/m);
}

note 'foo_10';
ok $sect{foo_10} =~ qout('foo_10($a, $b, $c)'), 'multi output function call, all args';
ok $sect{foo_10} =~ qout('($b, $c) = foo_10($a)'), 'multi output function call';
ok $sect{foo_10} =~ qout('($b, $c) = $a->foo_10'), 'multi output method call';
pp_bless('Foo::Bar');

note 'foo_11';
TODO: {
local $TODO = 'multiple output';
ok $sect{foo_11} =~ qout('foo_11($a, $k, $b, $c)'), 'multi output, argorder, function call, all args';
}
ok $sect{foo_11} =~ qout('($b, $c) = foo_11($a, $k)'), 'multi output, argorder, function call';
ok $sect{foo_11} =~ qout('($b, $c) = $a->foo_11($k)'), 'multi output, argorder, method call';
subtest a => sub {
my $obj = call_pp_def(foo =>
Pars => 'a(n)',
);

ok find_usage($obj, 'foo($a)'), 'function call';
ok find_usage($obj, '$a->foo'), 'method call';
ok all_seen($obj, 'foo'), 'all seen';
};

subtest a_n => sub {
my $obj = call_pp_def(foo =>
Pars => 'a(n)',
NoExport => 1,
);
ok find_usage($obj, 'Foo::Bar::foo($a)'), 'no-exp function call';
ok find_usage($obj, '$a->foo'), 'method call';
ok all_seen($obj, 'foo'), 'all seen';
};

subtest a_b_noi => sub {
my $obj = call_pp_def(foo =>
Pars => 'a(n); [o]b(n)',
NoExport => 1,
Overload => ['foo', 1],
Inplace => ['a'],
);
ok find_usage($obj, '$b = foo $a'), 'operator';
ok find_usage($obj, '$b = foo($a)'), 'function call';
ok find_usage($obj, 'foo($a, $b)'), 'all args';
ok find_usage($obj, '$b = $a->foo'), 'method call';
ok find_usage($obj, '$a->foo($b)'), 'method, all args';
ok find_usage($obj, 'foo($a->inplace)'), 'function, inplace';
ok find_usage($obj, '$a->inplace->foo'), 'method, inplace';
ok all_seen($obj, 'foo'), 'all seen';
};

subtest a_b_oi => sub {
my $obj = call_pp_def(foo =>
Pars => 'a(n); [o]b(n)',
Overload => ['foo', 1],
Inplace => ['a'],
);
ok find_usage($obj, '$b = foo $a'), 'operator';
ok find_usage($obj, '$b = foo($a)'), 'function call';
ok find_usage($obj, 'foo($a, $b)'), 'all args';
ok find_usage($obj, '$b = $a->foo'), 'method call';
ok find_usage($obj, '$a->foo($b)'), 'method, all args';
ok find_usage($obj, 'foo($a->inplace)'), 'function, inplace';
ok find_usage($obj, '$a->inplace->foo'), 'method, inplace';
ok all_seen($obj, 'foo'), 'all seen';
};

subtest a_b => sub {
my $obj = call_pp_def(foo =>
Pars => 'a(n); [o]b(n)',
);

ok find_usage($obj, '$b = foo($a)'), 'function call w/ arg';
ok find_usage($obj, 'foo($a, $b)'), 'all arguments given';
ok find_usage($obj, '$b = $a->foo'), 'method call';
ok find_usage($obj, '$a->foo($b)'), 'method call, arg';
ok all_seen($obj, 'foo'), 'all seen';
};

subtest a_b_k => sub {
my $obj = call_pp_def(foo =>
Pars => 'a(n); [o]b(n)',
OtherPars => 'int k',
);

ok find_usage($obj, '$b = foo($a, $k)'), 'function call w/ arg';
ok find_usage($obj, 'foo($a, $b, $k)'), 'all arguments given';
ok find_usage($obj, '$b = $a->foo($k)'), 'method call';
ok find_usage($obj, '$a->foo($b, $k)'), 'method call, arg';
ok all_seen($obj, 'foo'), 'all seen';
};

subtest ab_c_o => sub {
my $obj = call_pp_def(foo =>
Pars => 'a(n); b(n); [o]c(n)',
Overload => '?:',
);

ok find_usage($obj, '$c = $a ?: $b'), 'biop';
ok find_usage($obj, '$c = foo($a, $b)'), 'function';
ok find_usage($obj, 'foo($a, $b, $c)'), 'function, all args';
ok find_usage($obj, '$c = $a->foo($b)'), 'method';
ok find_usage($obj, '$a->foo($b, $c)'), 'method, all args';
ok all_seen($obj, 'foo'), 'all seen';
};

subtest ab_c_oi => sub {
my $obj = call_pp_def(foo =>
Pars => 'a(n); b(n); [o]c(n)',
Overload => ['?:', 1],
Inplace => ['a'],
);

ok find_usage($obj, '$c = $a ?: $b'), 'biop';
ok find_usage($obj, '$c = foo($a, $b)'), 'function';
ok find_usage($obj, 'foo($a, $b, $c)'), 'function, all args';
ok find_usage($obj, '$c = $a->foo($b)'), 'method';
ok find_usage($obj, '$a->foo($b, $c)'), 'method, all args';
ok find_usage($obj, '$a ?:= $b'), 'mutator';
ok find_usage($obj, 'foo($a->inplace, $b)'), 'inplace function call';
ok find_usage($obj, '$a->inplace->foo($b)'), 'inplace method call';
ok all_seen($obj, 'foo'), 'all seen';
};

subtest ab_c_ni => sub {
my $obj = call_pp_def(foo =>
Pars => 'a(n); b(n); [o]c(n)',
Inplace => ['a'],
NoExport => 1,
);

ok find_usage($obj, '$c = Foo::Bar::foo($a, $b)'), 'function';
ok find_usage($obj, 'Foo::Bar::foo($a, $b, $c)'), 'function, all args';
ok find_usage($obj, '$c = $a->foo($b)'), 'method';
ok find_usage($obj, '$a->foo($b, $c)'), 'method, all args';
ok find_usage($obj, 'Foo::Bar::foo($a->inplace, $b)'), 'inplace function call';
ok find_usage($obj, '$a->inplace->foo($b)'), 'inplace method call';
ok all_seen($obj, 'foo'), 'all seen';
};

subtest ab_c_o => sub {
my $obj = call_pp_def(foo =>
Pars => 'a(n); b(n); [o]c(n)',
Overload => ['rho', 0, 0, 1],
);

ok find_usage($obj, '$c = rho $a, $b'), 'prefix biop';
ok find_usage($obj, '$c = foo($a, $b)'), 'function';
ok find_usage($obj, 'foo($a, $b, $c)'), 'function, all args';
ok find_usage($obj, '$c = $a->foo($b)'), 'method';
ok find_usage($obj, '$a->foo($b, $c)'), 'method, all args';
ok all_seen($obj, 'foo'), 'all seen';
};

subtest ab_c_no => sub {
my $obj = call_pp_def(foo =>
Pars => 'a(n); b(n); [o]c(n)',
Overload => ['rho', 0, 0, 1],
NoExport => 1,
);

ok find_usage($obj, '$c = rho $a, $b'), 'prefix biop';
ok find_usage($obj, '$c = Foo::Bar::foo($a, $b)'), 'function';
ok find_usage($obj, 'Foo::Bar::foo($a, $b, $c)'), 'function, all args';
ok find_usage($obj, '$c = $a->foo($b)'), 'method';
ok find_usage($obj, '$a->foo($b, $c)'), 'method, all args';
ok all_seen($obj, 'foo'), 'all seen';
};


subtest a_bc => sub {
my $obj = call_pp_def(foo =>
Pars => 'a(n); [o]b(n); [o]c(n)',
);

ok find_usage($obj, 'foo($a, $b, $c)'), 'multi output function call, all args';
ok find_usage($obj, '($b, $c) = foo($a)'), 'multi output function call';
ok find_usage($obj, '($b, $c) = $a->foo'), 'multi output method call';
ok find_usage($obj, '$a->foo($b, $c)'), 'method call, all args';
ok all_seen($obj, 'foo'), 'all seen';
};

done_testing;
10 changes: 10 additions & 0 deletions t/ufunc.t
View file
Original file line number Diff line number Diff line change
@@ -313,4 +313,14 @@ subtest firstnonzeroover => sub {
is_pdl $a->firstnonzeroover, pdl(3, 5), "firstnonzeroover";
};

# Some (!) of these fail when exported:
subtest core_functions => sub {
ok approx(sin(1), &CORE::sin(1)), 'sin 1'; # !
ok approx(cos(1), &CORE::cos(1)), 'cos 1'; # !
ok approx(sqrt(2), &CORE::sqrt(2)), 'sqrt 2'; # !
ok approx(exp(1), &CORE::exp(1)), 'exp 1';
ok approx(log(2), &CORE::log(2)), 'log 2';
ok approx(atan2(1, 1), &CORE::atan2(1, 1)), 'atan2 1, 1';
};

done_testing;