ensure dims from COMP are set first

PDLPorters · Apr 11, 2024 · 54e78b6 · 54e78b6
1 parent ec1ab31
commit 54e78b6
Show file tree

Hide file tree

Showing 3 changed files with 10 additions and 4 deletions.
diff --git a/Basic/Gen/PP.pm b/Basic/Gen/PP.pm
@@ -1479,7 +1479,7 @@ EOD
    PDL::PP::Rule->new("CallCopy", ["SignatureObj", "Name"],
       sub {
 	  my ($sig, $Name, $hasp2c) = @_;
-	  my $noDimmedArgs = $sig->dims_count;
+	  my $noDimmedArgs = $sig->dims_obj->ind_names;
 	  my $noArgs = @{$sig->names};
 	  # Check for 2-arg function with 0-dim signatures
 	  return 0 if !($noDimmedArgs == 0 and $noArgs == 2);
@@ -1855,7 +1855,7 @@ sub make_vfn_args {
       sub { "PDL_RETERROR(PDL_err, PDL->redodims_default($_[0]));\n" }),
    PDL::PP::Rule->new("DimsSetters",
       ["SignatureObj"],
-      sub { join "\n", sort map $_->get_initdim, $_[0]->dims_values }),
+      sub { $_[0]->dims_init }),
    PDL::PP::Rule->new("RedoDimsFuncName", [qw(Name RedoDims? RedoDimsCode? DimsSetters)],
       sub { (scalar grep $_ && /\S/, @_[1..$#_]) ? "pdl_$_[0]_redodims" : 'NULL'}),
    PDL::PP::Rule::Returns->new("RedoDimsCode", [],

diff --git a/Basic/Gen/PP/Dims.pm b/Basic/Gen/PP/Dims.pm
@@ -19,6 +19,8 @@ sub get_indobj_make {
 
 sub ind_obj {$_[0]{$_[1]}}
 sub ind_names {keys %{$_[0]}}
+sub ind_fromcomp {grep defined $_->{From}, values %{$_[0]}}
+sub ind_notfromcomp {grep !defined $_->{From}, values %{$_[0]}}
 
 #####################################################################
 #

diff --git a/Basic/Gen/PP/Signature.pm b/Basic/Gen/PP/Signature.pm
@@ -99,8 +99,12 @@ sub names_out_nca { my $o=$_[0]->objs; grep $o->{$_}{FlagOut} && !$o->{$_}{FlagC
 sub names_tmp { my $o=$_[0]->objs; grep $o->{$_}{FlagTemp}, @{$_[0]{Names}} }
 
 sub dims_obj { $_[0]->{DimsObj} }
-sub dims_count { scalar keys %{$_[0]{DimsObj}} }
-sub dims_values { values %{$_[0]{DimsObj}} }
+sub dims_init {
+  my ($self) = @_;
+  join "\n",
+    (sort map $_->get_initdim, $self->{DimsObj}->ind_fromcomp),
+    (sort map $_->get_initdim, $self->{DimsObj}->ind_notfromcomp);
+}
 
 sub othernames {
   my ($self, $omit_count, $with_xs, $except) = @_;