xforms select datatype from outputs only if can - #511

Changes

@@ -40,6 +40,7 @@
 - Core::trans_children in scalar context now returns how many
 - add Pars type-spec "!complex" which makes it an error to supply complex values (#511)
 - fix xform datatype selection when "real" or "complex" (#511)
+- xforms now select datatype from outputs only if can (#511)
 
 2.095 2024-11-03
 - add PDL_GENTYPE_IS_{REAL,FLOATREAL,COMPLEX,SIGNED,UNSIGNED}_##ppsym (#502)

lib/PDL/Core/pdlapi.c

@@ -1118,21 +1118,23 @@ static inline pdl_error pdl__transtype_select(
   }
   char type_avail[PDL.ntypes]; for (i=0; i<PDL.ntypes; i++) type_avail[i] = 0;
   pdl_datatypes last_dtype = PDL_INVALID;
-  for (i=0; vtable->gentypes[i]!=-1; i++)
+  for (i=0; vtable->gentypes[i] != PDL_INVALID; i++)
     type_avail[last_dtype = vtable->gentypes[i]] = 1;
   if (vtable->gentypes[0] == last_dtype) {
     *retval = vtable->gentypes[0]; /* only one allowed type, use that */
     return PDL_err;
   }
-  for (i=0; i<vtable->npdls; i++) {
+  for (i=vtable->npdls-1; i>= 0; i--) {
     pdl *pdl = trans->pdls[i];
-    if (pdl->state & PDL_NOMYDIMS) continue;
     short flags = vtable->par_flags[i];
-    if (flags & (PDL_PARAM_ISIGNORE|PDL_PARAM_ISTYPED|PDL_PARAM_ISCREATEALWAYS))
-      continue;
-    pdl_datatypes new_transtype = PDL_TYPE_ADJUST_FROM_SUPPLIED(pdl->datatype, flags);
-    if (*retval >= new_transtype) continue;
-    *retval = new_transtype;
+    if (!(pdl->state & PDL_NOMYDIMS) &&
+      !(flags & (PDL_PARAM_ISIGNORE|PDL_PARAM_ISTYPED|PDL_PARAM_ISCREATEALWAYS))
+    ) {
+      pdl_datatypes new_transtype = PDL_TYPE_ADJUST_FROM_SUPPLIED(pdl->datatype, flags);
+      if (new_transtype != PDL_INVALID && type_avail[new_transtype] && *retval < new_transtype)
+        *retval = new_transtype;
+    }
+    if (i == vtable->nparents && *retval != PDL_INVALID) return PDL_err;
   }
   if (*retval == PDL_INVALID || !type_avail[*retval]) *retval = last_dtype;
   return PDL_err;

t/core.t

@@ -835,11 +835,10 @@ is $o_double->trans_parent->vtable->name, 'PDL::Ops::plus', 'right trans_parent
 is 0+$o_double->trans_children, 0, '0 trans_children on output from flowing';
 
 PDL::plus(my $i_double = double(1)->flowing, double(2), $o_float = float(0), 0);
-is +($i_double->trans_children)[0]->vtable->name, 'PDL::Ops::plus', 'current trans_children[0] is NOT convert on input from flowing output type < inputs';
-is_pdl $o_float, float(0), 'current output wrongly 0 from flowing output type < inputs';
-is $o_float->trans_parent, undef, 'current no trans_parent from flowing output type < inputs';
-is 0+$o_float->trans_children, 1, 'current 1 trans_children from flowing output type < inputs';
-is +($o_float->trans_children)[0]->vtable->name, 'converttypei_new', 'current trans_children[0] is convert output type < inputs';
+is +($i_double->trans_children)[0]->vtable->name, 'converttypei_new', 'input.trans_children[0] IS convert from flowing output type < inputs';
+is_pdl $o_float, float(3), 'output right from flowing output type < inputs';
+is $o_float->trans_parent->vtable->name, 'PDL::Ops::plus', 'trans_parent of output is plus from flowing output type < inputs';
+is 0+$o_float->trans_children, 0, '0 trans_children on output from flowing output type < inputs';
 
 eval {PDL::plus(double(1)->flowing, double(2), float(0)->slice(''), 0)};
 is $@, '', "current no error when flowing output to flowing xform, out type < input";
@@ -858,11 +857,7 @@ for ([\&float,\&cfloat,\&cdouble], [\&double,\&cdouble,\&cfloat], [\&ldouble,\&c
   is $@, '', 'current wrongly no error when supply output with parent to flowing '.$rt->();
   next if !$other_ct;
   czip($rt->(3)->flowing, $rt->(2), $o_cmplx = $other_ct->(0));
-  if ($other_ct->() eq 'cdouble') {
-    is_pdl $o_cmplx, $other_ct->('3+2i'), 'right answer from flowing, input '.$rt->().', supplied output '.$other_ct->();
-  } else {
-    is_pdl $o_cmplx, $other_ct->(0), 'current wrong answer from flowing, input '.$rt->().', supplied output '.$other_ct->();
-  }
+  is_pdl $o_cmplx, $other_ct->('3+2i'), 'right answer from flowing, input '.$rt->().', supplied output '.$other_ct->();
 }
 }