error to specify Inplace between differently-typed Pars - #511

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)

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<NaN> or C<inf> (either positive or negative). Works inplace.',
-       BadDoc =>
+  BadDoc =>
 'Bad values are treated as C<NaN> or C<inf>.',
-       );
+);
 
 # 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,

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

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)],

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',

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 {