Fix for string parsing and dimension handling (fixes SF#367)

There was a logic error where ->setdims([]) would get called when trying to remove the outermost dimension, but this would run after using clump() on a string that had a single value and ->dims() == 1. This also fixes the BAD value parsing bug in SF#367 which led to an incorrect BAD value when parsing the string "[BAD]". See <http://sourceforge.net/p/pdl/bugs/367/>, <#47>.
PDLPorters · Mar 7, 2015 · 95346c8 · 95346c8
1 parent b4d6f04
commit 95346c8
Show file tree

Hide file tree

Showing 2 changed files with 53 additions and 6 deletions.
diff --git a/Basic/Core/Core.pm b/Basic/Core/Core.pm
@@ -1100,12 +1100,15 @@ sub PDL::Core::new_pdl_from_string {
 
    if (ref $val eq 'ARRAY') {
       my $to_return = PDL::Core::pdl_avref($val,$this,$type);
-      # remove potentially spurious last dimension
-      $to_return = $to_return->mv(-1,1)->clump(2)
-         if $to_return->dims > 1 and $to_return->dim(-1) == 1;
-      # fix scalar values
-      $to_return->setdims([])
-         if $to_return->dims == 1 and $to_return->dim(-1) == 1;
+      if( $to_return->dim(-1) == 1 ) {
+	      if( $to_return->dims > 1 ) {
+		      # remove potentially spurious last dimension
+		      $to_return = $to_return->mv(-1,1)->clump(2);
+	      } elsif( $to_return->dims == 1 ) {
+		      # fix scalar values
+		      $to_return->setdims([]);
+	      }
+      }
       # Mark bad if appropriate
       $to_return->badflag($has_bad > 0);
       return $to_return;

diff --git a/t/issue-sf-367.t b/t/issue-sf-367.t
@@ -0,0 +1,44 @@
+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: BAD value parsing breakage
+##
+## Parsing of BAD values fails to set the correct BAD value when parsing from
+## the string "[BAD]".
+##
+## <http://sourceforge.net/p/pdl/bugs/367/>
+## <https://github.com/PDLPorters/pdl/issues/47>
+
+my $cases = {
+	q|BAD| => q|BAD|,
+	q|BAD BAD| => q|[BAD BAD]|,
+	q|BAD BAD BAD| => q|[BAD BAD BAD]|,
+	q|[BAD]| => q|[BAD]|,
+	q|[ BAD ]| => q|[BAD]|,
+	q|[BAD BAD]| => q|[BAD BAD]|,
+	q|[ BAD BAD ]| => q|[BAD BAD]|,
+};
+
+plan tests => scalar keys %$cases;
+
+while( my ($case_string, $expected_string) = each %$cases ) {
+	my $bad_pdl = pdl( $case_string );
+	subtest "Testing case: $case_string" => sub {
+		ok( $bad_pdl->badflag, 'has badflag enabled');
+		ok( $bad_pdl->isbad->all, 'all values in PDL are BAD');
+
+		is($bad_pdl->string, $expected_string, "PDL stringifies back to input string: @{[ $bad_pdl->string ]}");
+	};
+}
+
+done_testing;