Commits

Anonymous committed bcabdbf

Fixed a problem with an aliasing of the same variables in the concat array.

This was done by replacing the code with the one that muppet suggested.

  • Participants
  • Parent commits d9b430c

Comments (0)

Files changed (2)

perl5/ext-embed-internals/docbook/examples/incremental-examples-1/XSTest/lib/XSTest.xs

         }
 
 AV *
-concat_two_array_refs(array1, array2)
-    AV * array1
-    AV * array2
+concat_two_array_refs (AV * a1, AV * a2)
+    PREINIT:
+        AV * av;
+        int a1len, a2len, i, n;
+    CODE:
+        a1len = av_len (a1) + 1;
+        a2len = av_len (a2) + 1;
+        n = 0;
 
-    INIT:
-        /* Initialize RETVAL to NULL, so we'll know something is wrong
-         * if this indeed the case*/
-        RETVAL = NULL;
+        /* We return av. newAV initializes a new array. */
+        av = newAV ();
+        /* Pre-extend the array so we don't waste time allocating each time
+         * through the loop. */
+        av_extend (av, a1len + a2len);
 
-    CODE:
-        {
-            AV * ret;
-            AV * current;
-            I32 max_index;
-            I32 i;
-            I32 array_idx;
-            SV * * elem;
+        for (i = 0 ; i < a1len ; i++) {
+                SV ** svp = av_fetch (a1, i, FALSE);
+                /* Since we already checked the array length,
+                 * fetch should not fail */
+                assert (svp);
+                /* Let the new array take ownership of a new copy of the sv. */
+                av_store (av, n, newSVsv (*svp));
+                n++;
+        }
 
-            /* av_make() accepts a size and a list of SV's. So this
-             * call creates a new array*/
-            ret = av_make(0, NULL);
+        /* Same as above for the other array */
+        for (i = 0 ; i < a2len ; i++) {
+                SV ** svp = av_fetch (a2, i, FALSE);
+                assert (svp);
+                av_store (av, n, newSVsv (*svp));
+                n++;
+        }
 
-            if (ret == NULL)
-            {
-                goto myerror;
-            }
 
-            for(array_idx=0;array_idx<2;array_idx++)
-            {
-                current = (array_idx == 0) ? array1 : array2;
+        assert (n == (a1len + a2len));
+        /* We need to mortalize the AV because it is returned by
+         * the function (on the stack), and so will not be garbage
+         * collected. According to:
+         *
+         * http://www.nntp.perl.org/group/perl.xs/2008/12/msg2521.html
+         *
+         * AV *'s and HV *'s are not mortalized by default as is the case
+         * for SV *'s, so they need to be mortalized explicitly.
+         * */
 
-                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.
+        sv_2mortal((SV *)av);
+        
+        RETVAL = av;
 
-                         * av_fetch cannot return a non-NULL SV** that points
-                         * to a NULL SV*.
-                         * */
-
-                        SvREFCNT_inc_void_NN(*elem);
-                        av_push(ret, *elem);
-                    }
-                }
-            }
-
-            /* We need to mortalize the AV because it is returned by
-             * the function (on the stack), and so will not be garbage
-             * collected. According to:
-             *
-             * http://www.nntp.perl.org/group/perl.xs/2008/12/msg2521.html
-             *
-             * AV *'s and HV *'s are not mortalized by default as is the case
-             * for SV *'s, so they need to be mortalized explicitly.
-             * */
-
-            sv_2mortal((SV *)ret);
-
-            myerror:
-            RETVAL = ret;
-        }
     OUTPUT:
         RETVAL
+

perl5/ext-embed-internals/docbook/examples/incremental-examples-1/XSTest/t/10-array-from-scratch.t

 use strict;
 use warnings;
 
-use Test::More tests => 5;
+use Test::More tests => 7;
 
 use XSTest;
 
 
     @MyTestDestroyed::log = ();
 }
+
+{
+    my @array1 = (0, 1, 200, 33);
+    my @array2 = (4004, 50);
+
+    my $combined = XSTest::concat_two_array_refs(\@array1, \@array2);
+
+    $array1[0] .= "Hello";
+
+    # TEST
+    is_deeply(
+        $combined,
+        [0, 1, 200, 33, 4004, 50],
+        "concat_two_array_refs - 1"
+    );
+
+    $combined->[1] .= "suffix";
+
+    # TEST
+    is_deeply(
+        \@array1,
+        ["0Hello", 1, 200, 33],
+    );
+}
+