From ef7b2134836e969cea7bc323a28d524f48a01a00 Mon Sep 17 00:00:00 2001 From: carl Date: Thu, 9 May 2002 20:16:05 +0000 Subject: [PATCH] * subscriptn() secondpass testing... --- tests/test/cg/tsubst.pp | 766 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 766 insertions(+) create mode 100644 tests/test/cg/tsubst.pp diff --git a/tests/test/cg/tsubst.pp b/tests/test/cg/tsubst.pp new file mode 100644 index 0000000000..525c81f091 --- /dev/null +++ b/tests/test/cg/tsubst.pp @@ -0,0 +1,766 @@ +{****************************************************************} +{ CODE GENERATOR TEST PROGRAM } +{****************************************************************} +{ NODE TESTED : secondsubscriptn(), partial secondload() } +{****************************************************************} +{ PRE-REQUISITES: secondload() } +{ secondassign() } +{****************************************************************} +{ DEFINES: VERBOSE = Write test information to screen } +{ FPC = Target is FreePascal compiler } +{****************************************************************} +{ REMARKS: } +{ } +{ } +{ } +{****************************************************************} +Program tsubst1; +{$mode objfpc} + + +{$IFNDEF FPC} +type smallint = integer; +{$ENDIF} +const + { Should be equal to the maximum offset possible in indirect addressing + mode with displacement. (CPU SPECIFIC) } + +{$ifdef cpu86} + MAX_DISP = 65535; +{$endif} +{$ifdef cpu68k} + MAX_DISP = 32767; +{$endif} + +{ These different alignments are described in the PowerPC ABI + supplement, they should represent most possible cases. +} +type +tlevel1rec = record + c: byte; +end; + +tlevel2rec = record + c: byte; + d: byte; + s: word; + n: longint; +end; + +tlevel3rec = record + c: byte; + s: word; +end; + +tlevel4rec = record + c: byte; + i : int64; + s: word; +end; + +tlevel5rec = record + c: byte; + s: word; + j: longint; +end; + +tlevel1rec_big = record + fill : array[1..MAX_DISP] of byte; + c: byte; +end; + +tlevel2rec_big = record + fill : array[1..MAX_DISP] of byte; + c: byte; + d: byte; + s: word; + n: longint; +end; + +tlevel3rec_big = record + fill : array[1..MAX_DISP] of byte; + c: byte; + s: word; +end; + +tlevel4rec_big = record + fill : array[1..MAX_DISP] of byte; + c: byte; + i : int64; + s: word; +end; + +tlevel5rec_big = record + fill : array[1..MAX_DISP] of byte; + c: byte; + s: word; + j: longint; +end; + +{ packed record, for testing misaligned access } +tlevel1rec_packed = packed record + c: byte; +end; + +tlevel2rec_packed = packed record + c: byte; + d: byte; + s: word; + n: longint; +end; + +tlevel3rec_packed = packed record + c: byte; + s: word; +end; + +tlevel4rec_packed = packed record + c: byte; + i : int64; + s: word; +end; + +tlevel5rec_packed = packed record + c: byte; + s: word; + j: longint; +end; + +tclass1 = class + fill : array[1..MAX_DISP] of byte; + c: byte; + s: word; + j: longint; +end; + +tclass2 = class + c: byte; + s: word; + i: int64; +end; + + + { test with global variables } + const + RESULT_U8BIT = $55; + RESULT_U16BIT = $500F; + RESULT_S32BIT = $500F0000; + RESULT_S64BIT = $500F0000; + + + + + + level1rec : tlevel1rec = + ( + c: RESULT_U8BIT + ); + + level2rec : tlevel2rec = + ( + c: RESULT_U8BIT; + d: RESULT_U8BIT; + s: RESULT_U16BIT; + n: RESULT_S32BIT; + ); + + level3rec : tlevel3rec = + ( + c: RESULT_U8BIT; + s: RESULT_U16BIT; + + ); + + level4rec : tlevel4rec = + ( + c: RESULT_U8BIT; + i : RESULT_S64BIT; + s : RESULT_U16BIT + ); + + level5rec : tlevel5rec = + ( + c: RESULT_U8BIT; + s: RESULT_U16BIT; + j: RESULT_S32BIT; + ); + + level1rec_packed : tlevel1rec_packed = + ( + c: RESULT_U8BIT + ); + + level2rec_packed : tlevel2rec_packed = + ( + c: RESULT_U8BIT; + d: RESULT_U8BIT; + s: RESULT_U16BIT; + n: RESULT_S32BIT; + ); + + level3rec_packed : tlevel3rec_packed = + ( + c: RESULT_U8BIT; + s: RESULT_U16BIT; + ); + + level4rec_packed : tlevel4rec_packed = + ( + c: RESULT_U8BIT; + i : RESULT_S64BIT; + s : RESULT_U16BIT + ); + + level5rec_packed : tlevel5rec_packed = + ( + c: RESULT_U8BIT; + s: RESULT_U16BIT; + j: RESULT_S32BIT; + ); + + procedure fail; + begin + WriteLn('Failure.'); + halt(1); + end; + +var + c,d: byte; + s: word; + n,j: longint; + i: int64; + failed : boolean; + class1 : tclass1; + class2 : tclass2; + + procedure clear_globals; + begin + c:=0; + d:=0; + s:=0; + n:=0; + j:=0; + i:=0; + class1:=nil; + class2:=nil + end; + + + function getclass : tclass1; + begin + getclass := class1; + end; + + function getclass2: tclass2; + begin + getclass2 := class2; + end; + +{$ifndef cpu68k} + procedure testlocal_big_1; + var + local1rec_big : tlevel1rec_big; + begin + clear_globals; + local1rec_big.c := RESULT_U8BIT; + c:= local1rec_big.c; + if c <> RESULT_U8BIT then + failed := true; + end; + + + procedure testlocal_big_2; + var + local2rec_big : tlevel2rec_big; + begin + clear_globals; + { setup values - assign } + local2rec_big.c := RESULT_U8BIT; + local2rec_big.d := RESULT_U8BIT; + local2rec_big.s := RESULT_U16BIT; + local2rec_big.n := RESULT_S32BIT; + { load values - load } + c:= local2rec_big.c; + if c <> RESULT_U8BIT then + failed := true; + d:= local2rec_big.d; + if d <> RESULT_U8BIT then + failed := true; + s:= local2rec_big.s; + if s <> RESULT_U16BIT then + failed := true; + n:= local2rec_big.n; + if n <> RESULT_S32BIT then + failed := true; + end; + + + procedure testlocal_big_3; + var + local3rec_big : tlevel3rec_big; + begin + clear_globals; + { setup values - assign } + local3rec_big.c := RESULT_U8BIT; + local3rec_big.s := RESULT_U16BIT; + c:= local3rec_big.c; + if c <> RESULT_U8BIT then + failed := true; + s:= local3rec_big.s; + if s <> RESULT_U16BIT then + failed := true; + end; + + procedure testlocal_big_4; + var + local4rec_big : tlevel4rec_big; + begin + clear_globals; + { setup values - assign } + local4rec_big.c := RESULT_U8BIT; + local4rec_big.i := RESULT_S64BIT; + local4rec_big.s := RESULT_U16BIT; + + c:= local4rec_big.c; + if c <> RESULT_U8BIT then + failed := true; + i:= local4rec_big.i; + if i <> RESULT_S64BIT then + failed := true; + s:= local4rec_big.s; + if s <> RESULT_U16BIT then + failed := true; + end; + + + procedure testlocal_big_5; + var + local5rec_big : tlevel5rec_big; + begin + clear_globals; + { setup values - assign } + local5rec_big.c := RESULT_U8BIT; + local5rec_big.s := RESULT_U16BIT; + local5rec_big.j := RESULT_S32BIT; + c:= local5rec_big.c; + if c <> RESULT_U8BIT then + failed := true; + s:= local5rec_big.s; + if s <> RESULT_U16BIT then + failed := true; + j:= local5rec_big.j; + if j <> RESULT_S32BIT then + failed := true; + end; +{$endif} + +procedure testlocals; +var + local1rec : tlevel1rec_packed; + local2rec : tlevel2rec_packed; + local3rec : tlevel3rec_packed; + local4rec : tlevel4rec_packed; + local5rec : tlevel5rec_packed; +begin + { normal record access } + Write('Non-Aligned simple local record access (secondvecn())...'); + failed := false; + + clear_globals; + + clear_globals; + local1rec.c := RESULT_U8BIT; + c:= local1rec.c; + if c <> RESULT_U8BIT then + failed := true; + + clear_globals; + { setup values - assign } + local2rec.c := RESULT_U8BIT; + local2rec.d := RESULT_U8BIT; + local2rec.s := RESULT_U16BIT; + local2rec.n := RESULT_S32BIT; + { load values - load } + c:= local2rec.c; + if c <> RESULT_U8BIT then + failed := true; + d:= local2rec.d; + if d <> RESULT_U8BIT then + failed := true; + s:= local2rec.s; + if s <> RESULT_U16BIT then + failed := true; + n:= local2rec.n; + if n <> RESULT_S32BIT then + failed := true; + + + clear_globals; + { setup values - assign } + local3rec.c := RESULT_U8BIT; + local3rec.s := RESULT_U16BIT; + c:= local3rec.c; + if c <> RESULT_U8BIT then + failed := true; + s:= local3rec.s; + if s <> RESULT_U16BIT then + failed := true; + + clear_globals; + { setup values - assign } + local4rec.c := RESULT_U8BIT; + local4rec.i := RESULT_S64BIT; + local4rec.s := RESULT_U16BIT; + + c:= local4rec.c; + if c <> RESULT_U8BIT then + failed := true; + i:= local4rec.i; + if i <> RESULT_S64BIT then + failed := true; + s:= local4rec.s; + if s <> RESULT_U16BIT then + failed := true; + + clear_globals; + { setup values - assign } + local5rec.c := RESULT_U8BIT; + local5rec.s := RESULT_U16BIT; + local5rec.j := RESULT_S32BIT; + + c:= local5rec.c; + if c <> RESULT_U8BIT then + failed := true; + s:= local5rec.s; + if s <> RESULT_U16BIT then + failed := true; + j:= local5rec.j; + if j <> RESULT_S32BIT then + failed := true; + + if failed then + fail + else + WriteLN('Passed!'); +end; +{---------------------------} + +var + level1rec_big : tlevel1rec_big; + level2rec_big : tlevel2rec_big; + level3rec_big : tlevel3rec_big; + level4rec_big : tlevel4rec_big; + level5rec_big : tlevel5rec_big; +begin + { normal record access } + Write('Aligned simple global record access (secondvecn())...'); + failed := false; + + clear_globals; + c:= level1rec.c; + if c <> RESULT_U8BIT then + failed := true; + + clear_globals; + c:= level2rec.c; + if c <> RESULT_U8BIT then + failed := true; + d:= level2rec.d; + if d <> RESULT_U8BIT then + failed := true; + s:= level2rec.s; + if s <> RESULT_U16BIT then + failed := true; + n:= level2rec.n; + if n <> RESULT_S32BIT then + failed := true; + + + clear_globals; + c:= level3rec.c; + if c <> RESULT_U8BIT then + failed := true; + s:= level3rec.s; + if s <> RESULT_U16BIT then + failed := true; + + + clear_globals; + c:= level4rec.c; + if c <> RESULT_U8BIT then + failed := true; + i:= level4rec.i; + if i <> RESULT_S64BIT then + failed := true; + s:= level4rec.s; + if s <> RESULT_U16BIT then + failed := true; + + clear_globals; + c:= level5rec.c; + if c <> RESULT_U8BIT then + failed := true; + s:= level5rec.s; + if s <> RESULT_U16BIT then + failed := true; + j:= level5rec.j; + if j <> RESULT_S32BIT then + failed := true; + + if failed then + fail + else + WriteLN('Passed!'); + + Write('Non-Aligned simple global record access (secondvecn())...'); + + clear_globals; + c:= level1rec_packed.c; + if c <> RESULT_U8BIT then + failed := true; + + clear_globals; + c:= level2rec_packed.c; + if c <> RESULT_U8BIT then + failed := true; + d:= level2rec_packed.d; + if d <> RESULT_U8BIT then + failed := true; + s:= level2rec_packed.s; + if s <> RESULT_U16BIT then + failed := true; + n:= level2rec_packed.n; + if n <> RESULT_S32BIT then + failed := true; + + + clear_globals; + c:= level3rec_packed.c; + if c <> RESULT_U8BIT then + failed := true; + s:= level3rec_packed.s; + if s <> RESULT_U16BIT then + failed := true; + + + clear_globals; + c:= level4rec_packed.c; + if c <> RESULT_U8BIT then + failed := true; + i:= level4rec_packed.i; + if i <> RESULT_S64BIT then + failed := true; + s:= level4rec_packed.s; + if s <> RESULT_U16BIT then + failed := true; + + clear_globals; + c:= level5rec_packed.c; + if c <> RESULT_U8BIT then + failed := true; + s:= level5rec_packed.s; + if s <> RESULT_U16BIT then + failed := true; + j:= level5rec_packed.j; + if j <> RESULT_S32BIT then + failed := true; + + if failed then + fail + else + WriteLN('Passed!'); + + Write('Non-Aligned big global record access (secondvecn())...'); + + clear_globals; + level1rec_big.c := RESULT_U8BIT; + c:= level1rec_big.c; + if c <> RESULT_U8BIT then + failed := true; + + clear_globals; + { setup values - assign } + level2rec_big.c := RESULT_U8BIT; + level2rec_big.d := RESULT_U8BIT; + level2rec_big.s := RESULT_U16BIT; + level2rec_big.n := RESULT_S32BIT; + { load values - load } + c:= level2rec_big.c; + if c <> RESULT_U8BIT then + failed := true; + d:= level2rec_big.d; + if d <> RESULT_U8BIT then + failed := true; + s:= level2rec_big.s; + if s <> RESULT_U16BIT then + failed := true; + n:= level2rec_big.n; + if n <> RESULT_S32BIT then + failed := true; + + + clear_globals; + { setup values - assign } + level3rec_big.c := RESULT_U8BIT; + level3rec_big.s := RESULT_U16BIT; + c:= level3rec_big.c; + if c <> RESULT_U8BIT then + failed := true; + s:= level3rec_big.s; + if s <> RESULT_U16BIT then + failed := true; + + clear_globals; + { setup values - assign } + level4rec_big.c := RESULT_U8BIT; + level4rec_big.i := RESULT_S64BIT; + level4rec_big.s := RESULT_U16BIT; + + c:= level4rec_big.c; + if c <> RESULT_U8BIT then + failed := true; + i:= level4rec_big.i; + if i <> RESULT_S64BIT then + failed := true; + s:= level4rec_big.s; + if s <> RESULT_U16BIT then + failed := true; + + clear_globals; + { setup values - assign } + level5rec_big.c := RESULT_U8BIT; + level5rec_big.s := RESULT_U16BIT; + level5rec_big.j := RESULT_S32BIT; + + c:= level5rec_big.c; + if c <> RESULT_U8BIT then + failed := true; + s:= level5rec_big.s; + if s <> RESULT_U16BIT then + failed := true; + j:= level5rec_big.j; + if j <> RESULT_S32BIT then + failed := true; + + if failed then + fail + else + WriteLN('Passed!'); + + testlocals; + +{$ifndef cpu68k} + Write('Non-Aligned big local record access (secondvecn())...'); + failed := false; + + testlocal_big_1; + testlocal_big_2; + testlocal_big_3; + testlocal_big_4; + testlocal_big_5; + if failed then + fail + else + WriteLN('Passed!'); +{$endif} + Write('Aligned class big field access (secondvecn())...'); + clear_globals; + failed := false; + + + { LOC_REFERENCE } + class1:=tclass1.create; + class1.c:= RESULT_U8BIT; + class1.j:= RESULT_S32BIT; + class1.s:= RESULT_U16BIT; + c:=class1.c; + if c <> RESULT_U8BIT then + failed := true; + j:=class1.j; + if j <> RESULT_S32BIT then + failed := true; + s:=class1.s; + if s <> RESULT_U16BIT then + failed := true; + + class1.destroy; + clear_globals; + + { LOC_REGISTER } + class1:=tclass1.create; + class1.c:= RESULT_U8BIT; + class1.j:= RESULT_S32BIT; + class1.s:= RESULT_U16BIT; + c:=(getclass).c; + if c <> RESULT_U8BIT then + failed := true; + j:=(getclass).j; + if j <> RESULT_S32BIT then + failed := true; + s:=(getclass).s; + if s <> RESULT_U16BIT then + failed := true; + + class1.destroy; + + + if failed then + fail + else + WriteLN('Passed!'); + {----------------------------------------------------------------------------} + Write('Aligned class simple field access (secondvecn())...'); + clear_globals; + failed := false; + + + { LOC_REFERENCE } + class2:=tclass2.create; + class2.c:= RESULT_U8BIT; + class2.i:= RESULT_S64BIT; + class2.s:= RESULT_U16BIT; + c:=class2.c; + if c <> RESULT_U8BIT then + failed := true; + i:=class2.i; + if i <> RESULT_S64BIT then + failed := true; + s:=class2.s; + if s <> RESULT_U16BIT then + failed := true; + + class2.destroy; + clear_globals; + + { LOC_REGISTER } + class2:=tclass2.create; + class2.c:= RESULT_U8BIT; + class2.i:= RESULT_S64BIT; + class2.s:= RESULT_U16BIT; + c:=(getclass2).c; + if c <> RESULT_U8BIT then + failed := true; + i:=(getclass2).i; + if i <> RESULT_S64BIT then + failed := true; + s:=(getclass2).s; + if s <> RESULT_U16BIT then + failed := true; + + class2.destroy; + + + if failed then + fail + else + WriteLN('Passed!'); + + +end. + +{ + $Log$ + Revision 1.1 2002-05-09 20:16:05 carl + * subscriptn() secondpass testing... + +} \ No newline at end of file