Wrong refcount for Array ref contents (work with pure-Perl code)

[Shlomi Fish]

Hi all!

In:

http://opensvn.csie.org/shlomif/documents/perl/trunk/perl5/ext-embed-internals/docbook/examples/incremental-examples-1/XSTest/

I have written the following XS function:

{{{{{{{{{{{{
AV *
concat_two_array_refs(array1, array2)
    AV * array1
    AV * array2

    INIT:
        /* Initialize RETVAL to NULL, so we'll know something is wrong
         * if this indeed the case*/
        RETVAL = NULL;

    CODE:
        {
            AV * ret;
            AV * current;
            I32 max_index;
            I32 i;
            I32 array_idx;
            SV * * elem;

            /* av_make() accepts a size and a list of SV's. So this
             * call creates a new array*/
            ret = av_make(0, NULL);

            if (ret == NULL)
            {
                goto myerror;
            }

            for(array_idx=0;array_idx<2;array_idx++)
            {
                current = (array_idx == 0) ? array1 : array2;

                max_index = av_len(current);
                for(i=0;i<=max_index;i++)
                {
                    elem = av_fetch(current, i, 0);
                    if (elem == NULL)
                    {
                        av_push(ret, &PL_sv_undef);
                    }
                    else
                    {
                        /* Increment the reference count because we now
                         * reference it in another place and av_push
                         * does not do it for us.
                         * 
                         * SvREFCNT_inc_void_NN is a variation of SvREFCNT_inc 
                         * which has some limitations that don't matter here.
                         * 
                         * From the documentation (perldoc perlapi):
                         *
                         * SvREFCNT_inc_void_NN
                               Same as SvREFCNT_inc, but can only be used if 
                               you don't need the return value, and you know
                               that sv is not NULL.  The macro doesn't need to
                               return a meaningful value, or check for
                               NULLness, so it's smaller and faster.

                         * av_fetch cannot return a non-NULL SV** that points
                         * to a NULL SV*.
                         * */

                        SvREFCNT_inc_void_NN(*elem);
                        av_push(ret, *elem);
                    }
                }
            }

            myerror:
            RETVAL = ret;
        }
    OUTPUT:
        RETVAL
}}}}}}}}}}}}}}}

Now, I wrote the following test case (in t/10-array-from-scratch.t to check 
that the values were indeed destroyed):


{{{{{{{{{{{{{{
package MyTestDestroyed;

use vars (qw(@log));

sub new
{
    my $class = shift;
    my $self = {};
    
    bless $self, $class;

    $self->{'id'} = shift;

    return $self;
}

sub DESTROY
{
    my $self = shift;

    push @log, "$self->{id} was Destroyed";
}

package main;

{
    {
        my $combined;

        {
            my @array1 = ("One", MyTestDestroyed->new("CamelCase"));
            my @array2 = (20,30,40);

            $combined = XSTest::concat_two_array_refs(\...@array1, \...@array2);
            # $combined = [...@array1, @array2];
        }

        # TEST
        is ($combined->[0], "One", 
            "concat_two_arrays - Garbage Collection - elem 0"
        );

        # TEST
        is ($combined->[1]->{'id'}, "CamelCase", 
            "concat_two_arrays - Garbage Collection - elem 1/id"
        );
    }

    # TEST
    is_deeply(
        \...@mytestdestroyed::log,
        ["CamelCase was Destroyed"],
        "concat_two_arrays - Garbage Collection - object was destroyed.",
    );

    @MyTestDestroyed::log = ();
}
}}}}}}}}}}}}}}

The test fails.

If I replace the lines:

{{{
            $combined = XSTest::concat_two_array_refs(\...@array1, \...@array2);
            # $combined = [...@array1, @array2];
}}}

Everything works as expected.

What am I doing wrong? I asked on #p5p on irc.perl.org.il, and no one could 
tell me what is wrong.

Regards,

        Shlomi Fish

-- 
-----------------------------------------------------------------
Shlomi Fish       http://www.shlomifish.org/
What Makes Software Apps High Quality -  http://xrl.us/bkeuk

Shlomi, so what are you working on? Working on a new wiki about unit testing 
fortunes in freecell? -- Ran Eilam