diff --git a/Basic/Gen/PP.pm b/Basic/Gen/PP.pm index 8cb4dac06..fefe5f8e5 100644 --- a/Basic/Gen/PP.pm +++ b/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,17 +1637,15 @@ 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, {}, ''); @@ -1654,7 +1653,8 @@ EOD $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)"); }), diff --git a/Basic/Pod/PP.pod b/Basic/Pod/PP.pod index c2ca833c1..7620ff858 100644 --- a/Basic/Pod/PP.pod +++ b/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 cannot broadcast, since that would cause undefined results. A runtime check is generated that throws an diff --git a/Changes b/Changes index dd882521c..4d8e29983 100644 --- a/Changes +++ b/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 diff --git a/t/01-pptest.t b/t/01-pptest.t index 8d9fb85f4..8e2535447 100644 --- a/t/01-pptest.t +++ b/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