#!perl
# Copyright (C) 2001-2005, The Perl Foundation.
# $Id: spill.t 23188 2007-11-28 15:35:26Z kjs $
use strict;
use warnings;
use lib qw( . lib ../lib ../../lib );
use Parrot::Test tests => 9;
pir_output_is( <<'CODE', <<'OUT', "allocate 1" );
#
# Test the ability of the register allocator to
# generate spills.
#
.sub test :main
$I0 = 0
$I1 = 1
$I2 = 2
$I3 = 3
$I4 = 4
$I5 = 5
$I6 = 6
$I7 = 7
$I8 = 8
$I9 = 9
$I10 = 10
$I11 = 11
$I12 = 12
$I13 = 13
$I14 = 14
$I15 = 15
$I16 = 16
$I17 = 17
$I18 = 18
$I19 = 19
$I20 = 20
$I21 = 21
$I22 = 22
$I23 = 23
$I24 = 24
$I25 = 25
$I26 = 26
$I27 = 27
$I28 = 28
$I29 = 29
$I30 = 30
$I31 = 31
$I32 = 32
$I33 = 33
$I34 = 34
$I35 = 35
$I36 = 36
$I37 = 37
$I38 = 38
$I39 = 39
$I40 = 40
print $I0
print "\n"
print $I10
print "\n"
print $I20
print "\n"
print $I30
print "\n"
print $I40
print "\n"
end
.end
CODE
0
10
20
30
40
OUT
pir_output_is( <<'CODE', <<'OUT', "spill 1" );
#
# Test the ability of the register allocator to
# generate spills.
#
.sub test :main
$I0 = 0
$I1 = 1
$I2 = 2
$I3 = 3
$I4 = 4
$I5 = 5
$I6 = 6
$I7 = 7
$I8 = 8
$I9 = 9
$I10 = 10
$I11 = 11
$I12 = 12
$I13 = 13
$I14 = 14
$I15 = 15
$I16 = 16
$I17 = 17
$I18 = 18
$I19 = 19
$I20 = 20
$I21 = 21
$I22 = 22
$I23 = 23
$I24 = 24
$I25 = 25
$I26 = 26
$I27 = 27
$I28 = 28
$I29 = 29
$I30 = 30
$I31 = 31
$I32 = 32
$I33 = 33
$I34 = 34
$I35 = 35
$I36 = 36
$I37 = 37
$I38 = 38
$I39 = 39
$I40 = $I0 + $I1
$I41 = $I2 + $I3
$I42 = $I4 + $I5
$I43 = $I6 + $I7
$I44 = $I8 + $I9
$I50 = $I10 + $I11
$I51 = $I12 + $I13
$I52 = $I14 + $I15
$I53 = $I16 + $I17
$I54 = $I18 + $I19
$I60 = $I20 + $I21
$I61 = $I22 + $I23
$I62 = $I24 + $I25
$I63 = $I26 + $I27
$I64 = $I28 + $I29
$I70 = $I30 + $I31
$I71 = $I32 + $I33
$I72 = $I34 + $I35
$I73 = $I36 + $I37
$I74 = $I38 + $I39
print $I0
print $I1
print $I2
print $I3
print $I4
print $I5
print $I6
print $I7
print $I8
print $I9
print "\n"
print $I10
print $I11
print $I12
print $I13
print $I14
print $I15
print $I16
print $I17
print $I18
print $I19
print "\n"
print $I20
print $I21
print $I22
print $I23
print $I24
print $I25
print $I26
print $I27
print $I28
print $I29
print "\n"
print $I30
print $I31
print $I32
print $I33
print $I34
print $I35
print $I36
print $I37
print $I38
print $I39
print "\n"
print $I40
print $I41
print $I42
print $I43
print $I44
print "\n"
print $I50
print $I51
print $I52
print $I53
print $I54
print "\n"
print $I60
print $I61
print $I62
print $I63
print $I64
print "\n"
print $I70
print $I71
print $I72
print $I73
print $I74
print "\n"
end
.end
CODE
0123456789
10111213141516171819
20212223242526272829
30313233343536373839
1591317
2125293337
4145495357
6165697377
OUT
pir_output_is( <<'CODE', <<'OUT', "pcc arg overflow 1" );
#
# Test the ability of the register allocator in
# combination with PCC calling convention and overflow arguments.
# Slightly redundant with tests in t/syn/pcc.t but please leave.
#
.sub test :main
_foo(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40)
end
.end
.sub _foo
.param int i1
.param int i2
.param int i3
.param int i4
.param int i5
.param int i6
.param int i7
.param int i8
.param int i9
.param int i10
.param int i11
.param int i12
.param int i13
.param int i14
.param int i15
.param int i16
.param int i17
.param int i18
.param int i19
.param int i20
.param int i21
.param int i22
.param int i23
.param int i24
.param int i25
.param int i26
.param int i27
.param int i28
.param int i29
.param int i30
.param int i31
.param int i32
.param int i33
.param int i34
.param int i35
.param int i36
.param int i37
.param int i38
.param int i39
.param int i40
print i1
print "\n"
print i2
print "\n"
print i3
print "\n"
print i4
print "\n"
print i5
print "\n"
print i10
print "\n"
print i15
print "\n"
print i20
print "\n"
print i25
print "\n"
print i30
print "\n"
print i35
print "\n"
print i40
print "\n"
end
.end
CODE
1
2
3
4
5
10
15
20
25
30
35
40
OUT
pir_output_is( <<'CODE', <<'OUT', "spill 4" );
#
# Another spill test
#
.sub test :main
$I0 = 0
$I1 = 1
$I2 = 2
$I3 = 3
$I4 = 4
$I5 = 5
$I6 = 6
$I7 = 7
$I8 = 8
$I9 = 9
$I10 = 10
$I11 = 11
$I12 = 12
$I13 = 13
$I14 = 14
$I15 = 15
$I16 = 16
$I17 = 17
$I18 = 18
$I19 = 19
$I20 = 20
$I21 = 21
$I22 = 22
$I23 = 23
$I24 = 24
$I25 = 25
$I26 = 26
$I27 = 27
$I28 = 28
$I29 = 29
$I30 = 30
$I31 = 31
$I32 = 32
$I33 = 33
$I34 = 34
$I35 = 35
$I36 = 36
$I37 = 37
$I38 = 38
$I39 = 39
if $I0 != 0 goto err
if $I1 != 1 goto err
if $I2 != 2 goto err
if $I3 != 3 goto err
if $I4 != 4 goto err
if $I5 != 5 goto err
if $I6 != 6 goto err
if $I7 != 7 goto err
if $I8 != 8 goto err
if $I9 != 9 goto err
if $I10 != 10 goto err
if $I11 != 11 goto err
if $I12 != 12 goto err
if $I13 != 13 goto err
if $I14 != 14 goto err
if $I15 != 15 goto err
if $I16 != 16 goto err
if $I17 != 17 goto err
if $I18 != 18 goto err
if $I19 != 19 goto err
if $I20 != 20 goto err
if $I21 != 21 goto err
if $I22 != 22 goto err
if $I23 != 23 goto err
if $I24 != 24 goto err
if $I25 != 25 goto err
if $I26 != 26 goto err
if $I27 != 27 goto err
if $I28 != 28 goto err
if $I29 != 29 goto err
if $I30 != 30 goto err
if $I31 != 31 goto err
if $I32 != 32 goto err
if $I33 != 33 goto err
if $I34 != 34 goto err
if $I35 != 35 goto err
if $I36 != 36 goto err
if $I37 != 37 goto err
if $I38 != 38 goto err
if $I39 != 39 goto err
print "ok\n"
end
err:
print "nok\n"
end
.end
CODE
ok
OUT
pir_output_is( <<'CODE', <<'OUT', "bug #32996" );
.namespace ["Foo"]
.sub __biginit :main
$S0 = "Foo"
newclass $P0, $S0
$P1 = new $S0
$P1.method1()
$P1.method2()
$P2 = new $S0
$P2.method1()
$P2.method2()
$P3 = new $S0
$P3.method1()
$P3.method2()
$P4 = new $S0
$P4.method1()
$P4.method2()
$P5 = new $S0
$P5.method1()
$P5.method2()
$P6 = new $S0
$P6.method1()
$P6.method2()
$P7 = new $S0
$P7.method1()
$P7.method2()
$P8 = new $S0
$P8.method1()
$P8.method2()
$P9 = new $S0
$P9.method1()
$P9.method2()
$P10 = new $S0
$P10.method1()
$P10.method2()
$P11 = new $S0
$P11.method1()
$P11.method2()
$P12 = new $S0
$P12.method1()
$P12.method2()
$P13 = new $S0
$P13.method1()
$P13.method2()
$P14 = new $S0
$P14.method1()
$P14.method2()
$P15 = new $S0
$P15.method1()
$P15.method2()
$P1.method1()
$P1.method2()
$P2.method1()
$P2.method2()
$P3.method1()
$P3.method2()
$P4.method1()
$P4.method2()
$P5.method1()
$P5.method2()
$P6.method1()
$P6.method2()
$P7.method1()
$P7.method2()
$P8.method1()
$P8.method2()
$P9.method1()
$P9.method2()
$P10.method1()
$P10.method2()
$P11.method1()
$P11.method2()
$P12.method1()
$P12.method2()
$P13.method1()
$P13.method2()
$P14.method1()
$P14.method2()
$P15.method1()
$P15.method2()
end
.end
.sub method1 :method
print "In method 1\n"
.begin_return
.end_return
.end
.sub method2 :method
print "In method 2\n"
.begin_return
.end_return
.end
CODE
In method 1
In method 2
In method 1
In method 2
In method 1
In method 2
In method 1
In method 2
In method 1
In method 2
In method 1
In method 2
In method 1
In method 2
In method 1
In method 2
In method 1
In method 2
In method 1
In method 2
In method 1
In method 2
In method 1
In method 2
In method 1
In method 2
In method 1
In method 2
In method 1
In method 2
In method 1
In method 2
In method 1
In method 2
In method 1
In method 2
In method 1
In method 2
In method 1
In method 2
In method 1
In method 2
In method 1
In method 2
In method 1
In method 2
In method 1
In method 2
In method 1
In method 2
In method 1
In method 2
In method 1
In method 2
In method 1
In method 2
In method 1
In method 2
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
=LOCALS=
=INITS=
_sub(=ARGS=)
=TESTS2=
end
fail:
print "failed\n"
end
.end
.sub _sub
=PARAMS=
=TESTS=
print "all params ok\n"
.return()
fail:
print "failed\n"
end
.end
TEMPLATE
my $code = repeat(
$template2, 18,
LOCALS => ".local Integer a<index>\n\ta<index> = new Integer",
INITS => 'a<index> = <index>',
ARGS => 'a<index>',
PARAMS => '.param Integer a<index>',
TESTS => "set I0, a<index>\nne I0, <index>, fail",
TESTS2 => "set I0, a<index>\nne I0, <index>, fail"
);
pir_output_is( $code, <<'OUT', "overflow pmcs 18 spill" );
all params ok
OUT
$code = repeat(
$template2, 22,
LOCALS => ".local Integer a<index>\n\ta<index> = new Integer",
INITS => 'a<index> = <index>',
ARGS => 'a<index>',
PARAMS => '.param Integer a<index>',
TESTS => "set I0, a<index>\nne I0, <index>, fail",
TESTS2 => "set I0, a<index>\nne I0, <index>, fail"
);
pir_output_is( $code, <<'OUT', "overflow pmcs 22 spill" );
all params ok
OUT
$code = repeat(
$template2, 40,
LOCALS => ".local Integer a<index>\n\ta<index> = new Integer",
INITS => 'a<index> = <index>',
ARGS => 'a<index>',
PARAMS => '.param Integer a<index>',
TESTS => "set I0, a<index>\nne I0, <index>, fail",
TESTS2 => "set I0, a<index>\nne I0, <index>, fail"
);
pir_output_is( $code, <<'OUT', "overflow pmcs 40 spill" );
all params ok
OUT
$code = repeat(
$template2, 60,
LOCALS => ".local Integer a<index>\n\ta<index> = new Integer",
INITS => 'a<index> = <index>',
ARGS => 'a<index>',
PARAMS => '.param Integer a<index>',
TESTS => "set I0, a<index>\nne I0, <index>, fail",
TESTS2 => "set I0, a<index>\nne I0, <index>, fail"
);
pir_output_is( $code, <<'OUT', "overflow pmcs 60 spill" );
all params ok
OUT
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
# fill-column: 100
# End:
# vim: expandtab shiftwidth=4:
syntax highlighted by Code2HTML, v. 0.9.1