Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

Inline::C : passing parameters to functions, modifying by reference

by bliako (Monsignor)
on Jul 22, 2021 at 23:54 UTC ( #11135324=perlquestion: print w/replies, xml ) Need Help??

bliako has asked for the wisdom of the Perl Monks concerning the following question:

Dear Monks,

I have spent quite some time in trying to do a seemingly simple task with Inline::C, that of passing a reference to a function and the function modifying it so that caller gets results back. I don't want to use the return() mechanism, so my function looks like int func(SV *inp, SV *out); inp is a readonly ref and out is the ref I would like to write to.

I have 3 cases I would like to deal with:

  1. out is an arrayref, e.g. my @inp; my @out; func(\@inp, \@out); In this case I want to remove all elements of @out if any and then make it a 2D array of 5cols and 3rows, containing the number 42.

  2. out is a scalar, e.g. my @inp; my $out; func(\@inp, $out); In this case I want to make $out an arrayref and proceed to fill it as above, so that caller can dereference as my @out = @$out.

  3. out is a scalarref, e.g. my @inp; my $out; func(\@inp, \$out); In this case I want to find if its dereference, e.g. $out is a ref to any array or hash, or just a plain scalar. If it's a plain scalar I would like to make it an arrayref and proceed as above, so that caller can dereference as my @out = @$out.

Can anyone help me to fill any of the blanks in this advent calendar of perlguts?

Here is a test script testing each case.

use strict; use warnings; use Test::More; use Inline C => Config => BUILD_NOISY => 1, clean_after_build => 0, warnings => 10, ; use Inline C => <<'EOC'; #include <stdio.h> // checks if array is indeed an arrayref and sets array_sz to its size + and // returns 1 else returns 0 (not an array) int is_array_ref( SV *array, size_t *array_sz ){ if( ! SvROK(array) ){ fprintf(stderr, "is_array_ref() : warning, i +nput '%p' is not a reference.\n", array); return 0; } if( SvTYPE(SvRV(array)) != SVt_PVAV ){ fprintf(stderr, "is_array_r +ef() : warning, input ref '%p' is not an ARRAY reference.\n", array); + return 0; } // it's an array, cast it to AV to get its len via av_len(); // yes, av_len needs to be bumped up, it's $#array int asz = 1+av_len((AV *)SvRV(array)); if( asz < 0 ){ fprintf(stderr, "is_array_ref() : error, input arra +y ref '%p' has negative size!\n", array); return 0; } *array_sz = (size_t )asz; return 1; // success, it is an array and size returned by ref, abo +ve } int func( SV *inp, SV *out ){ AV *av, *av2; size_t i, j, asz; if( is_array_ref(out, &asz) ){ printf("Case1: @out\n"); // we have an \@R, e.g. func(\@R) av = (AV *)SvRV(out); // but first clear any contents if( asz > 0 ) av_clear(av); } else if( SvROK(out) ){ printf("Case3: \\$out\n"); // we have a scalar ref, e.g. func(\$x) av = newAV(); sv_setsv(SvRV(out), (SV *)av); } else { printf("Case2: $out\n"); // we have a scalar e.g func($x); av = newAV(); sv_setsv(out, (SV *)av); } // and fill it in for(i=0;i<5;i++){ av2 = newAV(); av_extend(av2, 3); av_push(av, (SV *)av2); for(j=0;j<3;j++){ av_store(av2, j, newSViv(42)); } } return 0; // success } EOC my @inp = (1..5); my @out; my $T = 'Case1'; is(func(\@inp, \@out),0, "$T: called success."); is(scalar(@out), 5, "$T: rows are 5"); for(my $i=0;$i<5;$i++){ ok(ref($out[$i])eq'ARRAY', "$T : item $i is ARRAYref."); is(scalar($out[$i]), 3, "$T : it has 3 elements."); for(my $j=0;$j<3;$j++){ is($out[$i]->[$j], 42, "$T : it's value is 42."); } } $T = 'Case2'; my $out; is(func(\@inp, $out),0, "$T: called success."); is(ref($out)eq'ARRAY', "$T: it is now an ARRAYref."); @out = @$out; is(scalar(@out), 5, "$T: rows are 5"); for(my $i=0;$i<5;$i++){ ok(ref($out[$i])eq'ARRAY', "$T : item $i is ARRAYref."); is(scalar($out[$i]), 3, "$T : it has 3 elements."); for(my $j=0;$j<3;$j++){ is($out[$i]->[$j], 42, "$T : it's value is 42."); } } $T = 'Case3'; $out = undef; is(func(\@inp, \$out),0, "$T: called success."); is(ref($out)eq'ARRAY', "$T: it is now an ARRAYref."); @out = @$out; is(scalar(@out), 5, "$T: rows are 5"); for(my $i=0;$i<5;$i++){ ok(ref($out[$i])eq'ARRAY', "$T : item $i is ARRAYref."); is(scalar($out[$i]), 3, "$T : it has 3 elements."); for(my $j=0;$j<3;$j++){ is($out[$i]->[$j], 42, "$T : it's value is 42."); } } done_testing();

thanks in advance, bw, bliako

Replies are listed 'Best First'.
[Solved] Re: Inline::C : passing parameters to functions, modifying by reference
by bliako (Monsignor) on Jul 23, 2021 at 11:24 UTC

    Thanks to LeoNerd who kindly responded to my desperate queries at https://kiwiirc.com/nextclient/#irc://irc.perl.org/#perl the script now works. And confidence to calling-by-reference has been restored, Balans returned to the Universe.

    LeoNerd suggested and implemented a new sv_setrv() which is how you stuff an array into an SV. He also suggested replacing av_push(av, (SV *)av2); with av_push(av, newRV_noinc((SV *)av2)); which pushes an arrayref to an array.

    The following script now passes all cases and shows how to call an Inline::C function and returning results by ref with either an arrayref (Case1), a scalarref which we assign an arrayref to it (Case3) or a scalar which we assign an arrayref to it (Case2).

    Definetely an addition to the sparse XS documentation and even sparser examples. A big thank you to LeoNerd.

    use strict; use warnings; use Test::More; use Inline C => Config => BUILD_NOISY => 1, clean_after_build => 0, warnings => 10, ; use Inline C => <<'EOC'; #include <stdio.h> /************************************************************/ /* Monkeypatch by LeoNerd to set an arrayref into a scalarref As posted on https://kiwiirc.com/nextclient/#irc://irc.perl.org/#pe +rl at 10:50 23/07/2021 A BIG THANK YOU LeoNerd */ #define HAVE_PERL_VERSION(R, V, S) \ (PERL_REVISION > (R) || (PERL_REVISION == (R) && (PERL_VERSION > ( +V) || (PERL_VERSION == (V) && (PERL_SUBVERSION >= (S)))))) #define sv_setrv(s, r) S_sv_setrv(aTHX_ s, r) static void S_sv_setrv(pTHX_ SV *sv, SV *rv) { sv_setiv(sv, (IV)rv); #if !HAVE_PERL_VERSION(5, 24, 0) SvIOK_off(sv); #endif SvROK_on(sv); } /************************************************************/ int is_array_ref( SV *array, size_t *array_sz ){ if( ! SvROK(array) ){ fprintf(stderr, "is_array_ref() : warning, i +nput '%p' is not a reference.\n", array); return 0; } if( SvTYPE(SvRV(array)) != SVt_PVAV ){ fprintf(stderr, "is_array_r +ef() : warning, input ref '%p' is not an ARRAY reference.\n", array); + return 0; } // it's an array, cast it to AV to get its len via av_len(); // yes, av_len needs to be bumped up int asz = 1+av_len((AV *)SvRV(array)); if( asz < 0 ){ fprintf(stderr, "is_array_ref() : error, input arra +y ref '%p' has negative size!\n", array); return 0; } *array_sz = (size_t )asz; return 1; // success, it is an array and size returned by ref, abo +ve } int func( SV *inp, SV *out ){ AV *av, *av2; size_t i, j, asz; if( is_array_ref(out, &asz) ){ printf("Case1: @out\n"); // we have an \@R, e.g. func(\@R) av = (AV *)SvRV(out); // but first clear any contents if( asz > 0 ) av_clear(av); } else if( SvROK(out) ){ printf("Case3: \\$out\n"); // we have a scalar ref, e.g. func(\$x) av = newAV(); sv_setrv(SvRV(out), (SV *)av); } else { printf("Case2: $out\n"); // we have a scalar e.g func($x); av = newAV(); sv_setrv(out, (SV *)av); } for(i=0;i<5;i++){ av2 = newAV(); av_extend(av2, 3); //av_push(av, (SV *)av2); // LeoNerd suggestion: av_push(av, newRV_noinc((SV *)av2)); for(j=0;j<3;j++){ av_store(av2, j, newSViv(42)); } } return 0; // success } EOC my @inp = (1..5); my @out; my $T = 'Case1'; is(func(\@inp, \@out),0, "$T: called success."); is(scalar(@out), 5, "$T: rows are 5"); for(my $i=0;$i<5;$i++){ ok(ref($out[$i])eq'ARRAY', "$T : item $i is ARRAYref."); is(scalar(@{$out[$i]}), 3, "$T : it has 3 elements: ".scalar(@{$ou +t[$i]})); for(my $j=0;$j<3;$j++){ is($out[$i]->[$j], 42, "$T : it's value is 42."); } } $T = 'Case2'; my $out; is(func(\@inp, $out),0, "$T: called success."); ok(ref($out)eq'ARRAY', "$T: it is now an ARRAYref."); @out = @$out; is(scalar(@out), 5, "$T: rows are 5"); for(my $i=0;$i<5;$i++){ ok(ref($out[$i])eq'ARRAY', "$T : item $i is ARRAYref."); is(scalar(@{$out[$i]}), 3, "$T : it has 3 elements."); for(my $j=0;$j<3;$j++){ is($out[$i]->[$j], 42, "$T : it's value is 42."); } } $T = 'Case3'; $out = undef; is(func(\@inp, \$out),0, "$T: called success."); ok(ref($out)eq'ARRAY', "$T: it is now an ARRAYref: ".ref($out)); @out = @$out; is(scalar(@out), 5, "$T: rows are 5"); for(my $i=0;$i<5;$i++){ ok(ref($out[$i])eq'ARRAY', "$T : item $i is ARRAYref."); is(scalar(@{$out[$i]}), 3, "$T : it has 3 elements."); for(my $j=0;$j<3;$j++){ is($out[$i]->[$j], 42, "$T : it's value is 42."); } } done_testing();

    Update: minor code-fixing (and spelling) after 1hr of posting

    bw, bliako

Re: Inline::C : passing parameters to functions, modifying by reference
by syphilis (Bishop) on Jul 23, 2021 at 10:19 UTC
    Hi bliako,

    I sense that there's a bit you could do to simplify the task.
    When I run your script I get:
    C:\_32\pscrpt\inline>perl bliako.pl Case1: @out ok 1 - Case1: called success. ok 2 - Case1: rows are 5 not ok 3 - Case1 : item 0 is ARRAYref. # Failed test 'Case1 : item 0 is ARRAYref.' # at bliako.pl line 72. Bizarre copy of ARRAY in list assignment at C:/perl-5.34.0/lib/Test/Bu +ilder.pm line 802. # Tests were run but no plan was declared and done_testing() was not s +een. # Looks like your test exited with 255 just after 3.
    I therefore wonder "why present us with all of the extra stuff that we don't even get to" ?
    Much better, IMO, to consider just the part that's not working. (And then, if needed, proceed to the next part that fails to work when we've fixed the first failure.)

    Doing a Devel::Peek::Dump of $out[$i] reveals that it is an array (and not a reference to an array). At least, that's how it looks to me:
    ok 1 - Case1: called success. ok 2 - Case1: rows are 5 SV = PVAV(0x7ae098) at 0x33cab0 REFCNT = 1 FLAGS = () ARRAY = 0x2f0d7d8 FILL = 2 MAX = 3 FLAGS = (REAL) Elt No. 0 SV = IV(0x33cad0) at 0x33cae0 REFCNT = 1 FLAGS = (IOK,pIOK) IV = 42 Elt No. 1 SV = IV(0x33cab8) at 0x33cac8 REFCNT = 1 FLAGS = (IOK,pIOK) IV = 42 Elt No. 2 SV = IV(0x33cb30) at 0x33cb40 REFCNT = 1 FLAGS = (IOK,pIOK) IV = 42 not ok 3 - Case1 : item 0 is ARRAYref. # Failed test 'Case1 : item 0 is ARRAYref.'
    So the test is reporting correctly.

    I'm also a bit puzzled about the involvement of Test/Builder.pm. Do you know what it is it that pulls that module in ?

    Cheers,
    Rob

      syphilis, I was expecting your call. Thanks.

      You saw that correctly. And the culprit, as per advice from LeoNerd at https://kiwiirc.com/nextclient/#irc://irc.perl.org/#perl (23/07/2021 @ 10:50 server time) is in the filling part: av_push(av, (SV *)av2); should become av_push(av, newRV_noinc((SV *)av2)); . And sv_setsv() should be sv_setrv()

      Which is non-existent but LeoNerd posted this:

      /************************************************************/ /* Monkeypath by LeoNerd to set an arrayref into a scalarref As posted on https://kiwiirc.com/nextclient/#irc://irc.perl.org/#pe +rl at 10:50 23/07/2021 A BIG THANK YOU LeoNerd */ #define HAVE_PERL_VERSION(R, V, S) \ (PERL_REVISION > (R) || (PERL_REVISION == (R) && (PERL_VERSION > ( +V) || (PERL_VERSION == (V) && (PERL_SUBVERSION >= (S)))))) #define sv_setrv(s, r) S_sv_setrv(aTHX_ s, r) static void S_sv_setrv(pTHX_ SV *sv, SV *rv) { sv_setiv(sv, (IV)rv); #if !HAVE_PERL_VERSION(5, 24, 0) SvIOK_off(sv); #endif SvROK_on(sv); } /************************************************************/

      I am posting the full working script as a comment to my question.

      bw, bliako

Re: Inline::C : passing parameters to functions, modifying by reference
by perlfan (Vicar) on Jul 23, 2021 at 21:59 UTC
    I know this is a minor nit and doesn't address your actual question, but I find this style of including the C code (or whatever) to Inline::C to be easier to read and maintain (example untested, but basically using your original code in OP),
    use Inline ( C => 'DATA', BUILD_NOISY => 1, clean_after_build => 0, warnings => 10, ); # perl stuff # more perl stuff... __DATA__ __C__ #include <stdio.h> // checks if array is indeed an arrayref and sets array_sz to its size + and // returns 1 else returns 0 (not an array) int is_array_ref( SV *array, size_t *array_sz ){ if( ! SvROK(array) ){ fprintf(stderr, "is_array_ref() : warning, i +nput '%p' is not a reference.\n", array); return 0; } if( SvTYPE(SvRV(array)) != SVt_PVAV ){ fprintf(stderr, "is_array_r +ef() : warning, input ref '%p' is not an ARRAY reference.\n", array); + return 0; } // it's an array, cast it to AV to get its len via av_len(); // yes, av_len needs to be bumped up, it's $#array int asz = 1+av_len((AV *)SvRV(array)); if( asz < 0 ){ fprintf(stderr, "is_array_ref() : error, input arra +y ref '%p' has negative size!\n", array); return 0; } *array_sz = (size_t )asz; return 1; // success, it is an array and size returned by ref, abo +ve } int func( SV *inp, SV *out ){ AV *av, *av2; size_t i, j, asz; if( is_array_ref(out, &asz) ){ printf("Case1: @out\n"); // we have an \@R, e.g. func(\@R) av = (AV *)SvRV(out); // but first clear any contents if( asz > 0 ) av_clear(av); } else if( SvROK(out) ){ printf("Case3: \\$out\n"); // we have a scalar ref, e.g. func(\$x) av = newAV(); sv_setsv(SvRV(out), (SV *)av); } else { printf("Case2: $out\n"); // we have a scalar e.g func($x); av = newAV(); sv_setsv(out, (SV *)av); } // and fill it in for(i=0;i<5;i++){ av2 = newAV(); av_extend(av2, 3); av_push(av, (SV *)av2); for(j=0;j<3;j++){ av_store(av2, j, newSViv(42)); } } return 0; // success }

      ... BUT!

      use strict; use warnings; use Inline C => "DATA"; xyz(); __DATA__ __C__ xyz(); __DATA__ __C__ #define __XX__ unsigned __XX__ int xyz(){ printf("hhaahah\n"); return 1; }
      Undefined subroutine &main::xyz called at a.pl line 8.

      removing any of the underscores in __XX__ fixes the problem.

      whereas this does not have a problem:

      use strict; use warnings; use Inline(C => <<'EOC'); #define __XX__ unsigned __XX__ int xyz(){ printf("hhaahah\n"); return 1; } EOC xyz();

      I am neat-picking because in some of my usage, a 3rd party insists on typedef a __global__ and that messes up the whole inlining. But #define GLOBAL __global__ is a workaround.

      bw, bliako

      that's a good suggestion thanks

Re: Inline::C : passing parameters to functions, modifying by reference
by Anonymous Monk on Jul 23, 2021 at 16:55 UTC
    Many thanks to the community for this quick and thorough write-up ... which means that I don't have to ask!

      You know, mike, more asking and less "teaching" from you would be an improvement.

A reply falls below the community's threshold of quality. You may see it by logging in.

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://11135324]
Front-paged by Corion
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others about the Monastery: (2)
As of 2021-12-01 07:50 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?