test comparisons between scalars and 0-dim PDLs with badflag == 1

This is to elucidate the issues with stat() and per-PDL badvalues brought up by Marek Gierliński in SF#390 <http://sourceforge.net/p/pdl/bugs/390/>, <#124>.
PDLPorters · Jun 21, 2015 · 4ea4d15 · 4ea4d15
1 parent e01c825
commit 4ea4d15
Showing 1 changed file with 108 additions and 0 deletions.
diff --git a/t/badvalue_scalar_cmp.t b/t/badvalue_scalar_cmp.t
@@ -0,0 +1,108 @@
+use Test::More;
+
+use strict;
+use warnings;
+
+use PDL::Config;
+
+plan skip_all => "Bad values disabled" unless $PDL::Config{WITH_BADVAL};
+
+use PDL::LiteF;
+
+## Issue information
+##
+## Name: scalar PDL with badvalue always compares BAD with perl scalars
+##
+## <http://sourceforge.net/p/pdl/bugs/390/>
+## <https://github.com/PDLPorters/pdl/issues/124>
+
+plan tests => 3;
+
+subtest "Issue example code" => sub {
+	my $x = pdl(1, 2, 3, 0);
+	$x->badflag(1);
+	$x->badvalue(0);
+	# bad value for $x is now set to 0
+
+	is( "$x", "[1 2 3 BAD]", "PDL with bad-value stringifies correctly" );
+
+	my ($m, $s) = stats($x);
+
+	is( "$m", 2, "Mean of [1 2 3] is 2" );
+	is( "$s", 1, "And std. dev is 1" );
+
+	is( "".($s >  0), "1", "is 1 >  0? -> true" );
+	is( "".($s <  0), "0", "is 1 <  0? -> false");
+	is( "".($s == 0), "0", "is 1 == 0? -> false");
+};
+
+subtest "Badvalue set on 0-dim PDL + comparision operators" => sub {
+	my $val = 2;
+	my $badval_sclr = 5;
+	my $p_val = pdl($val);
+
+	# set the bad flag to 0
+	$p_val->badflag(1);
+	$p_val->badvalue($badval_sclr);
+
+	diag "\$p_val = $p_val";
+	is( "$p_val", "$val", "Sanity test" );
+
+	subtest "Comparing a 0-dim PDL w/ a scalar should be the same as comparing a scalar w/ a scalar" => sub {
+		is
+			"".  ( $p_val <  $badval_sclr),
+			"".0+(   $val <  $badval_sclr),
+				"$val <  $badval_sclr";
+
+		is
+			"".  ($p_val == $badval_sclr),
+			"".0+(  $val == $badval_sclr),
+			       "$val == $badval_sclr";
+
+		is
+			"".  ($p_val >  $badval_sclr),
+			"".0+(  $val >  $badval_sclr),
+			       "$val >  $badval_sclr";
+	};
+
+	subtest "Comparing a 0-dim PDL w/ bad value with a 0-dim PDL without bad value set should not set BAD" => sub {
+		my $not_bad_sclr = 5;
+		my $p_not_bad = pdl($not_bad_sclr);
+		$p_not_bad->badflag(0); # should not have bad flag
+
+		my $lt_p = $p_val <  $p_not_bad;
+		is
+			"".  ( $lt_p                  ),
+			"".0+(   $val <  $not_bad_sclr),
+				"$val <  $not_bad_sclr";
+		ok ! $lt_p->badflag, "cmp for < does not set badflag";
+
+		my $eq_p = $p_val ==  $p_not_bad;
+		is
+			"".  ( $eq_p                 ),
+			"".0+(  $val == $not_bad_sclr),
+			       "$val == $not_bad_sclr";
+		ok ! $eq_p->badflag, "cmp for == does not set badflag";
+
+		my $gt_p = $p_val >  $p_not_bad;
+		is
+			"".  ( $gt_p                 ),
+			"".0+(  $val >  $not_bad_sclr),
+			       "$val >  $not_bad_sclr";
+		ok ! $gt_p->badflag, "cmp for > does not set badflag";
+	};
+};
+
+
+subtest "stats() should not set the badflag for output" => sub {
+	my $p = pdl [1, 2, 3];
+	$p->badflag(1);
+	$p->badvalue(2);
+
+	diag "\$p = $p";
+	is( "$p", "[1 BAD 3]");
+
+	my $m = stats($p);
+
+	is( "$m", "2", "Mean of [1 3] is 2" );
+};