cvsuser 04/12/14 01:06:24
Modified: imcc/t/reg spill.t
imcc/t/syn pcc.t
ops object.ops
Log:
fix #33031
* set current_object in context before calling invoke
* add more tests WRT register passing and spilling
Revision Changes Path
1.10 +105 -1 parrot/imcc/t/reg/spill.t
Index: spill.t
===================================================================
RCS file: /cvs/public/parrot/imcc/t/reg/spill.t,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -r1.9 -r1.10
--- spill.t 11 Dec 2004 05:38:37 -0000 1.9
+++ spill.t 14 Dec 2004 09:06:22 -0000 1.10
@@ -1,6 +1,6 @@
#!perl
use strict;
-use TestCompiler tests => 5;
+use TestCompiler tests => 9;
##############################
@@ -599,3 +599,107 @@
In method 1
In method 2
OUT
+
+sub repeat {
+ my ($template, $count, %substs) = @_;
+ my ($code, $n, $start);
+ foreach (split(/\n/, $template)) {
+ $n = $count;
+ $start = 0;
+ if (/^(.*)=(\w+)=(.*)/) {
+ my ($pre, $key, $post) = ($1, $2, $3);
+ if ($key eq 'ARGS') {
+ my @params;
+ for my $i (0..$n-1) {
+ (my $new = $substs{$key}) =~ s/\<index\>/$i/g;
+ push @params, $new;
+ }
+ $code .= $pre . join(',', @params) . "$post\n";
+ next;
+ }
+ $start = $n / 2 if ($key eq 'TESTS2');
+ for my $i ($start..$n-1) {
+ (my $new = $substs{$key}) =~ s/\<index\>/$i/g;
+ $code .= "$pre$new$post\n";
+ }
+ } else {
+ $code .= "$_\n";
+ }
+ }
+
+ return $code;
+}
+ my $template2 = <<'TEMPLATE';
+.sub _main
+ new P3, .PerlInt
+ new P4, .PerlInt
+ =LOCALS=
+ =INITS=
+ _sub(=ARGS=)
+ =TESTS2=
+ P5 = P3
+ P5 = P4
+ end
+fail:
+ print "failed\n"
+ end
+.end
+.pcc_sub _sub prototyped
+ =PARAMS=
+ =TESTS=
+ print "all params ok\n"
+ .pcc_begin_return
+ .pcc_end_return
+fail:
+ print "failed\n"
+ end
+.end
+TEMPLATE
+
+my $code = repeat($template2, 18,
+ LOCALS => ".local PerlInt a<index>\n\ta<index> = new PerlInt",
+ INITS => 'a<index> = <index>',
+ ARGS => 'a<index>',
+ PARAMS => '.param PerlInt a<index>',
+ TESTS => "set I0, a<index>\nne I0, <index>, fail",
+ TESTS2 => "set I0, a<index>\nne I0, <index>, fail");
+
+output_is($code, <<'OUT', "overflow pmcs 18 spill");
+all params ok
+OUT
+
+my $code = repeat($template2, 22,
+ LOCALS => ".local PerlInt a<index>\n\ta<index> = new PerlInt",
+ INITS => 'a<index> = <index>',
+ ARGS => 'a<index>',
+ PARAMS => '.param PerlInt a<index>',
+ TESTS => "set I0, a<index>\nne I0, <index>, fail",
+ TESTS2 => "set I0, a<index>\nne I0, <index>, fail");
+
+output_is($code, <<'OUT', "overflow pmcs 22 spill");
+all params ok
+OUT
+
+$code = repeat($template2, 40,
+ LOCALS => ".local PerlInt a<index>\n\ta<index> = new PerlInt",
+ INITS => 'a<index> = <index>',
+ ARGS => 'a<index>',
+ PARAMS => '.param PerlInt a<index>',
+ TESTS => "set I0, a<index>\nne I0, <index>, fail",
+ TESTS2 => "set I0, a<index>\nne I0, <index>, fail");
+
+output_is($code, <<'OUT', "overflow pmcs 40 spill");
+all params ok
+OUT
+
+$code = repeat($template2, 60,
+ LOCALS => ".local PerlInt a<index>\n\ta<index> = new PerlInt",
+ INITS => 'a<index> = <index>',
+ ARGS => 'a<index>',
+ PARAMS => '.param PerlInt a<index>',
+ TESTS => "set I0, a<index>\nne I0, <index>, fail",
+ TESTS2 => "set I0, a<index>\nne I0, <index>, fail");
+
+output_is($code, <<'OUT', "overflow pmcs 60 spill");
+all params ok
+OUT
1.46 +13 -4 parrot/imcc/t/syn/pcc.t
Index: pcc.t
===================================================================
RCS file: /cvs/public/parrot/imcc/t/syn/pcc.t,v
retrieving revision 1.45
retrieving revision 1.46
diff -u -r1.45 -r1.46
--- pcc.t 24 Nov 2004 16:16:20 -0000 1.45
+++ pcc.t 14 Dec 2004 09:06:23 -0000 1.46
@@ -1,6 +1,6 @@
#!perl
use strict;
-use TestCompiler tests => 40;
+use TestCompiler tests => 41;
##############################
# Parrot Calling Conventions
@@ -774,8 +774,6 @@
all params ok
OUT
-SKIP: {
- skip "massive spilling not yet implemented", 1;
$code = repeat($template, 40,
LOCALS => '.local int a<index>',
INITS => 'a<index> = <index>',
@@ -785,7 +783,6 @@
output_is($code, <<'OUT', "overflowed spilled integers");
all params ok
OUT
-}
$code = repeat($template, 18,
LOCALS => ".local PerlInt a<index>\n\ta<index> = new PerlInt",
@@ -798,6 +795,18 @@
all params ok
OUT
+$code = repeat($template, 40,
+ LOCALS => ".local PerlInt a<index>\n\ta<index> = new PerlInt",
+ INITS => 'a<index> = <index>',
+ ARGS => '.arg a<index>',
+ PARAMS => '.param PerlInt a<index>',
+ TESTS => "set I0, a<index>\nne I0, <index>, fail");
+
+output_is($code, <<'OUT', "overflow pmcs 40");
+all params ok
+OUT
+
+
output_is(<<'CODE', <<'OUT', ".flatten_arg non-prototyped 1");
.pcc_sub _main prototyped
.local Sub sub
1.52 +3 -6 parrot/ops/object.ops
Index: object.ops
===================================================================
RCS file: /cvs/public/parrot/ops/object.ops,v
retrieving revision 1.51
retrieving revision 1.52
diff -u -r1.51 -r1.52
--- object.ops 12 Dec 2004 23:03:48 -0000 1.51
+++ object.ops 14 Dec 2004 09:06:24 -0000 1.52
@@ -102,14 +102,13 @@
opcode_t *next = expr NEXT();
REG_PMC(1) = new_ret_continuation_pmc(interpreter, next);
- object = REG_PMC(2);
+ interpreter->ctx.current_object = object = REG_PMC(2);
method_pmc = VTABLE_find_method(interpreter, object, REG_STR(0));
if (!method_pmc) {
real_exception(interpreter, next, METH_NOT_FOUND,
"Method '%Ss' not found", REG_STR(0));
}
REG_PMC(0) = method_pmc;
- interpreter->ctx.current_object = object;
dest = (opcode_t *)REG_PMC(0)->vtable->invoke(interpreter, method_pmc,
next);
goto ADDRESS(dest);
}
@@ -122,14 +121,13 @@
REG_STR(0) = $1;
REG_PMC(1) = new_ret_continuation_pmc(interpreter, next);
- object = REG_PMC(2);
+ interpreter->ctx.current_object = object = REG_PMC(2);
method_pmc = VTABLE_find_method(interpreter, object, REG_STR(0));
if (!method_pmc) {
real_exception(interpreter, next, METH_NOT_FOUND,
"Method '%Ss' not found", REG_STR(0));
}
REG_PMC(0) = method_pmc;
- interpreter->ctx.current_object = object;
dest = (opcode_t *)REG_PMC(0)->vtable->invoke(interpreter, method_pmc,
next);
goto ADDRESS(dest);
}
@@ -143,14 +141,13 @@
REG_PMC(1) = interpreter->ctx.current_cont;
PObj_get_FLAGS(REG_PMC(1)) |= SUB_FLAG_TAILCALL;
- object = REG_PMC(2);
+ interpreter->ctx.current_object = object = REG_PMC(2);
method_pmc = VTABLE_find_method(interpreter, object, REG_STR(0));
if (!method_pmc) {
real_exception(interpreter, next, METH_NOT_FOUND,
"Method '%Ss' not found", REG_STR(0));
}
REG_PMC(0) = method_pmc;
- interpreter->ctx.current_object = object;
dest = (opcode_t *)REG_PMC(0)->vtable->invoke(interpreter, method_pmc,
next);
goto ADDRESS(dest);
}
