From 3e366065bb34e04f3361d8b560578236b986a11e Mon Sep 17 00:00:00 2001 From: Ed J Date: Fri, 27 Dec 2024 02:06:34 +0000 Subject: [PATCH] error to specify Inplace between differently-typed Pars - #511 --- Changes | 1 + lib/PDL/Math.pd | 27 ++++++++++++--------------- lib/PDL/Ops.pd | 2 +- lib/PDL/PP.pm | 21 +++++++++++++-------- lib/PDL/Primitive.pd | 2 +- t/primitive-misc.t | 2 +- 6 files changed, 29 insertions(+), 26 deletions(-) diff --git a/Changes b/Changes index 56bf4cd73..8f60448b8 100644 --- a/Changes +++ b/Changes @@ -42,6 +42,7 @@ - fix xform datatype selection when "real" or "complex" (#511) - xforms now select datatype from outputs only if can (#511) - xforms now give error if supply output with trans_parent needing converting (#511) +- now an error to specify Inplace between differently-typed Pars (#511) 2.095 2024-11-03 - add PDL_GENTYPE_IS_{REAL,FLOATREAL,COMPLEX,SIGNED,UNSIGNED}_##ppsym (#502) diff --git a/lib/PDL/Math.pd b/lib/PDL/Math.pd index bad7ddea4..5e07f6057 100644 --- a/lib/PDL/Math.pd +++ b/lib/PDL/Math.pd @@ -307,26 +307,24 @@ elsif ($Config{cc} =~ /\bgcc/i) { ); } # elsif: cc =~ /\bgcc/i -pp_def( - 'isfinite', - Pars => 'a(); int [o]mask();', - Inplace => 1, - HandleBad => 1, - Code =>' +pp_def('isfinite', + Pars => 'a(); [o]mask();', + Inplace => 1, + HandleBad => 1, + Code => <<'EOF', broadcastloop %{ - $mask() = isfinite((double) $a()) != 0 PDL_IF_BAD(&& $ISGOOD($a()),); + $mask() = isfinite((double) $a()) != 0 PDL_IF_BAD(&& $ISGOOD($a()),); %} $PDLSTATESETGOOD(mask); - ', - Doc => +EOF + Doc => 'Sets C<$mask> true if C<$a> is not a C or C (either positive or negative). Works inplace.', - BadDoc => + BadDoc => 'Bad values are treated as C or C.', - ); +); # Extra functions from cephes -pp_def( - "erfi", +pp_def("erfi", HandleBad => 1, NoBadifNaN => 1, GenericTypes => $F, @@ -339,8 +337,7 @@ pp_def( else,) { $b() = SQRTH*ndtri((1+(double)$a())/2); }', ); -pp_def( - "ndtri", +pp_def("ndtri", HandleBad => 1, NoBadifNaN => 1, GenericTypes => $F, diff --git a/lib/PDL/Ops.pd b/lib/PDL/Ops.pd index 60ee313f0..0dab8423a 100644 --- a/lib/PDL/Ops.pd +++ b/lib/PDL/Ops.pd @@ -479,7 +479,7 @@ sub cfunc { Pars => 'complexv(); '.($make_real ? 'real' : '').' [o]b()', HandleBad => 1, NoBadifNaN => 1, - Inplace => 1, + ($make_real ? () : (Inplace => 1)), Code => pp_line_numbers(__LINE__-1, qq{ PDL_IF_BAD(if ( \$ISBAD(complexv()) ) \$SETBAD(b()); else,) $codestr diff --git a/lib/PDL/PP.pm b/lib/PDL/PP.pm index 81d6c5257..8232826bc 100644 --- a/lib/PDL/PP.pm +++ b/lib/PDL/PP.pm @@ -1394,7 +1394,7 @@ EOD sub { PDL::PP::Signature->new('', @_[0,1], join(';', grep defined() && /[^\s;]/, @_[2..$#_])) }), PDL::PP::Rule->new("CompStruct", ["CompObj"], sub {$_[0]->getcomp}), - PDL::PP::Rule->new("InplaceNormalised", ["SignatureObj","Inplace"], + PDL::PP::Rule->new("InplaceNormalised", [qw(Name SignatureObj Inplace)], 'interpret Inplace and Signature to get input/output', # Inplace can be supplied several values # => 1 @@ -1406,7 +1406,7 @@ EOD # input ndarray is a(), output ndarray is 'b' # this will set InplaceNormalised to [input,output] sub { - my ($sig, $arg) = @_; + my ($name, $sig, $arg) = @_; confess 'Inplace given false value' if !$arg; confess "Inplace array-ref (@$arg) > 2 elements" if ref($arg) eq "ARRAY" and @$arg > 2; # find input and output ndarrays @@ -1419,23 +1419,28 @@ EOD $in = $$arg[0]; $out = $$arg[1] if @$arg > 1; } - confess "ERROR: Inplace does not know name of input ndarray" + confess "ERROR in pp_def($name): Inplace does not know name of input ndarray" unless defined $in; - confess "ERROR: Inplace input ndarray '$in' is actually output" + confess "ERROR in pp_def($name): Inplace input ndarray '$in' is actually output" if $is_out{$in}; - confess "ERROR: Inplace does not know name of output ndarray" + confess "ERROR in pp_def($name): Inplace does not know name of output ndarray" unless defined $out; my ($in_obj, $out_obj) = map $sig->objs->{$_}, $in, $out; - confess "ERROR: Inplace output arg $out not [o]\n" if !$$out_obj{FlagW}; + confess "ERROR in pp_def($name): Inplace output arg $out not [o]\n" if !$$out_obj{FlagW}; my ($in_inds, $out_inds) = map $_->{IndObjs}, $in_obj, $out_obj; - confess "ERROR: Inplace args $in and $out different number of dims" + confess "ERROR in pp_def($name): Inplace args $in and $out different number of dims" if @$in_inds != @$out_inds; for my $i (0..$#$in_inds) { my ($in_ind, $out_ind) = map $_->[$i], $in_inds, $out_inds; next if grep !defined $_->{Value}, $in_ind, $out_ind; - confess "ERROR: Inplace Pars $in and $out inds ".join('=',@$in_ind{qw(Name Value)})." and ".join('=',@$out_ind{qw(Name Value)})." not compatible" + confess "ERROR in pp_def($name): Inplace Pars $in and $out inds ".join('=',@$in_ind{qw(Name Value)})." and ".join('=',@$out_ind{qw(Name Value)})." not compatible" if $in_ind->{Value} != $out_ind->{Value}; } + my ($in_flags, $out_flags) = map [grep /^FlagType/, keys %$_], $in_obj, $out_obj; + confess "ERROR in pp_def($name): Inplace args $in and $out have different type specifications" + if "@$in_flags" ne "@$out_flags" or + "@$in_obj{@$in_flags}" ne "@$out_obj{@$out_flags}" or + ($in_obj->{Type}//'NONE') ne ($out_obj->{Type}//'NONE'); [$in, $out]; }), PDL::PP::Rule->new(["InplaceCode"], [qw(InplaceNormalised)], diff --git a/lib/PDL/Primitive.pd b/lib/PDL/Primitive.pd index d148804dd..1b5ba7383 100644 --- a/lib/PDL/Primitive.pd +++ b/lib/PDL/Primitive.pd @@ -1410,7 +1410,7 @@ broadcastloop %{ ########################################################### pp_def('fibonacci', - Pars => 'i(n); indx [o]x(n)', + Pars => 'i(n); [o]x(n)', Inplace => 1, GenericTypes => [ppdefs_all], Doc=>'Constructor - a vector with Fibonacci\'s sequence', diff --git a/t/primitive-misc.t b/t/primitive-misc.t index a11727d64..2a1406558 100644 --- a/t/primitive-misc.t +++ b/t/primitive-misc.t @@ -34,7 +34,7 @@ subtest glue => sub { }; subtest 'fibonacci' => sub { - is_pdl fibonacci(15), indx('1 1 2 3 5 8 13 21 34 55 89 144 233 377 610'), 'Fibonacci sequence'; + is_pdl fibonacci(15), pdl('1 1 2 3 5 8 13 21 34 55 89 144 233 377 610'), 'Fibonacci sequence'; }; subtest 'indadd' => sub {