Commit 477fba6b authored by Michael D. Adams's avatar Michael D. Adams
Browse files

Added tests for Cmm and CPS (they are currently skipped)

Also the test driver doesn't understand 'cmm' files
so something will have to be written before these tests
can even run.
parent 8aeb1c98
# Leave these off until the CPS pass is finished and integrated.
#
# These tests are not in their final format yet, but they provide
# a starting point.
test('cmm001', skip, compile, ['-O -fasm -ddump-cps-cmm'])
test('cmm002', skip, compile, ['-fasm -ddump-cps-cmm'])
test('cps001', skip, compile, ['-ddump-cps-cmm'])
test('cps002', skip, compile, ['-ddump-cps-cmm'])
test('cps003', skip, compile, ['-ddump-cps-cmm'])
test('cps004', skip, compile, ['-ddump-cps-cmm'])
test('cps005', skip, compile, ['-ddump-cps-cmm'])
test('cps006', skip, compile, ['-ddump-cps-cmm'])
test('cps007', skip, compile, ['-ddump-cps-cmm'])
test('cps008', skip, compile, ['-ddump-cps-cmm'])
test('cps009', skip, compile, ['-ddump-cps-cmm'])
test('cps010', skip, compile, ['-ddump-cps-cmm'])
test('cps011', skip, compile, ['-ddump-cps-cmm'])
test('cps012', skip, compile, ['-ddump-cps-cmm'])
test('cps013', skip, compile, ['-ddump-cps-cmm'])
test('cps014', skip, compile, ['-ddump-cps-cmm'])
test('cps015', skip, compile, ['-ddump-cps-cmm'])
test('cps016', skip, compile, ['-ddump-cps-cmm'])
test('cps017', skip, compile, ['-ddump-cps-cmm'])
test('cps018', skip, compile, ['-ddump-cps-cmm'])
test('cps019', skip, compile, ['-ddump-cps-cmm'])
test('cps020', skip, compile, ['-ddump-cps-cmm'])
test('cps021', skip, compile, ['-ddump-cps-cmm'])
test('cps022', skip, compile, ['-ddump-cps-cmm'])
test('cps023', skip, compile, ['-ddump-cps-cmm'])
test('cps024', skip, compile, ['-ddump-cps-cmm'])
test('cps025', skip, compile, ['-ddump-cps-cmm'])
test('cps026', skip, compile, ['-ddump-cps-cmm'])
// This puts GHC into an infinite loop(!) when -O is on
foo {
L: goto L;
}
// Reduced cps012.cmm to the key part that makes it crash
// in RegisterAlloc.joinToTargets
stg_ap_0_fast {
bits32 y, x;
c7: y = bits32[x];
goto c7;
}
// Basic function with a call
foo1 {
bits32 x;
B:
foreign "C--" bar() "safe";
x = 3;
goto B;
}
// Basic function with a call
foo1 {
B:
foreign "C--" bar() "safe";
goto B;
}
// Basic function with a heap check
// The GC block should only be one instruction
// (or rather it should be after assignment optimizations)
foo1 {
bits32 r;
B:
(r) = foreign "C--" bar() "safe";
L:
if (Hp > HpLim) {
(r) = foreign "C--" stg_gc_ret_p(r) "safe";
goto L;
}
return (r);
}
// Test basic function parameters and return values
foo2 (bits16 a, bits16 b, "ptr" bits16 c) {
bits32 x, y;
x = R1;
(y) = foreign "C--" bar(x) "safe";
goto L;
L:
foreign "C--" baz(x) "safe";
//jump 12;
goto M;
M:
return (12);
//goto L;
//goto L;
}
// Basic test of return
foo3 {
foreign "C--" glap() "safe";
return (12);
}
// Basic test of return with extra block
foo4{
B:
foreign "C--" palg() "safe";
return (14);
}
// Test that empty functions stay empty (and stay alive)
foo5 {
}
// Test basic general case for heap check
foo6_gc_slow {
if (Hp + 5 > HpLim) {
foreign "C--" do_gc_gen() "safe";
jump foo6_gc_slow(1, 2, 3);
}
return (7);
}
// Test basic stack check
foo6_gc_slow("ptr" bits32 f) goto GC {
return (7);
GC:
jump stg_gc_fun_v(f);
}
// Test general stack check
// Note, the GC block shouldn't trigger the stack limit
foo6_gc_slow("ptr" bits32 f, bits32 x) goto GC {
return (7);
GC:
foreign "C--" stg_gc_gen() "safe";
jump foo6_gc_slow(f, x);
}
// Yet another basic function
foo7 {
bits32 x;
(x) = foreign "C--" get_time() "safe";
return (x);
}
// A real world example from the RTS
// Should be checked later to see if it is right
stg_ap_0_fast ("ptr" bits32 fun, "ptr" bits32 arg) {
bits32 _c8;
c6: goto c7;
c7: _c8 = bits32[x]; // TODO: allow I32 or print bits32
switch [0 .. 71] (bits16[_c8 - 4]) {
case 0,1,2,3,4,5,6,7,8 : { goto c9; }
case 9,10,11,12,13,14,15 : { goto ca; }
case 16,17,18,19,20,21,22,23 : { goto c9; }
case 24 : {goto ca;}
case 25 : {goto c9;}
case 26 : {goto ca;}
case 27 : {goto c9;}
case 28,29,30,31,32 : {goto cb;}
case 33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,66,67,68,69,70,71 : {goto c9;}
}
c9: jump _c8 ();
cb: R1 = bits32[fun + 4 + 0];
goto c7;
ca: jump (bits32[arg + 0 * 4]) ();
}
// Test the calling conventions
// Test the default calling convention
// which is "unsafe" but will change soon to "safe"
foo1() {
foreign "C--" bar(x, y);
return (1);
}
// Test the "unsafe" calling convention
foo2() {
foreign "C--" bar(x, y) "unsafe";
return (1);
}
// Test the "safe" calling convention
foo3() {
bits32 x, y, z;
foreign "C--" bar(x, y, z) "safe";
return (1);
}
// Test explicit continuations.
// Note, we might want to check about suffix on foo2 (i.e. "_entry").
// I'm not sure that that is right.
foo1 (bits32 update) jump foo2(update) {
bits32 x;
return (x);
}
INFO_TABLE_RET (foo2, 0, bits32 update) (bits32 x) {
bits32[update] = x;
return (x);
}
// Test whether a stack check is performed even when
// the existing stack due to on-stack arguments is big enough.
// With space for a return address
foo1 (bits32 x, bits32 y) goto GC {
foreign "C--" bar(x) "safe";
return (1);
GC:
return (1);
}
// No space needed for a return address
foo2 (bits32 x, bits32 y) goto GC {
jump bar(x, y);
GC:
return (1);
}
// Test whether extra proc-points are generated
// by a label after a call such as with a heap check.
foo1 () {
bits32 p, q;
bits32 x, y, z;
(p, q) = foreign "C--" bar(1, 2) "safe";
L:
if (Hp < HpLim) {
(p, q) = foreign "C--" do_gc() "safe";
goto L;
}
return (p+q+x+y+z);
}
// Test whether extra proc-points are generated
// by a label after a call such as with a heap check,
// but where the return signature is different.
// The extra proc-point should be generated in this case.
foo1 () {
bits32 p, q;
bits32 x, y, z;
(p, q) = foreign "C--" bar(1, 2) "safe";
L:
if (Hp < HpLim) {
(p) = foreign "C--" do_gc() "safe";
goto L;
}
return (p+q+x+y+z);
}
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment