Ops::assgn now propagates its badflag without needing to set output b…

…adflag - improve #29 #51

Basic/Core/pdlapi.c

@@ -3,12 +3,17 @@
 #include "pdl.h"      /* Data structure declarations */
 #include "pdlcore.h"  /* Core declarations */
 
-#define VTABLE_OR_DEFAULT(what, trans, func, default_func) \
+#define VTABLE_OR_DEFAULT(what, trans, is_fwd, func, default_func) \
   do { \
     PDLDEBUG_f(printf("VTOD call " #func "(%p=%s)\n", trans, trans->vtable->name)); \
     what(PDL_err, ((trans)->vtable->func \
       ? (trans)->vtable->func \
       : pdl_ ## default_func)(trans)); \
+    pdl **pdls = trans->pdls; \
+    PDL_Indx i, istart = is_fwd ? trans->vtable->nparents : 0, iend = is_fwd ? trans->vtable->npdls : trans->vtable->nparents; \
+    for (i = istart; i < iend; i++) \
+      if (pdls[i] && (pdls[i]->state & PDL_BADVAL)) \
+        pdl_propagate_badflag(pdls[i], !!(pdls[i]->state & PDL_BADVAL)); \
   } while (0)
 
 #define REDODIMS(what, trans) do { \
@@ -26,8 +31,8 @@
       ? (trans)->vtable->redodims \
       : pdl_redodims_default)(trans)); \
   } while (0)
-#define READDATA(trans) VTABLE_OR_DEFAULT(PDL_ACCUMERROR, trans, readdata, readdata_affine)
-#define WRITEDATA(trans) VTABLE_OR_DEFAULT(PDL_ACCUMERROR, trans, writebackdata, writebackdata_affine)
+#define READDATA(trans) VTABLE_OR_DEFAULT(PDL_ACCUMERROR, trans, 1, readdata, readdata_affine)
+#define WRITEDATA(trans) VTABLE_OR_DEFAULT(PDL_ACCUMERROR, trans, 0, writebackdata, writebackdata_affine)
 #define FREETRANS(trans, destroy) \
     if(trans->vtable->freetrans) { \
 	PDLDEBUG_f(printf("call freetrans\n")); \

Basic/Ops/ops.pd

@@ -466,24 +466,16 @@ pp_def(
        GenericTypes => $A,
        Pars => 'a(); [o]b();',
        Code => pp_line_numbers(__LINE__-1, q{
-	    PDL_IF_BAD(if ( $ISBAD(a()) ) $SETBAD(b()); else,)
+	  char anybad = 0;
+	  broadcastloop %{
+	    PDL_IF_BAD(if ( $ISBAD(a()) ) { anybad = 1; $SETBAD(b()); } else,)
 	       $b() = $a();
+	  %}
+	  PDL_IF_BAD(if (anybad) $PDLSTATESETBAD(b);,)
        }),
        Doc =>
 'Plain numerical assignment. This is used to implement the ".=" operator',
-		BadDoc =>
-'If C<a> is a child ndarray (e.g., the result of a slice) and bad values are generated in C<b>,
-the bad value flag is set in C<b>, but it is B<NOT> automatically propagated back to the parent of C<a>.
-The following idiom ensures that the badflag is propagated back to the parent of C<a>:
-
- $pdl->slice(":,(1)") .= PDL::Bad_aware_func();
- $pdl->badflag(1);
- $pdl->check_badflag();
-
-This is unnecessary if $pdl->badflag is known to be 1 before the slice is performed.
-
-See http://pdl.perl.org/PDLdocs/BadValues.html#dataflow_of_the_badflag for details.'
-); # pp_def assgn
+);
 
 # special functions for complex data types that don't work well with
 # the ufunc/bifunc logic

Changes

@@ -1,5 +1,6 @@
 - move Math::badmask to Bad
 - PDL.propagate_badflag propagates both to parents AND children, sets flag itself
+- Ops::assgn now propagates its badflag without needing to set output badflag
 
 2.078 2022-04-10
 - Ops::atan2 etc have default swap param

t/ops.t

@@ -293,7 +293,6 @@ my $startgood = sequence(10);
 my $hasbad = sequence(5);
 $hasbad->inplace->setvaltobad(3);
 $startgood->slice('0:4') .= $hasbad;
-$startgood->badflag(1);
 ok $startgood->badflag, 'startgood badflag now true';
 ok $startgood->nbad == 1, 'badflag propagation with .=';
 }

t/ufunc.t

@@ -118,8 +118,8 @@ EOF
  ok($x->min == $y->min, "min with NaNs");
  ok($x->max == $y->max, "max with NaNs");
 }
-my $empty = which(ones(5)>5);
-$x = $empty->double->maximum;
+my $empty = empty();
+$x = $empty->maximum;
 ok( $x->nelem==1, "maximum over an empty dim yields 1 value");
 is $x.'', 'BAD', "max of empty nonbad float gives BAD";