[o] OtherPars can now be omitted from args like [o] ndarrays

Basic/Gen/PP.pm

@@ -1092,6 +1092,7 @@ sub make_xs_code {
 
 sub indent($$) {
     my ($text,$ind) = @_;
+    return $text if !length $text;
     $text =~ s/^(.*)$/$ind$1/mg;
     return $text;
 }
@@ -1623,7 +1624,7 @@ EOD
         my %outca = map +($_=>1), $sig->names_oca;
         my %other_out = map +($_=>1), $sig->other_out;
         my %tmp = map +($_=>1), $sig->names_tmp;
-        my $nout   = keys %out;
+        my $nout   = keys(%out) + keys(%other_out);
         my $noutca = keys %outca;
         my $ntmp   = keys %tmp;
         my $ntot   = @args;
@@ -1636,25 +1637,24 @@ EOD
         # Generate declarations for SV * variables corresponding to pdl * output variables.
         # These are used in creating output variables.  One variable (ex: SV * outvar1_SV;)
         # is needed for each output and output create always argument
-        my $svdecls = join "\n", map indent("SV *${_}_SV = NULL;",$ci), $sig->names_out;
-        my ($xsargs, $xsdecls) = ('', ''); my %already_read; my $cnt = 0; my %outother2cnt;
+        my $svdecls = join "\n", map indent("SV *${_}_SV = NULL;",$ci), $sig->names_out, $sig->other_out;
+        my ($xsargs, $xsdecls) = ('', ''); my %already_read; my $cnt = 0;
         foreach my $x (grep !$outca{$_}, @args) {
-            last if $out{$x} || ($other{$x} && exists $defaults->{$x});
+            last if $out{$x} || $other_out{$x} || ($other{$x} && exists $defaults->{$x});
             $already_read{$x} = 1;
             $xsargs .= "$x, "; $xsdecls .= "\n\t$ptypes{$x}$x";
-            $outother2cnt{$x} = $cnt if $other{$x} && $other_out{$x};
             $cnt++;
         }
         my $pars = join "\n",map indent("$_;",$ci), $sig->alldecls(0, 0, \%already_read);
-        $svdecls = join "\n", grep length, $svdecls, map indent(qq{SV *${_}_SV = @{[defined($outother2cnt{$_})?"ST($outother2cnt{$_})":'NULL']};},$ci), $sig->other_out;
         $ci = '    ';  # Current indenting
         # clause for reading in all variables
         my $clause1 = callTypemaps([grep !$outca{$_}, @args], \%ptypes, {%out,%other_out}, \%already_read, {}, '');
         $clause1 .= callPerlInit([grep $outca{$_}, @args], $callcopy);
         $clause1 = indent($clause1,$ci);
         # clause for reading in input and creating output vars
         my $defaults_rawcond = $ndefault ? "items == ($nin-$ndefault)" : '';
-        my $clause3 = callTypemaps([grep !($out{$_} || $outca{$_}), @args], \%ptypes, \%other_out, \%already_read, $defaults, $defaults_rawcond);
+        my $clause3 = callTypemaps([grep !($out{$_} || $outca{$_} || $other_out{$_}), @args], \%ptypes, {}, \%already_read, $defaults, $defaults_rawcond);
+        $clause3 .= "${_}_SV = sv_newmortal();\n" for sort keys %other_out;
         $clause3 .= callPerlInit([grep $out{$_} || $outca{$_}, @args], $callcopy);
         $clause3 = indent($clause3,$ci);
         my $defaults_cond = $ndefault ? " || $defaults_rawcond" : '';
@@ -1730,8 +1730,10 @@ EOF
       "Generate XS trailer to return output variables or leave them as modified input variables",
       sub {
         my ($sig,$other_out_set) = @_;
-        my @outs = $sig->names_out; # names of output ndarrays in calling order
-        my $clause1 = join ';', map "ST($_) = $outs[$_]_SV", 0 .. $#outs;
+        my $oc = my @outs = $sig->names_out; # output ndarrays in calling order
+        my @other_outs = $sig->other_out; # output OtherPars in calling order
+        my $clause1 = join ';', (map "ST($_) = $outs[$_]_SV", 0 .. $#outs),
+          (map "ST(@{[$_+$oc]}) = $other_outs[$_]_SV", 0 .. $#other_outs);
         $other_out_set.PDL::PP::pp_line_numbers(__LINE__-1, "PDL_XS_RETURN($clause1)");
       }),
 

Basic/Pod/PP.pod

@@ -1708,6 +1708,8 @@ The passed-in stack SV will be mutated in place, so this code will then work:
 
     output_op([5,7], my $v0, my $v1);
     is_deeply [$v0,$v1], [5,7], 'output OtherPars work';
+    ($v0, $v1) = output_op([5,7]); # you can omit them, then they get returned
+    is_deeply [$v0,$v1], [5,7], 'output OtherPars work 1a';
 
 An operation with output C<OtherPars> cannot broadcast, since that would
 cause undefined results. A runtime check is generated that throws an

Changes

@@ -3,6 +3,7 @@
 - PP Inplace now checks inputs and outputs are dimensionally compatible (#416)
 - no more HTML doc generation
 - PDL::Doc::add_module now adds all submodules of given namespace (#420)
+- [o] OtherPars can now be omitted from args like [o] ndarrays
 
 2.082 2023-03-22
 - no changes from 2.081_03

t/01-pptest.t

@@ -480,13 +480,17 @@ is succ(2)."", 3, 'test pp_add_macros works';
 
 output_op([5,7], my $v0, my $v1);
 is_deeply [$v0,$v1], [5,7], 'output OtherPars work';
+($v0, $v1) = output_op([5,7]);
+is_deeply [$v0,$v1], [5,7], 'output OtherPars work 1a';
 eval { output_op(sequence(2,3), my $v0, my $v1) };
 isnt $@, '', 'broadcast with output OtherPars throws';
 
-output_op2([5,7], my $v0_2, my $v1_2);
+output_op2([5,7], my $n=PDL->null, my $v0_2, my $v1_2);
 is_deeply [$v0_2,$v1_2], [5,7], 'output OtherPars work 2';
-eval { output_op2(sequence(2,3), my $v0_2, my $v1_2) };
-isnt $@, '', 'broadcast with output OtherPars throws 2';
+(undef, $v0_2, $v1_2) = output_op2([5,7]);
+is_deeply [$v0_2,$v1_2], [5,7], 'output OtherPars work 2a';
+eval { output_op2(sequence(2,3), my $n=PDL->null, my $v0_2, my $v1_2) };
+like $@, qr/Can't broadcast/, 'broadcast with output OtherPars throws 2';
 
 output_op3([5,7], my $out3 = PDL->null, my $v0_3, my $v1_3);
 is_deeply [$v0_3,$v1_3], [5,7], 'output OtherPars work 3' or diag "got: ",$v0_3," ",$v1_3;
@@ -496,11 +500,7 @@ is "$o", 4;
 $o = incomp_dim([0..3]);
 is "$o", 4;
 
-$o = typem(my $oth = 3);
-is "$o", 4;
-is "$oth", 7;
-
-typem($o = PDL->null, $oth = 3);
+typem($o = PDL->null, my $oth = 3);
 is "$o", 4;
 is "$oth", 7;
 
@@ -523,6 +523,9 @@ isnt $@, '';
 incomp_out(sequence(3), 2, my $nds);
 is 0+@$nds, 2;
 is +($nds->[0]//'undef').'', "[0 1 2]";
+$nds = incomp_out(sequence(3), 2);
+is 0+@$nds, 2;
+is +($nds->[0]//'undef').'', "[0 1 2]";
 
 done_testing;
 EOF