[perl #43006] [NEW] Tail call force-frees current context

[via RT]

# New Ticket Created by  B. Geron 
# Please include the string:  [perl #43006]
# in the subject line of all future correspondence about this issue. 
# <URL: http://rt.perl.org/rt3/Ticket/Display.html?id=43006 >


-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1

When there is a tail call without parameters, the tail call frees the
caller's context without checking if it is referenced, e.g. by a
closure. The test in <parrot.tailcalltest.patch> fails in svn HEAD
because of this, but checking relies on the 'coincidence' that some new
allocated context is of the same size as the (incorrectly) freed
context. If some version of Parrot optimizes by default, the test might
succeed with the problem still there.

The patch in <parrot.solution1.patch> fixes the problem for me.

Why is the surrounding if statement (see below) there? If it was there
to detect that a closure was made and is now passed on to the callee, we
can remove it as it should not be necessary any more. That might fix
[perl #42790]: Tailcall with slurpy argument passing causes a memory leak.

315:            if (!(*pc == PARROT_OP_get_params_pc ||
316:                        (*pc == PARROT_OP_push_eh_ic &&
317:                         pc[2] == PARROT_OP_get_params_pc))) {

Thanks,
- --
Bram Geron | GPG 0xE7B9E65E



-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.6 (GNU/Linux)
Comment: Using GnuPG with Mozilla - http://enigmail.mozdev.org

iD8DBQFGUHKSvquQbee55l4RAgk5AJ4lvXfbT4bNQbTPxlZmyIn4YHsWaACfcia4
IaQqZGPjMNPNNL11sjDSgUU=
=3+fM
-----END PGP SIGNATURE-----

Index: t/op/calling.t
===================================================================
--- t/op/calling.t	(revision 18597)
+++ t/op/calling.t	(working copy)
@@ -7,7 +7,7 @@
 use lib qw( . lib ../lib ../../lib );
 
 use Test::More;
-use Parrot::Test tests => 94;
+use Parrot::Test tests => 95;
 
 =head1 NAME
 
@@ -2408,6 +2408,45 @@
 Have bar: 2
 OUTPUT
 
+pir_output_is( <<'CODE', <<'OUTPUT', "Tail call without arguments should not free the context when a closure depends on it" );
+.sub main :main
+    $P0 = create_closure_and_run_it()
+.end
+
+.sub create_closure_and_run_it
+    P0 = new "Integer"
+    P0 = 3
+    .lex "val", P0
+    P2 = get_global "myclosure"
+    P1 = newclosure P2
+    # There is a closure depending on our current context, so this shouldn't
+    # free it.
+    .return P1()
+.end
+
+.sub myclosure :outer(create_closure_and_run_it)
+    P1 = find_lex "val"
+    say P1 # Should output 3
+    donothing()
+    P1 = find_lex "val"
+    say P1 # Should output 3 as well
+    .return ()
+.end
+
+.sub donothing
+    P0 = new "Integer"
+    P0 = 5
+    # This creates a new binding that is not accessible by the
+    # caller (myclosure)
+    .lex "val", P0
+    P2 = null
+    P1 = null
+.end
+CODE
+3
+3
+OUTPUT
+
 # Local Variables:
 #   mode: cperl
 #   cperl-indent-level: 4

Index: src/pmc/sub.pmc
===================================================================
--- src/pmc/sub.pmc	(revision 18597)
+++ src/pmc/sub.pmc	(working copy)
@@ -322,7 +322,7 @@
                 PObj_get_FLAGS(ccont) &= ~SUB_FLAG_TAILCALL;
                 context->caller_ctx    = caller_ctx->caller_ctx;
 
-                Parrot_free_context(INTERP, caller_ctx, 1);
+                Parrot_free_context(INTERP, caller_ctx, 0);
             }
         }