From: Bob Rogers <[EMAIL PROTECTED]>
Date: Wed, 9 Jul 2008 01:27:29 -0400
Oops; r28763 seems to be the source of one of my problems, a "lexical
not found" error. With this change, Parrot gets confused when multiple
calls to the :outer sub have been made, such as when it is recursive.
The attached patch is a band-aid that fixes this problem without
reverting r28763. I believe it is a minimal conservative fix (that
happens to look huge because of merging t/op/lexicals-2.t into
t/op/lexicals.t).
Patrick, this not only passes your original badlex.pir case, but I
also successfully ran "make spectest_regression" for Rakudo on it.
IMHO, this fix should go into the imminent release because it
restores functionality that had been lost since the previous release.
Comments? Objections?
-- Bob
[CORE] Keep Closure:invoke from breaking what newclosure hath wrought.
This is a band-aid that will be removed along with "autoclose."
* include/parrot/sub.h:
+ Add SUB_FLAG_NEWCLOSURE to sub_flags_enum.
* src/sub.c:
+ (parrot_new_closure): Mark the closures we create.
* src/pmc/closure.pmc:
+ (invoke): Only overwrite sub->outer_ctx if not from "newclosure".
* MANIFEST, t/op/lexicals-2.t (deleted), t/op/lexicals.t:
+ Merge lexicals-2.t into lexicals.t, remove "todo" from "RT#56398:
Bob's recursion bug" case.
Diffs between last version checked in and current workfile(s):
Index: include/parrot/sub.h
===================================================================
--- include/parrot/sub.h (revision 29359)
+++ include/parrot/sub.h (working copy)
@@ -36,6 +36,9 @@
SUB_FLAG_PF_IMMEDIATE = PObj_private6_FLAG,
SUB_FLAG_PF_POSTCOMP = PObj_private7_FLAG,
+ /* [temporary expedient. -- rgr, 13-Jul-08.] */
+ SUB_FLAG_NEWCLOSURE = SUB_FLAG_PF_IMMEDIATE,
+
SUB_FLAG_PF_MASK = 0xfa /* anon ... postcomp, is_outer*/
} sub_flags_enum;
Index: src/sub.c
===================================================================
--- src/sub.c (revision 29359)
+++ src/sub.c (working copy)
@@ -527,6 +527,9 @@
cont = ctx->current_cont;
+ /* mark clos_pmc as having been created by newclosure. */
+ SUB_FLAG_flag_SET(NEWCLOSURE, clos_pmc);
+
/* preserve this frame by converting the continuation */
cont->vtable = interp->vtables[enum_class_Continuation];
Index: src/pmc/closure.pmc
===================================================================
--- src/pmc/closure.pmc (revision 29359)
+++ src/pmc/closure.pmc (working copy)
@@ -91,9 +91,10 @@
opcode_t *next = SUPER(in_next);
PMC *outer_sub = sub->outer_sub;
- if (sub->ctx->caller_ctx->current_sub == outer_sub) {
- /* Being called from outer sub, in which case our outer is its
- * context. */
+ if (! (PObj_get_FLAGS(SELF) & SUB_FLAG_NEWCLOSURE)
+ && sub->ctx->caller_ctx->current_sub == outer_sub) {
+ /* Autoclose sub being called from the :outer sub, in which case
our
+ * outer is its context. */
sub->outer_ctx = sub->ctx->outer_ctx = PMC_sub(outer_sub)->ctx;
}
else if (sub->outer_ctx) {
Index: MANIFEST
===================================================================
--- MANIFEST (revision 29361)
+++ MANIFEST (working copy)
@@ -1,7 +1,7 @@
# ex: set ro:
# $Id$
#
-# generated by tools/dev/mk_manifest_and_skip.pl Sat Jul 12 13:47:29 2008 UT
+# generated by tools/dev/mk_manifest_and_skip.pl Mon Jul 14 02:56:21 2008 UT
#
# See tools/dev/install_files.pl for documentation on the
# format of this file.
@@ -3464,7 +3464,6 @@
t/op/jit.t []
t/op/jitn.t []
t/op/lexicals.t []
-t/op/lexicals-2.t []
t/op/literal.t []
t/op/load_bytecode.t []
t/op/number.t []
Index: t/op/lexicals-2.t
===================================================================
--- t/op/lexicals-2.t (revision 29360)
+++ t/op/lexicals-2.t (working copy)
@@ -1,200 +0,0 @@
-#!perl
-# Copyright (C) 2001-2008, The Perl Foundation.
-# $Id$
-
-use strict;
-use warnings;
-use lib qw( . lib ../lib ../../lib );
-
-use Test::More;
-use Parrot::Test tests => 3;
-
-=head1 NAME
-
-t/op/lexicals-2.t - Lexical Ops
-
-=head1 SYNOPSIS
-
- % prove t/op/lexicals-2.t
-
-=head1 DESCRIPTION
-
-More elaborate tests of closure and lexical variable operations.
-See PDD20.
-
-=cut
-
-pir_output_is( <<'CODE', <<'OUTPUT', "RT#56398: Patrick's request" );
-.sub 'main' :main
- foo('try 1')
- foo('try 2')
- foo('try 3')
-.end
-
-.sub 'foo' :lexid('foo')
- .param pmc x
- .lex '$x', x
- print "outer foo "
- say x
- 'inner'()
-.end
-
-.sub 'inner' :outer('foo')
- .local pmc x
- x = find_lex '$x'
- print "inner foo "
- say x
- $P0 = new 'String'
- $P0 = 'BOGUS!'
- store_lex '$x', $P0
-.end
-CODE
-outer foo try 1
-inner foo try 1
-outer foo try 2
-inner foo try 2
-outer foo try 3
-inner foo try 3
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', "RT#56398: Bob's recursion bug", todo =>
'not working after r28763.');
-.sub main :main
- rpwi(0)
-.end
-
-.sub rpwi
- .param int recursive_p
- unless recursive_p goto do_lex
- print "rpwi: recursive case\n"
- .return ()
-do_lex:
- .lex "(SAVED *SHARP-EQUAL-ALIST*)", $P40
- $P40 = new 'Integer'
- $P40 = 99
- .const .Sub $P80 = "(:INTERNAL rpwi 0)"
- newclosure $P81, $P80
- ## $P81 = clone $P80
- ## pushaction $P81
- print "rpwi: lex case\n"
- rpwi(1)
- $P81()
-.end
-
-.sub "(:INTERNAL rpwi 0)" :anon :outer('rpwi')
- print "[restoring *SHARP-EQUAL-ALIST*]\n"
- find_lex $P40, "(SAVED *SHARP-EQUAL-ALIST*)"
- print "[got "
- print $P40
- print "]\n"
-.end
-CODE
-rpwi: lex case
-rpwi: recursive case
-[restoring *SHARP-EQUAL-ALIST*]
-[got 99]
-OUTPUT
-
-pir_output_is( <<'CODE', <<'OUTPUT', "RT#56398: Jonathan's recursive case" );
-.sub 'main' :main
- $P0 = new 'ResizablePMCArray'
- push $P0, 'a'
- $P1 = new 'ResizablePMCArray'
- $P2 = new 'ResizablePMCArray'
- push $P2, 'simple'
- push $P1, $P2
- push $P1, 'test'
- $P3 = new 'ResizablePMCArray'
- push $P3, 'for'
- push $P3, 'a'
- push $P3, 'simple'
- push $P1, $P3
- push $P0, $P1
- push $P0, 'script'
- 'dump_thing'($P0, '# ')
-.end
-
-.sub 'dump_thing'
- .param pmc thing
- .param pmc prefix
- .lex '$thing', thing
- .lex '$prefix', prefix
-
- $P0 = find_global 'anon_1'
- $P1 = newclosure $P0
- .lex '$recur', $P1
-
- $P2 = find_lex '$thing'
- $I0 = isa $P2, 'ResizablePMCArray'
- unless $I0 goto not_ResizablePMCArray
-
- $P3 = find_lex '$prefix'
- print $P3
- print "[\n"
- $P4 = find_global 'anon_2'
- $P5 = newclosure $P4
- $P6 = find_lex '$thing'
- 'map'($P5, $P6)
- $P7 = find_lex '$prefix'
- print $P7
- print "]\n"
- goto end_if
-
- not_ResizablePMCArray:
- $P8 = find_lex '$prefix'
- print $P8
- $P9 = find_lex '$thing'
- print $P9
- print "\n"
- end_if:
-.end
-
-.sub 'anon_1' :outer('dump_thing')
- .param pmc subthing
- .lex '$subthing', subthing
- $P0 = find_lex '$subthing'
- $P1 = find_lex '$prefix'
- $P2 = new 'String'
- $P2 = concat $P1, ' '
- 'dump_thing'($P0, $P2)
-.end
-
-.sub 'anon_2' :outer('dump_thing')
- .param pmc topic
- .lex "$_", topic
- $P0 = find_lex '$recur'
- $P1 = find_lex '$_'
- $P0($P1)
-.end
-
-.sub 'map'
- .param pmc block
- .param pmc array
- .local pmc result, it
- result = new 'ResizablePMCArray'
- it = iter array
- loop:
- unless it goto loop_end
- $P0 = shift it
- $P0 = block($P0)
- push result, $P0
- goto loop
- loop_end:
- .return (result)
-.end
-CODE
-# [
-# a
-# [
-# [
-# simple
-# ]
-# test
-# [
-# for
-# a
-# simple
-# ]
-# ]
-# script
-# ]
-OUTPUT
Index: t/op/lexicals.t
===================================================================
--- t/op/lexicals.t (revision 29359)
+++ t/op/lexicals.t (working copy)
@@ -7,7 +7,7 @@
use lib qw( . lib ../lib ../../lib );
use Test::More;
-use Parrot::Test tests => 44;
+use Parrot::Test tests => 47;
=head1 NAME
@@ -1282,6 +1282,181 @@
hello world
OUTPUT
+pir_output_is( <<'CODE', <<'OUTPUT', "RT#56398: Patrick's request" );
+.sub 'main' :main
+ foo('try 1')
+ foo('try 2')
+ foo('try 3')
+.end
+
+.sub 'foo' :lexid('foo')
+ .param pmc x
+ .lex '$x', x
+ print "outer foo "
+ say x
+ 'inner'()
+.end
+
+.sub 'inner' :outer('foo')
+ .local pmc x
+ x = find_lex '$x'
+ print "inner foo "
+ say x
+ $P0 = new 'String'
+ $P0 = 'BOGUS!'
+ store_lex '$x', $P0
+.end
+CODE
+outer foo try 1
+inner foo try 1
+outer foo try 2
+inner foo try 2
+outer foo try 3
+inner foo try 3
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "RT#56398: Bob's recursion bug");
+.sub main :main
+ rpwi(0)
+.end
+
+.sub rpwi
+ .param int recursive_p
+ unless recursive_p goto do_lex
+ print "rpwi: recursive case\n"
+ .return ()
+do_lex:
+ .lex "(SAVED *SHARP-EQUAL-ALIST*)", $P40
+ $P40 = new 'Integer'
+ $P40 = 99
+ .const .Sub $P80 = "(:INTERNAL rpwi 0)"
+ newclosure $P81, $P80
+ ## $P81 = clone $P80
+ ## pushaction $P81
+ print "rpwi: lex case\n"
+ rpwi(1)
+ $P81()
+.end
+
+.sub "(:INTERNAL rpwi 0)" :anon :outer('rpwi')
+ print "[restoring *SHARP-EQUAL-ALIST*]\n"
+ find_lex $P40, "(SAVED *SHARP-EQUAL-ALIST*)"
+ print "[got "
+ print $P40
+ print "]\n"
+.end
+CODE
+rpwi: lex case
+rpwi: recursive case
+[restoring *SHARP-EQUAL-ALIST*]
+[got 99]
+OUTPUT
+
+pir_output_is( <<'CODE', <<'OUTPUT', "RT#56398: Jonathan's recursive case" );
+.sub 'main' :main
+ $P0 = new 'ResizablePMCArray'
+ push $P0, 'a'
+ $P1 = new 'ResizablePMCArray'
+ $P2 = new 'ResizablePMCArray'
+ push $P2, 'simple'
+ push $P1, $P2
+ push $P1, 'test'
+ $P3 = new 'ResizablePMCArray'
+ push $P3, 'for'
+ push $P3, 'a'
+ push $P3, 'simple'
+ push $P1, $P3
+ push $P0, $P1
+ push $P0, 'script'
+ 'dump_thing'($P0, '# ')
+.end
+
+.sub 'dump_thing'
+ .param pmc thing
+ .param pmc prefix
+ .lex '$thing', thing
+ .lex '$prefix', prefix
+
+ $P0 = find_global 'anon_1'
+ $P1 = newclosure $P0
+ .lex '$recur', $P1
+
+ $P2 = find_lex '$thing'
+ $I0 = isa $P2, 'ResizablePMCArray'
+ unless $I0 goto not_ResizablePMCArray
+
+ $P3 = find_lex '$prefix'
+ print $P3
+ print "[\n"
+ $P4 = find_global 'anon_2'
+ $P5 = newclosure $P4
+ $P6 = find_lex '$thing'
+ 'map'($P5, $P6)
+ $P7 = find_lex '$prefix'
+ print $P7
+ print "]\n"
+ goto end_if
+
+ not_ResizablePMCArray:
+ $P8 = find_lex '$prefix'
+ print $P8
+ $P9 = find_lex '$thing'
+ print $P9
+ print "\n"
+ end_if:
+.end
+
+.sub 'anon_1' :outer('dump_thing')
+ .param pmc subthing
+ .lex '$subthing', subthing
+ $P0 = find_lex '$subthing'
+ $P1 = find_lex '$prefix'
+ $P2 = new 'String'
+ $P2 = concat $P1, ' '
+ 'dump_thing'($P0, $P2)
+.end
+
+.sub 'anon_2' :outer('dump_thing')
+ .param pmc topic
+ .lex "$_", topic
+ $P0 = find_lex '$recur'
+ $P1 = find_lex '$_'
+ $P0($P1)
+.end
+
+.sub 'map'
+ .param pmc block
+ .param pmc array
+ .local pmc result, it
+ result = new 'ResizablePMCArray'
+ it = iter array
+ loop:
+ unless it goto loop_end
+ $P0 = shift it
+ $P0 = block($P0)
+ push result, $P0
+ goto loop
+ loop_end:
+ .return (result)
+.end
+CODE
+# [
+# a
+# [
+# [
+# simple
+# ]
+# test
+# [
+# for
+# a
+# simple
+# ]
+# ]
+# script
+# ]
+OUTPUT
+
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
End of diffs.
