badflag now not propagated back to inputs if set on outputs - #517

Author: mohawk2

Changes

@@ -24,6 +24,7 @@
 - add Ops::csqrt{,_up} (#524) - thanks @wlmb
 - Core::upd_data now sets DATACHANGED so will work for flowing ops
 - remove CopyBadStatusCode key from PP (#517)
+- badflag now not propagated back to inputs if set on outputs (#517)
 
 2.098 2025-01-03
 - fix Windows build problems

lib/PDL/Bad.pd

@@ -820,9 +820,7 @@ EOF
       $GENERIC(b) a_val = $a();
       $b() = PDL_IF_BAD($ISBADVAR(a_val,a) ? replace : ,) a_val;
     %}
-    char input_was_bad = !!$PDLSTATEISBAD(a);
-    PDL->propagate_badflag( $PDL(b), 0 ); /* always make sure the output is "good" */
-    if (input_was_bad && $PDL(a) != $PDL(b)) $PDLSTATESETBAD(a);
+    PDL->propagate_badflag_dir($PDL(b), 0, 1, 1); /* always make sure the output is "good" */
   },
   NewXSFindBadStatusNS => <<'EOF',
 PDL_RETERROR(PDL_err, PDL->trans_check_pdls(__privtrans));

lib/PDL/Core.xs

@@ -1171,8 +1171,11 @@ badflag(x,newval=0)
     pdl *x
     int newval
   CODE:
-    if (items>1)
-	pdl_propagate_badflag( x, newval );
+    if (items>1) {
+      if (x->trans_parent)
+        pdl_propagate_badflag_dir(x, newval, 0, 1);
+      pdl_propagate_badflag_dir(x, newval, 1, 1);
+    }
     RETVAL = ((x->state & PDL_BADVAL) > 0);
   OUTPUT:
     RETVAL

lib/PDL/Core/pdlapi.c

@@ -24,7 +24,7 @@ extern Core PDL; /* for PDL_TYPENAME */
       PDLDEBUG_f(printf("VTOD " #func " child=%p turning off datachanged, before=", child); pdl_dump_flags_fixspace(child->state, 0, PDL_FLAGS_PDL)); \
       if (is_fwd) child->state &= ~PDL_PARENTDATACHANGED; \
       if (child && (child->state & PDL_BADVAL)) \
-        pdl_propagate_badflag(child, !!(child->state & PDL_BADVAL)); \
+        pdl_propagate_badflag_dir(child, !!(child->state & PDL_BADVAL), is_fwd, 1); \
     } \
   } while (0)
 #define READDATA(trans) VTABLE_OR_DEFAULT(PDL_ACCUMERROR, trans, 1, readdata, readdata_affine)
@@ -1029,30 +1029,45 @@ pdl_error pdl_sever(pdl *src)
     return PDL_err;
 }
 
-#define PDL_MAYBE_PROPAGATE_BADFLAG(t, newval) \
-  for ( i = 0; i < (t)->vtable->npdls; i++ ) { \
-    pdl *tpdl = (t)->pdls[i]; \
-    /* make sure we propagate if changed */ \
-    if (!!newval != !!(tpdl->state & PDL_BADVAL)) \
-      pdl_propagate_badflag( tpdl, newval ); \
-  }
-
+#define PDL_MAYBE_PROPAGATE_BADFLAG(t, newval, is_fwd) do { \
+    pdl_transvtable *vtable = (t)->vtable; \
+    PDL_Indx i, istart = is_fwd ? vtable->nparents : 0, iend = is_fwd ? vtable->npdls : vtable->nparents; \
+    for (i = istart; i < iend; i++) { \
+      pdl *tpdl = (t)->pdls[i]; \
+      /* make sure we propagate if changed */ \
+      if (!!newval != !!(tpdl->state & PDL_BADVAL)) \
+        pdl_propagate_badflag_dir(tpdl, newval, is_fwd, recurse_count + 1); \
+    } \
+  } while (0)
 /* newval = 1 means set flag, 0 means clear it */
-void pdl_propagate_badflag( pdl *it, int newval ) {
-    PDLDEBUG_f(printf("pdl_propagate_badflag pdl=%p newval=%d\n", it, newval));
-    PDL_Indx i, j;
-    if (newval)
-	it->state |=  PDL_BADVAL;
-    else
-	it->state &= ~PDL_BADVAL;
+pdl_error pdl_propagate_badflag_dir(pdl *it, int newval, char is_fwd, int recurse_count) {
+  PDL_RECURSE_CHECK(recurse_count);
+  PDLDEBUG_f(printf("pdl_propagate_badflag_dir pdl=%p newval=%d is_fwd=%d\n", it, newval, (int)is_fwd));
+  pdl_error PDL_err = {0, NULL, 0};
+  if (newval)
+    it->state |=  PDL_BADVAL;
+  else
+    it->state &= ~PDL_BADVAL;
+  if (!is_fwd) {
     if (it->trans_parent)
-	PDL_MAYBE_PROPAGATE_BADFLAG(it->trans_parent, newval)
+      PDL_MAYBE_PROPAGATE_BADFLAG(it->trans_parent, newval, 0);
+  } else {
+    PDL_Indx j;
+    if (
+      (it->state & (PDL_OPT_VAFFTRANSOK|PDL_ALLOCATED)) == PDL_OPT_VAFFTRANSOK && /* pure vaff */
+      newval /* expansive - if slice gets badflag, whole does */
+    )
+      pdl_propagate_badflag_dir(it->vafftrans->from, newval, 1, recurse_count + 1);
     for (j = 0; j < it->ntrans_children_allocated; j++) {
       pdl_trans *trans = it->trans_children[j];
       if (!trans) continue;
-      trans->bvalflag = !!newval;
-      PDL_MAYBE_PROPAGATE_BADFLAG(trans, newval)
+      PDL_MAYBE_PROPAGATE_BADFLAG(trans, newval, 1);
     }
+  }
+  return PDL_err;
+}
+void pdl_propagate_badflag(pdl *it, int newval) { /* CORE21 get rid */
+  return; /* nerfed as replaced with directional version */
 }
 
 /*CORE21 use pdl_error, replace fprintf*/

lib/PDL/Core/pdlcore.h

@@ -159,6 +159,7 @@ void pdl_dump_anyval(PDL_Anyval v);
   X(unpackpdls, SV*, ( pdl **, PDL_Indx npdls )) \
   X(packstrings, char **, ( SV* sv, PDL_Indx *nstrings )) \
   X(prealloc_trans_children, pdl_error, (pdl *it, PDL_Indx howmany)) \
+  X(propagate_badflag_dir, pdl_error, (pdl *it, int newval, char is_fwd, int recurse_count)) \
 
 /*************** Function prototypes *********************/
 #define X(sym, rettype, args) \

lib/PDL/Ops.pd

@@ -371,8 +371,8 @@ pp_def(
        Code => pp_line_numbers(__LINE__-1, q{
 PDL_IF_BAD(char anybad = 0;,)
 broadcastloop %{
-  PDL_IF_BAD(if ( $ISBAD(a()) ) { anybad = 1; $SETBAD(b()); } else,)
-    $b() = $a();
+  PDL_IF_BAD(if ($ISBAD(a())) { anybad = 1; $SETBAD(b()); continue; },)
+  $b() = $a();
 %}
 PDL_IF_BAD(if (anybad) $PDLSTATESETBAD(b);,)
        }),

t/bad.t

@@ -184,7 +184,7 @@ is_pdl $s[2], pdl(66.5), "setbadif/stats test 3";
 is_pdl $s[3], pdl(22), "setbadif/stats test 4";
 is_pdl $s[4], pdl(98), "setbadif/stats test 5";
 is_pdl $s[6], pdl(26.7312), abstol("setbadif/stats test 6");
-ok $x->badflag, 'badflag wrongly set on input after setbadif';
+ok !$x->badflag, 'badflag not set on input after setbadif';
 
 # how about setbadtoval
 empty()->setbadtoval(20); # shouldn't segfault