From 2b234527dddc284e8d5912a46e99eaf44b8c2360 Mon Sep 17 00:00:00 2001 From: florian Date: Sat, 24 Jan 2004 21:12:47 +0000 Subject: [PATCH] * newlines fixed --- tests/test/cg/tsubst.pp | 1541 ++++++++++++++++++++------------------- 1 file changed, 772 insertions(+), 769 deletions(-) diff --git a/tests/test/cg/tsubst.pp b/tests/test/cg/tsubst.pp index 16436ab923..5c5138eb9d 100644 --- a/tests/test/cg/tsubst.pp +++ b/tests/test/cg/tsubst.pp @@ -1,771 +1,774 @@ -{****************************************************************} -{ 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 cpu68k} - MAX_DISP = 32767; -{$else} - MAX_DISP = 65535; -{$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. - -{ +{****************************************************************} +{ 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 cpu68k} + MAX_DISP = 32767; +{$else} + MAX_DISP = 65535; +{$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.3 2003-04-22 13:03:36 florian + Revision 1.4 2004-01-24 21:12:47 florian + * newlines fixed + + Revision 1.3 2003/04/22 13:03:36 florian * fixed for non i386/m68k cpus - - Revision 1.2 2002/09/07 15:40:56 peter - * old logs removed and tabs fixed - - Revision 1.1 2002/05/09 20:16:05 carl - * subscriptn() secondpass testing... - -} + + Revision 1.2 2002/09/07 15:40:56 peter + * old logs removed and tabs fixed + + Revision 1.1 2002/05/09 20:16:05 carl + * subscriptn() secondpass testing... + +}