fix reshape bug introduced with slice update. (Problem was that previ…

…ous slice behaved, er, in an undocumented way -- and the undocumented behavior was used in reshape(-1).)
PDLPorters · Jan 5, 2015 · 2460c9f · 2460c9f
1 parent ccc5425
commit 2460c9f
Show file tree

Hide file tree

Showing 2 changed files with 26 additions and 18 deletions.
diff --git a/Basic/Core/Core.pm.PL b/Basic/Core/Core.pm.PL
@@ -2690,22 +2690,22 @@ Important: Physical piddles are changed inplace!
 
 *reshape = \&PDL::reshape;
 sub PDL::reshape{
-  if (@_ == 2 && $_[1] == -1) {  # a slicing reshape that drops 1-dims
-    return $_[0]->slice(join(',',map {$_ == 1 ? '(0)' : ''} $_[0]->dims));
-  }
-  my $pdl = pdl($_[0]);
-  my $nelem = $pdl->nelem;
-  my @dims = @_[1..$#_];
-  for my $dim(@dims) { barf "reshape: invalid dim size '$dim'" if $dim < 0 }
-  @dims = grep($_ != 1, $pdl->dims) if @dims == 0; # get rid of dims of size 1
-  $pdl->setdims([@dims]);
-  $pdl->upd_data;
-  if ($pdl->nelem > $nelem) {
-     my $tmp=$pdl->clump(-1)->slice("$nelem:-1");
-     $tmp .= 0;
-  }
-  $_[0] = $pdl;
-  return $pdl;
+    if (@_ == 2 && $_[1] == -1) {  # a slicing reshape that drops 1-dims
+	return $_[0]->slice( map { $_==1 ? [0,0,0] : [] } $_[0]->dims);
+    }
+    my $pdl = pdl($_[0]);
+    my $nelem = $pdl->nelem;
+    my @dims = @_[1..$#_];
+    for my $dim(@dims) { barf "reshape: invalid dim size '$dim'" if $dim < 0 }
+    @dims = grep($_ != 1, $pdl->dims) if @dims == 0; # get rid of dims of size 1
+    $pdl->setdims([@dims]);
+    $pdl->upd_data;
+    if ($pdl->nelem > $nelem) {
+	my $tmp=$pdl->clump(-1)->slice("$nelem:-1");
+	$tmp .= 0;
+    }
+    $_[0] = $pdl;
+    return $pdl;
 }
 
 =head2 squeeze

diff --git a/t/core.t b/t/core.t
@@ -4,7 +4,7 @@
 #
 
 use strict;
-use Test::More tests => 56;
+use Test::More tests => 59;
 
 BEGIN {
     # if we've got this far in the tests then 
@@ -69,10 +69,18 @@ $c = $a->squeeze;
 ok eq_array( [ $b->dims ], [3,4] ), "reshape(-1)";
 ok all( $b == $c ), "squeeze";
 
-$c++; # check dataflow
+$c++; # check dataflow in reshaped PDL
 ok all( $b == $c ), "dataflow"; # should flow back to b
 ok all( $a == 2 ), "dataflow";
 
+our $d = pdl(5); # zero dim piddle and reshape/squeeze
+ok $d->reshape(-1)->ndims==0, "reshape(-1) on 0-dim PDL gives 0-dim PDL";
+ok $d->reshape(1)->ndims==1, "reshape(1) on 0-dim PDL gives 1-dim PDL";
+ok $d->reshape(1)->reshape(-1)->ndims==0, "reshape(-1) on 1-dim, 1-element PDL gives 0-dim PDL";
+
+
+
+
 # test topdl
 
 isa_ok( PDL->topdl(1),       "PDL", "topdl(1) returns a piddle" );