fixup: Handle NaN in comparison if type requires it

PDLPorters · Jul 10, 2016 · 7123a3b · 7123a3b
1 parent ca57882
commit 7123a3b
Show file tree

Hide file tree

Showing 2 changed files with 14 additions and 5 deletions.
diff --git a/Basic/Core/pdlcore.c.PL b/Basic/Core/pdlcore.c.PL
@@ -1089,13 +1089,22 @@ PDL_Indx pdl_kludge_copy_$type(PDL_Indx poff, // Offset into the dest data array
 !WITH!SUBS!
 
         # perl loop to emit code for all the PDL types -- ctype gets the C type of 
-        # the source PDL, switch_type gets the Perl name, and ppsym gets
-        # the symbol need to retrieve from a PDL_Anyval.
+        # the source PDL, switch_type gets the Perl name, ppsym gets
+        # the symbol need to retrieve from a PDL_Anyval, and type_usenan is a
+        # boolean indicating whether this type handles NaNs.
         foreach my $switch_type (keys %PDL::Types::typehash) {
 
 	    my $ctype = $PDL::Types::typehash{$switch_type}{ctype};
 	    my $stype = $PDL::Types::typehash{$switch_type}{ctype};
 	    my $ppsym = $PDL::Types::typehash{$switch_type}{ppsym};
+	    my $type_usenan = $PDL::Types::typehash{$switch_type}{usenan};
+
+	    my $comp_for_nan =
+	          $usenan && $type_usenan
+	          # if not equal, check if both are NaN
+	        ? "( !finite( (($ctype *)pptr)[i] ) && !finite(source_badval.value.$ppsym) )"
+	          # otherwise it must be false
+	        : '0';
 	    $stype =~ s/PDL_//;
 
         print OUT <<"!WITH!SUBS!";
@@ -1108,7 +1117,7 @@ PDL_Indx pdl_kludge_copy_$type(PDL_Indx poff, // Offset into the dest data array
 #if BADVAL
           if(source_pdl->has_badvalue || (source_pdl->state & PDL_BADVAL)) {
               /* Retrieve directly from .value.* instead of using ANYVAL_EQ_ANYVAL */
-              if( (($ctype *)pptr)[i] == source_badval.value.$ppsym ) {
+              if( (($ctype *)pptr)[i] == source_badval.value.$ppsym || $comp_for_nan ) {
                   /* bad value in source PDL -- use our own type's bad value instead */
                   pdata[i] = PDL.bvals.$type;
                   p->state |= PDL_BADVAL;

diff --git a/t/constructor.t b/t/constructor.t
@@ -129,14 +129,14 @@ is $p->at(1,0), $PDL::undefval, "scalar got padded OK";
 is $p->at(0,1), $pdl_v->at(0), "vector element 0 got copied OK";
 is $p->at(1,1), $pdl_v->at(1), "vector element 1 got copied OK";
 
-## A more complicated case 
+## A more complicated case
 $p = pdl($pdl_s, 5, $pdl_v, $pdl_m, [$pdl_v, $pdl_v]);
 isa_ok($p,'PDL');
 is $p->ndims(), 3, 'complicated case -> 3-d PDL';
 is $p->dim(0), 2, 'complicated case -> dim 0 is 2';
 is $p->dim(1), 2, 'complicated case -> dim 1 is 2';
 is $p->dim(2), 5, 'complicated case -> dim 1 is 5';
-@testvals = ([ [0,0,0], 2 ],   [ [1,0,0], 0 ],   [ [0,1,0], 0 ],  [ [1,1,0], 0 ], 
+@testvals = ([ [0,0,0], 2 ],   [ [1,0,0], 0 ],   [ [0,1,0], 0 ],  [ [1,1,0], 0 ],
 	     [ [0,0,1], 5 ],   [ [1,0,1], 0 ],   [ [0,1,1], 0 ],  [ [1,1,1], 0 ],
 	     [ [0,0,2], 3 ],   [ [1,0,2], 0 ],   [ [0,1,2], 4 ],  [ [1,1,2], 0 ],
 	     [ [0,0,3], 5 ],   [ [1,0,3], 6 ],   [ [0,1,3], 7 ],  [ [1,1,3], 8 ],