Fix sf.net bug 406

Added missing logic for clump(-N) and minor cleanup of perl wrapper.
PDLPorters · Nov 5, 2015 · 66878c6 · 66878c6
1 parent a6d59a7
commit 66878c6
Show file tree

Hide file tree

Showing 3 changed files with 19 additions and 6 deletions.
diff --git a/Basic/Core/Core.pm b/Basic/Core/Core.pm
@@ -1615,8 +1615,6 @@ the usual cases. The following example demonstrates typical usage:
 sub PDL::clump {
   my $ndims = $_[0]->getndims;
   if ($#_ < 2) {
-    return &PDL::_clump_int($_[0],$_[1]) # Truncate clumping to actual dims
-      if $_[1] > $ndims;
     return &PDL::_clump_int(@_);
   } else {
     my ($this,@dims) = @_;

diff --git a/Basic/Slices/slices.pd b/Basic/Slices/slices.pd
@@ -1358,8 +1358,11 @@ pp_def(
 		 if($COMP(n) > $PARENT(ndims))
                         $COMP(n) = $PARENT(ndims);
 
-                 $COMP(nrem) = ($COMP(n)==-1 ? $PARENT(threadids[0]) : $COMP(n));
-                 $PRIV(nnew) = $PARENT(ndims) - $COMP(nrem) + 1;
+		 if($COMP(n) < -1)
+                        $COMP(n) = $PARENT(ndims) + $COMP(n) + 1;
+
+                 $PRIV(nrem) = ($COMP(n)==-1 ? $PARENT(threadids[0]) : $COMP(n));
+                 $PRIV(nnew) = $PARENT(ndims) - $PRIV(nrem) + 1;
                  $SETNDIMS($PRIV(nnew));
                  d1=1;
                  for(i=0; i<$PRIV(nrem); i++) {
@@ -1370,7 +1373,7 @@ pp_def(
                         $CHILD(dims[i-$PRIV(nrem)+1]) = $PARENT(dims[i]);
                  }
                  $SETDIMS();
-                 $SETDELTATHREADIDS(1-$COMP(nrem));
+                 $SETDELTATHREADIDS(1-$PRIV(nrem));
                  ',
         EquivCPOffsCode => '
                 PDL_Indx i;

diff --git a/t/clump.t b/t/clump.t
@@ -1,7 +1,7 @@
 # Test ->clump(). This is not yet good enough: we need
 # nasty test cases
 
-use Test::More tests => 3;
+use Test::More tests => 5;
 use PDL::LiteF;
 
 use strict;
@@ -87,4 +87,16 @@ if(0) {
 	ok(all PDL::approx($pd,pdl([0,2,10,12,20,22]), $eps));
 
 	ok(all PDL::approx($pe,pdl([10,12,20]), $eps));
+
+        # SF bug #406 clump(-N) failure
+        ##-- test data
+        my $a1 = sequence(2,13);
+        my $b1 = sequence(3,2,13);
+
+        ##-- bash to max 2 dimensions
+        my $a2 = $a1->clump(-2);   ##-- no-op
+        my $b2 = $b1->clump(-2);   ##-- merge 1st 2 dims
+
+        ok($a1->ndims == 2, "no-op clump(-2)");
+        ok($b2->ndims == 2, "general clump(-2)");
 }