diff --git a/tests/test/cg/tcalfun2.pp b/tests/test/cg/tcalfun2.pp
index 690da07be6..4107c53eb6 100644
--- a/tests/test/cg/tcalfun2.pp
+++ b/tests/test/cg/tcalfun2.pp
@@ -1,1417 +1,1420 @@
- {****************************************************************}
- { CODE GENERATOR TEST PROGRAM }
- { By Carl Eric Codere }
- {****************************************************************}
- { NODE TESTED : secondcallparan() }
- {****************************************************************}
- { PRE-REQUISITES: secondload() }
- { secondassign() }
- { secondtypeconv() }
- { secondtryexcept() }
- { secondcalln() }
- { secondadd() }
- {****************************************************************}
- { DEFINES: }
- { FPC = Target is FreePascal compiler }
- {****************************************************************}
- { REMARKS: This tests a subset of the secondcalln() node }
- { (function return values with pascal calling cnvs) }
- { (also tests nested routines up to 2 level deep) }
- {****************************************************************}
- program tcalfun2;
-
- {$ifdef fpc}
- {$mode objfpc}
- {$INLINE ON}
- {$endif}
- {$R+}
- {$P-}
-
-{$ifdef VER70}
- {$define tp}
-{$endif}
-
-
- { REAL should map to single or double }
- { so it is not checked, since single }
- { double nodes are checked. }
-
- { assumes that enumdef is the same as orddef (same storage format) }
-
- const
- { should be defined depending on CPU target }
-{$ifdef fpc}
- {$ifdef cpu68k}
- BIG_INDEX = 8000;
- SMALL_INDEX = 13;
- {$else}
- BIG_INDEX = 33000;
- SMALL_INDEX = 13; { value should not be aligned! }
- {$endif}
-{$else}
- BIG_INDEX = 33000;
- SMALL_INDEX = 13; { value should not be aligned! }
-{$endif}
- RESULT_U8BIT = $55;
- RESULT_U16BIT = $500F;
- RESULT_S32BIT = $500F0000;
- RESULT_S64BIT = $500F0000;
- RESULT_S32REAL = 1777.12;
- RESULT_S64REAL = 3444.24;
- RESULT_BOOL8BIT = 1;
- RESULT_BOOL16BIT = 1;
- RESULT_BOOL32BIT = 1;
- RESULT_PCHAR = 'Hello world';
- RESULT_BIGSTRING = 'Hello world';
- RESULT_SMALLSTRING = 'H';
- RESULT_CHAR = 'I';
- RESULT_BOOLEAN = TRUE;
-
- type
- {$ifndef tp}
- tclass1 = class
- end;
- {$else}
- shortstring = string;
- {$endif}
-
- tprocedure = procedure;
-
- tsmallrecord = packed record
- b: byte;
- w: word;
- end;
-
- tlargerecord = packed record
- b: array[1..BIG_INDEX] of byte;
- end;
-
- tsmallarray = packed array[1..SMALL_INDEX] of byte;
-
- tsmallsetenum =
- (A_A,A_B,A_C,A_D);
-
- tsmallset = set of tsmallsetenum;
- tlargeset = set of char;
-
- tsmallstring = string[2];
-
-
-
-
-
- var
- global_u8bit : byte;
- global_u16bit : word;
- global_s32bit : longint;
- global_s32real : single;
- global_s64real : double;
- global_ptr : pchar;
- global_proc : tprocedure;
- global_bigstring : shortstring;
- global_boolean : boolean;
- global_char : char;
- {$ifndef tp}
- global_class : tclass1;
- global_s64bit : int64;
- value_s64bit : int64;
- value_class : tclass1;
- {$endif}
- value_ansistring : ansistring;
- value_u8bit : byte;
- value_u16bit : word;
- value_s32bit : longint;
- value_s32real : single;
- value_s64real : double;
- value_proc : tprocedure;
- value_ptr : pchar;
- value_smallrec : tsmallrecord;
- value_largerec : tlargerecord;
- value_smallset : tsmallset;
- value_smallstring : tsmallstring;
- value_bigstring : shortstring;
- value_largeset : tlargeset;
- value_smallarray : tsmallarray;
- value_boolean : boolean;
- value_char : char;
-
- procedure fail;
- begin
- WriteLn('Failure.');
- halt(1);
- end;
-
-
- procedure clear_globals;
- begin
- global_u8bit := 0;
- global_u16bit := 0;
- global_s32bit := 0;
- global_s32real := 0.0;
- global_s64real := 0.0;
- global_ptr := nil;
- global_proc := nil;
- global_bigstring := '';
- global_boolean := false;
- global_char := #0;
- global_s64bit := 0;
- global_class := nil;
- end;
-
-
- procedure clear_values;
- begin
- value_u8bit := 0;
- value_u16bit := 0;
- value_s32bit := 0;
- value_s32real := 0.0;
- value_s64real := 0.0;
- value_proc := nil;
- value_ptr := nil;
- fillchar(value_smallrec, sizeof(value_smallrec), #0);
- fillchar(value_largerec, sizeof(value_largerec), #0);
- value_smallset := [];
- value_smallstring := '';
- value_bigstring := '';
- value_largeset := [];
- fillchar(value_smallarray, sizeof(value_smallarray), #0);
- value_boolean := false;
- value_char:=#0;
- value_ansistring := '';
- {$ifndef tp}
- value_s64bit := 0;
- value_class := nil;
- {$endif}
- end;
-
-
-
- {********************************* FUNCTION RESULTS *************************}
-
-{ LOC_MEM return values }
-function func_array: tsmallarray;pascal;
- var
- smallarray: tsmallarray;
- begin
- fillchar(smallarray, sizeof(smallarray), #0);
- smallarray[1] := RESULT_U8BIT;
- smallarray[SMALL_INDEX] := RESULT_U8BIT;
- func_array := smallarray;
- end;
-
-function func_largerecord: tlargerecord;pascal;
- var
- largerecord : tlargerecord;
- begin
- fillchar(largerecord, sizeof(largerecord), #0);
- largerecord.b[1] := RESULT_U8BIT;
- largerecord.b[BIG_INDEX] := RESULT_U8BIT;
- func_largerecord := largerecord;
- end;
-
-function func_shortstring: shortstring;pascal;
- begin
- func_shortstring := RESULT_BIGSTRING;
- end;
-
-function func_largeset : tlargeset;pascal;
- var
- largeset : tlargeset;
- begin
- largeset := ['I'];
- func_largeset := largeset;
- end;
-
-function func_u8bit : byte;pascal;
- begin
- func_u8bit := RESULT_U8BIT;
- end;
-
-function func_u16bit : word;pascal;
- begin
- func_u16bit := RESULT_U16BIT;
- end;
-
-function func_s32bit : longint;pascal;
- begin
- func_s32bit := RESULT_S32BIT;
- end;
-
-function func_s64bit : int64;pascal;
- begin
- func_s64bit := RESULT_S64BIT;
- end;
-
-function func_s32real : single;pascal;
- begin
- func_s32real := RESULT_S32REAL;
- end;
-
-function func_s64real : double;pascal;
- begin
- func_s64real := RESULT_S64REAl;
- end;
-
-function func_ansistring : ansistring;pascal;
- begin
- func_ansistring := RESULT_BIGSTRING;
- end;
-
-function func_pchar : pchar;pascal;
- begin
- func_pchar := RESULT_PCHAR;
- end;
-
- {************************** FUNCTION RESULT WITH PARAMS ******************}
-{ LOC_MEM return values }
-function func_array_mixed(b: byte): tsmallarray;pascal;
- var
- local_b: byte;
- smallarray: tsmallarray;
- begin
- fillchar(smallarray, sizeof(smallarray), #0);
- smallarray[1] := RESULT_U8BIT;
- smallarray[SMALL_INDEX] := RESULT_U8BIT;
- func_array_mixed := smallarray;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_largerecord_mixed(b: byte): tlargerecord;pascal;
- var
- local_b: byte;
- largerecord : tlargerecord;
- begin
- fillchar(largerecord, sizeof(largerecord), #0);
- largerecord.b[1] := RESULT_U8BIT;
- largerecord.b[BIG_INDEX] := RESULT_U8BIT;
- func_largerecord_mixed := largerecord;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_shortstring_mixed(b: byte): shortstring;pascal;
- var
- local_b: byte;
- begin
- func_shortstring_mixed := RESULT_BIGSTRING;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_largeset_mixed(b: byte) : tlargeset;pascal;
- var
- local_b: byte;
- largeset : tlargeset;
- begin
- largeset := ['I'];
- func_largeset_mixed := largeset;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_u8bit_mixed(b: byte) : byte;pascal;
- var
- local_b: byte;
- begin
- func_u8bit_mixed := RESULT_U8BIT;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_u16bit_mixed(b: byte) : word;pascal;
- var
- local_b: byte;
- begin
- func_u16bit_mixed := RESULT_U16BIT;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_s32bit_mixed(b: byte) : longint;pascal;
- var
- local_b: byte;
- begin
- func_s32bit_mixed := RESULT_S32BIT;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_s64bit_mixed(b: byte) : int64;pascal;
- var
- local_b: byte;
- begin
- func_s64bit_mixed := RESULT_S64BIT;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_s32real_mixed(b: byte) : single;pascal;
- var
- local_b: byte;
- begin
- func_s32real_mixed := RESULT_S32REAL;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_s64real_mixed(b: byte) : double;pascal;
- var
- local_b: byte;
- begin
- func_s64real_mixed := RESULT_S64REAl;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_ansistring_mixed(b: byte) : ansistring;pascal;
- var
- local_b: byte;
- begin
- func_ansistring_mixed := RESULT_BIGSTRING;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_pchar_mixed(b: byte) : pchar;pascal;
- var
- local_b: byte;
- begin
- func_pchar_mixed := RESULT_PCHAR;
- local_b:=b;
- global_u8bit := b;
- end;
-
- {********************* FUNCTION RESULT WITH PARAMS (NESTED) ******************}
-{ LOC_MEM return values }
-function func_array_mixed_nested(b: byte): tsmallarray;pascal;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- smallarray: tsmallarray;
- begin
- fillchar(smallarray, sizeof(smallarray), #0);
- smallarray[1] := RESULT_U8BIT;
- smallarray[SMALL_INDEX] := RESULT_U8BIT;
- func_array_mixed_nested := smallarray;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
-{ nested_one_proc(RESULT_S32BIT);}
- end;
-
-function func_largerecord_mixed_nested(b: byte): tlargerecord;pascal;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- largerecord : tlargerecord;
- begin
- fillchar(largerecord, sizeof(largerecord), #0);
- largerecord.b[1] := RESULT_U8BIT;
- largerecord.b[BIG_INDEX] := RESULT_U8BIT;
- func_largerecord_mixed_nested := largerecord;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_shortstring_mixed_nested(b: byte): shortstring;pascal;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
- var
- local_b: byte;
- begin
- func_shortstring_mixed_nested := RESULT_BIGSTRING;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_largeset_mixed_nested(b: byte) : tlargeset;pascal;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- largeset : tlargeset;
- begin
- largeset := ['I'];
- func_largeset_mixed_nested := largeset;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_u8bit_mixed_nested(b: byte) : byte;pascal;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_u8bit_mixed_nested := RESULT_U8BIT;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_u16bit_mixed_nested(b: byte) : word;pascal;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_u16bit_mixed_nested := RESULT_U16BIT;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_s32bit_mixed_nested(b: byte) : longint;pascal;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_s32bit_mixed_nested := RESULT_S32BIT;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_s64bit_mixed_nested(b: byte) : int64;pascal;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_s64bit_mixed_nested := RESULT_S64BIT;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_s32real_mixed_nested(b: byte) : single;pascal;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_s32real_mixed_nested := RESULT_S32REAL;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_s64real_mixed_nested(b: byte) : double;pascal;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_s64real_mixed_nested := RESULT_S64REAl;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_ansistring_mixed_nested(b: byte) : ansistring;pascal;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_ansistring_mixed_nested := RESULT_BIGSTRING;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_pchar_mixed_nested(b: byte) : pchar;pascal;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_pchar_mixed_nested := RESULT_PCHAR;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-
-var
- failed: boolean;
-Begin
- {************************************* SIMPLE TESTS ***********************************}
- write('Testing function results (LOC_REFERENCE)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_smallarray := func_array;
- if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
- failed := true;
-
- clear_globals;
- clear_values;
- value_largerec := func_largerecord;
- if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[BIG_INDEX] <> RESULT_U8BIT) then
- failed:=true;
-
- clear_globals;
- clear_values;
- value_bigstring := func_shortstring;
- if value_bigstring <> RESULT_BIGSTRING then
- failed := true;
-
- clear_globals;
- clear_values;
- value_largeset := func_largeset;
- if not ('I' in value_largeset) then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing orddef/enumdef function results (LOC_REGISTER)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
-
- value_u8bit := func_u8bit;
- if value_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_u16bit := func_u16bit;
- if value_u16bit <> RESULT_U16BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s32bit := func_s32bit;
- if value_s32bit <> RESULT_S32BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s64bit := func_s64bit;
- if value_s64bit <> RESULT_S64BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
-
- write('Testing floatdef function results...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- clear_globals;
- clear_values;
- value_s32real := func_s32real;
- if trunc(value_s32real) <> trunc(RESULT_S32REAL) then
- failed:=true;
-
- clear_globals;
- clear_values;
- value_s64real := func_s64real;
- if trunc(value_s64real) <> trunc(RESULT_S64REAL) then
- failed:=true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing ansistring function result...');
-
- clear_globals;
- clear_values;
- failed := false;
-
-
-value_ansistring := func_ansistring;
-if value_ansistring <> RESULT_BIGSTRING then
- failed:=true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing pointer function result (LOC_REGISTER)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_ptr := func_pchar;
- if value_ptr <> RESULT_PCHAR then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- {*********************************** TESTS W/PARAMS ***********************************}
- write('Testing function results with parameter (LOC_REFERENCE)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_smallarray := func_array_mixed(RESULT_U8BIT);
- if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_largerec := func_largerecord_mixed(RESULT_U8BIT);
- if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[BIG_INDEX] <> RESULT_U8BIT) then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_bigstring := func_shortstring_mixed(RESULT_U8BIT);
- if value_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_largeset := func_largeset_mixed(RESULT_U8BIT);
- if not ('I' in value_largeset) then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing orddef/enumdef function results with parameter (LOC_REGISTER)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
-
- value_u8bit := func_u8bit_mixed(RESULT_U8BIT);
- if value_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_u16bit := func_u16bit_mixed(RESULT_U8BIT);
- if value_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s32bit := func_s32bit_mixed(RESULT_U8BIT);
- if value_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s64bit := func_s64bit_mixed(RESULT_U8BIT);
- if value_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
-
- write('Testing floatdef function results with parameter...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_s32real := func_s32real_mixed(RESULT_U8BIT);
- if trunc(value_s32real) <> trunc(RESULT_S32REAL) then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s64real := func_s64real_mixed(RESULT_U8BIT);
- if trunc(value_s64real) <> trunc(RESULT_S64REAL) then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing ansistring function result with parameter...');
-
- clear_globals;
- clear_values;
- failed := false;
-
-
- value_ansistring := func_ansistring_mixed(RESULT_U8BIT);
- if value_ansistring <> RESULT_BIGSTRING then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing pointer function result with parameter (LOC_REGISTER)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_ptr := func_pchar_mixed(RESULT_U8BIT);
- if value_ptr <> RESULT_PCHAR then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- {******************************NESTED TESTS W/PARAMS **********************************}
- write('Testing function (w/nesting) results with parameter (LOC_REFERENCE)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_smallarray := func_array_mixed_nested(RESULT_U8BIT);
- if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_largerec := func_largerecord_mixed_nested(RESULT_U8BIT);
- if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[BIG_INDEX] <> RESULT_U8BIT) then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_bigstring := func_shortstring_mixed_nested(RESULT_U8BIT);
- if value_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_largeset := func_largeset_mixed_nested(RESULT_U8BIT);
- if not ('I' in value_largeset) then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing orddef/enumdef function (w/nesting) results with parameter (LOC_REGISTER)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
-
- value_u8bit := func_u8bit_mixed_nested(RESULT_U8BIT);
- if value_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_u16bit := func_u16bit_mixed_nested(RESULT_U8BIT);
- if value_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s32bit := func_s32bit_mixed_nested(RESULT_U8BIT);
- if value_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s64bit := func_s64bit_mixed_nested(RESULT_U8BIT);
- if value_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
-
- write('Testing floatdef function (w/nesting) results with parameter...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_s32real := func_s32real_mixed_nested(RESULT_U8BIT);
- if trunc(value_s32real) <> trunc(RESULT_S32REAL) then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s64real := func_s64real_mixed_nested(RESULT_U8BIT);
- if trunc(value_s64real) <> trunc(RESULT_S64REAL) then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing ansistring function (w/nesting) result with parameter...');
-
- clear_globals;
- clear_values;
- failed := false;
-
-
- value_ansistring := func_ansistring_mixed_nested(RESULT_U8BIT);
- if value_ansistring <> RESULT_BIGSTRING then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing pointer function (w/nesting) result with parameter (LOC_REGISTER)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_ptr := func_pchar_mixed_nested(RESULT_U8BIT);
- if value_ptr <> RESULT_PCHAR then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-end.
-
-{
+ {****************************************************************}
+ { CODE GENERATOR TEST PROGRAM }
+ { By Carl Eric Codere }
+ {****************************************************************}
+ { NODE TESTED : secondcallparan() }
+ {****************************************************************}
+ { PRE-REQUISITES: secondload() }
+ { secondassign() }
+ { secondtypeconv() }
+ { secondtryexcept() }
+ { secondcalln() }
+ { secondadd() }
+ {****************************************************************}
+ { DEFINES: }
+ { FPC = Target is FreePascal compiler }
+ {****************************************************************}
+ { REMARKS: This tests a subset of the secondcalln() node }
+ { (function return values with pascal calling cnvs) }
+ { (also tests nested routines up to 2 level deep) }
+ {****************************************************************}
+ program tcalfun2;
+
+ {$ifdef fpc}
+ {$mode objfpc}
+ {$INLINE ON}
+ {$endif}
+ {$R+}
+ {$P-}
+
+{$ifdef VER70}
+ {$define tp}
+{$endif}
+
+
+ { REAL should map to single or double }
+ { so it is not checked, since single }
+ { double nodes are checked. }
+
+ { assumes that enumdef is the same as orddef (same storage format) }
+
+ const
+ { should be defined depending on CPU target }
+{$ifdef fpc}
+ {$ifdef cpu68k}
+ BIG_INDEX = 8000;
+ SMALL_INDEX = 13;
+ {$else}
+ BIG_INDEX = 33000;
+ SMALL_INDEX = 13; { value should not be aligned! }
+ {$endif}
+{$else}
+ BIG_INDEX = 33000;
+ SMALL_INDEX = 13; { value should not be aligned! }
+{$endif}
+ RESULT_U8BIT = $55;
+ RESULT_U16BIT = $500F;
+ RESULT_S32BIT = $500F0000;
+ RESULT_S64BIT = $500F0000;
+ RESULT_S32REAL = 1777.12;
+ RESULT_S64REAL = 3444.24;
+ RESULT_BOOL8BIT = 1;
+ RESULT_BOOL16BIT = 1;
+ RESULT_BOOL32BIT = 1;
+ RESULT_PCHAR = 'Hello world';
+ RESULT_BIGSTRING = 'Hello world';
+ RESULT_SMALLSTRING = 'H';
+ RESULT_CHAR = 'I';
+ RESULT_BOOLEAN = TRUE;
+
+ type
+ {$ifndef tp}
+ tclass1 = class
+ end;
+ {$else}
+ shortstring = string;
+ {$endif}
+
+ tprocedure = procedure;
+
+ tsmallrecord = packed record
+ b: byte;
+ w: word;
+ end;
+
+ tlargerecord = packed record
+ b: array[1..BIG_INDEX] of byte;
+ end;
+
+ tsmallarray = packed array[1..SMALL_INDEX] of byte;
+
+ tsmallsetenum =
+ (A_A,A_B,A_C,A_D);
+
+ tsmallset = set of tsmallsetenum;
+ tlargeset = set of char;
+
+ tsmallstring = string[2];
+
+
+
+
+
+ var
+ global_u8bit : byte;
+ global_u16bit : word;
+ global_s32bit : longint;
+ global_s32real : single;
+ global_s64real : double;
+ global_ptr : pchar;
+ global_proc : tprocedure;
+ global_bigstring : shortstring;
+ global_boolean : boolean;
+ global_char : char;
+ {$ifndef tp}
+ global_class : tclass1;
+ global_s64bit : int64;
+ value_s64bit : int64;
+ value_class : tclass1;
+ {$endif}
+ value_ansistring : ansistring;
+ value_u8bit : byte;
+ value_u16bit : word;
+ value_s32bit : longint;
+ value_s32real : single;
+ value_s64real : double;
+ value_proc : tprocedure;
+ value_ptr : pchar;
+ value_smallrec : tsmallrecord;
+ value_largerec : tlargerecord;
+ value_smallset : tsmallset;
+ value_smallstring : tsmallstring;
+ value_bigstring : shortstring;
+ value_largeset : tlargeset;
+ value_smallarray : tsmallarray;
+ value_boolean : boolean;
+ value_char : char;
+
+ procedure fail;
+ begin
+ WriteLn('Failure.');
+ halt(1);
+ end;
+
+
+ procedure clear_globals;
+ begin
+ global_u8bit := 0;
+ global_u16bit := 0;
+ global_s32bit := 0;
+ global_s32real := 0.0;
+ global_s64real := 0.0;
+ global_ptr := nil;
+ global_proc := nil;
+ global_bigstring := '';
+ global_boolean := false;
+ global_char := #0;
+ global_s64bit := 0;
+ global_class := nil;
+ end;
+
+
+ procedure clear_values;
+ begin
+ value_u8bit := 0;
+ value_u16bit := 0;
+ value_s32bit := 0;
+ value_s32real := 0.0;
+ value_s64real := 0.0;
+ value_proc := nil;
+ value_ptr := nil;
+ fillchar(value_smallrec, sizeof(value_smallrec), #0);
+ fillchar(value_largerec, sizeof(value_largerec), #0);
+ value_smallset := [];
+ value_smallstring := '';
+ value_bigstring := '';
+ value_largeset := [];
+ fillchar(value_smallarray, sizeof(value_smallarray), #0);
+ value_boolean := false;
+ value_char:=#0;
+ value_ansistring := '';
+ {$ifndef tp}
+ value_s64bit := 0;
+ value_class := nil;
+ {$endif}
+ end;
+
+
+
+ {********************************* FUNCTION RESULTS *************************}
+
+{ LOC_MEM return values }
+function func_array: tsmallarray;pascal;
+ var
+ smallarray: tsmallarray;
+ begin
+ fillchar(smallarray, sizeof(smallarray), #0);
+ smallarray[1] := RESULT_U8BIT;
+ smallarray[SMALL_INDEX] := RESULT_U8BIT;
+ func_array := smallarray;
+ end;
+
+function func_largerecord: tlargerecord;pascal;
+ var
+ largerecord : tlargerecord;
+ begin
+ fillchar(largerecord, sizeof(largerecord), #0);
+ largerecord.b[1] := RESULT_U8BIT;
+ largerecord.b[BIG_INDEX] := RESULT_U8BIT;
+ func_largerecord := largerecord;
+ end;
+
+function func_shortstring: shortstring;pascal;
+ begin
+ func_shortstring := RESULT_BIGSTRING;
+ end;
+
+function func_largeset : tlargeset;pascal;
+ var
+ largeset : tlargeset;
+ begin
+ largeset := ['I'];
+ func_largeset := largeset;
+ end;
+
+function func_u8bit : byte;pascal;
+ begin
+ func_u8bit := RESULT_U8BIT;
+ end;
+
+function func_u16bit : word;pascal;
+ begin
+ func_u16bit := RESULT_U16BIT;
+ end;
+
+function func_s32bit : longint;pascal;
+ begin
+ func_s32bit := RESULT_S32BIT;
+ end;
+
+function func_s64bit : int64;pascal;
+ begin
+ func_s64bit := RESULT_S64BIT;
+ end;
+
+function func_s32real : single;pascal;
+ begin
+ func_s32real := RESULT_S32REAL;
+ end;
+
+function func_s64real : double;pascal;
+ begin
+ func_s64real := RESULT_S64REAl;
+ end;
+
+function func_ansistring : ansistring;pascal;
+ begin
+ func_ansistring := RESULT_BIGSTRING;
+ end;
+
+function func_pchar : pchar;pascal;
+ begin
+ func_pchar := RESULT_PCHAR;
+ end;
+
+ {************************** FUNCTION RESULT WITH PARAMS ******************}
+{ LOC_MEM return values }
+function func_array_mixed(b: byte): tsmallarray;pascal;
+ var
+ local_b: byte;
+ smallarray: tsmallarray;
+ begin
+ fillchar(smallarray, sizeof(smallarray), #0);
+ smallarray[1] := RESULT_U8BIT;
+ smallarray[SMALL_INDEX] := RESULT_U8BIT;
+ func_array_mixed := smallarray;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_largerecord_mixed(b: byte): tlargerecord;pascal;
+ var
+ local_b: byte;
+ largerecord : tlargerecord;
+ begin
+ fillchar(largerecord, sizeof(largerecord), #0);
+ largerecord.b[1] := RESULT_U8BIT;
+ largerecord.b[BIG_INDEX] := RESULT_U8BIT;
+ func_largerecord_mixed := largerecord;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_shortstring_mixed(b: byte): shortstring;pascal;
+ var
+ local_b: byte;
+ begin
+ func_shortstring_mixed := RESULT_BIGSTRING;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_largeset_mixed(b: byte) : tlargeset;pascal;
+ var
+ local_b: byte;
+ largeset : tlargeset;
+ begin
+ largeset := ['I'];
+ func_largeset_mixed := largeset;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_u8bit_mixed(b: byte) : byte;pascal;
+ var
+ local_b: byte;
+ begin
+ func_u8bit_mixed := RESULT_U8BIT;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_u16bit_mixed(b: byte) : word;pascal;
+ var
+ local_b: byte;
+ begin
+ func_u16bit_mixed := RESULT_U16BIT;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_s32bit_mixed(b: byte) : longint;pascal;
+ var
+ local_b: byte;
+ begin
+ func_s32bit_mixed := RESULT_S32BIT;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_s64bit_mixed(b: byte) : int64;pascal;
+ var
+ local_b: byte;
+ begin
+ func_s64bit_mixed := RESULT_S64BIT;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_s32real_mixed(b: byte) : single;pascal;
+ var
+ local_b: byte;
+ begin
+ func_s32real_mixed := RESULT_S32REAL;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_s64real_mixed(b: byte) : double;pascal;
+ var
+ local_b: byte;
+ begin
+ func_s64real_mixed := RESULT_S64REAl;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_ansistring_mixed(b: byte) : ansistring;pascal;
+ var
+ local_b: byte;
+ begin
+ func_ansistring_mixed := RESULT_BIGSTRING;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_pchar_mixed(b: byte) : pchar;pascal;
+ var
+ local_b: byte;
+ begin
+ func_pchar_mixed := RESULT_PCHAR;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+ {********************* FUNCTION RESULT WITH PARAMS (NESTED) ******************}
+{ LOC_MEM return values }
+function func_array_mixed_nested(b: byte): tsmallarray;pascal;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ smallarray: tsmallarray;
+ begin
+ fillchar(smallarray, sizeof(smallarray), #0);
+ smallarray[1] := RESULT_U8BIT;
+ smallarray[SMALL_INDEX] := RESULT_U8BIT;
+ func_array_mixed_nested := smallarray;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+{ nested_one_proc(RESULT_S32BIT);}
+ end;
+
+function func_largerecord_mixed_nested(b: byte): tlargerecord;pascal;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ largerecord : tlargerecord;
+ begin
+ fillchar(largerecord, sizeof(largerecord), #0);
+ largerecord.b[1] := RESULT_U8BIT;
+ largerecord.b[BIG_INDEX] := RESULT_U8BIT;
+ func_largerecord_mixed_nested := largerecord;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_shortstring_mixed_nested(b: byte): shortstring;pascal;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+ var
+ local_b: byte;
+ begin
+ func_shortstring_mixed_nested := RESULT_BIGSTRING;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_largeset_mixed_nested(b: byte) : tlargeset;pascal;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ largeset : tlargeset;
+ begin
+ largeset := ['I'];
+ func_largeset_mixed_nested := largeset;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_u8bit_mixed_nested(b: byte) : byte;pascal;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_u8bit_mixed_nested := RESULT_U8BIT;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_u16bit_mixed_nested(b: byte) : word;pascal;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_u16bit_mixed_nested := RESULT_U16BIT;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_s32bit_mixed_nested(b: byte) : longint;pascal;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_s32bit_mixed_nested := RESULT_S32BIT;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_s64bit_mixed_nested(b: byte) : int64;pascal;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_s64bit_mixed_nested := RESULT_S64BIT;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_s32real_mixed_nested(b: byte) : single;pascal;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_s32real_mixed_nested := RESULT_S32REAL;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_s64real_mixed_nested(b: byte) : double;pascal;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_s64real_mixed_nested := RESULT_S64REAl;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_ansistring_mixed_nested(b: byte) : ansistring;pascal;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_ansistring_mixed_nested := RESULT_BIGSTRING;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_pchar_mixed_nested(b: byte) : pchar;pascal;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_pchar_mixed_nested := RESULT_PCHAR;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+
+var
+ failed: boolean;
+Begin
+ {************************************* SIMPLE TESTS ***********************************}
+ write('Testing function results (LOC_REFERENCE)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_smallarray := func_array;
+ if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_largerec := func_largerecord;
+ if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[BIG_INDEX] <> RESULT_U8BIT) then
+ failed:=true;
+
+ clear_globals;
+ clear_values;
+ value_bigstring := func_shortstring;
+ if value_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_largeset := func_largeset;
+ if not ('I' in value_largeset) then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing orddef/enumdef function results (LOC_REGISTER)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+
+ value_u8bit := func_u8bit;
+ if value_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_u16bit := func_u16bit;
+ if value_u16bit <> RESULT_U16BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s32bit := func_s32bit;
+ if value_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s64bit := func_s64bit;
+ if value_s64bit <> RESULT_S64BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+
+ write('Testing floatdef function results...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ clear_globals;
+ clear_values;
+ value_s32real := func_s32real;
+ if trunc(value_s32real) <> trunc(RESULT_S32REAL) then
+ failed:=true;
+
+ clear_globals;
+ clear_values;
+ value_s64real := func_s64real;
+ if trunc(value_s64real) <> trunc(RESULT_S64REAL) then
+ failed:=true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing ansistring function result...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+
+value_ansistring := func_ansistring;
+if value_ansistring <> RESULT_BIGSTRING then
+ failed:=true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing pointer function result (LOC_REGISTER)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_ptr := func_pchar;
+ if value_ptr <> RESULT_PCHAR then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ {*********************************** TESTS W/PARAMS ***********************************}
+ write('Testing function results with parameter (LOC_REFERENCE)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_smallarray := func_array_mixed(RESULT_U8BIT);
+ if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_largerec := func_largerecord_mixed(RESULT_U8BIT);
+ if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[BIG_INDEX] <> RESULT_U8BIT) then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_bigstring := func_shortstring_mixed(RESULT_U8BIT);
+ if value_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_largeset := func_largeset_mixed(RESULT_U8BIT);
+ if not ('I' in value_largeset) then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing orddef/enumdef function results with parameter (LOC_REGISTER)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+
+ value_u8bit := func_u8bit_mixed(RESULT_U8BIT);
+ if value_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_u16bit := func_u16bit_mixed(RESULT_U8BIT);
+ if value_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s32bit := func_s32bit_mixed(RESULT_U8BIT);
+ if value_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s64bit := func_s64bit_mixed(RESULT_U8BIT);
+ if value_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+
+ write('Testing floatdef function results with parameter...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_s32real := func_s32real_mixed(RESULT_U8BIT);
+ if trunc(value_s32real) <> trunc(RESULT_S32REAL) then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s64real := func_s64real_mixed(RESULT_U8BIT);
+ if trunc(value_s64real) <> trunc(RESULT_S64REAL) then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing ansistring function result with parameter...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+
+ value_ansistring := func_ansistring_mixed(RESULT_U8BIT);
+ if value_ansistring <> RESULT_BIGSTRING then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing pointer function result with parameter (LOC_REGISTER)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_ptr := func_pchar_mixed(RESULT_U8BIT);
+ if value_ptr <> RESULT_PCHAR then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ {******************************NESTED TESTS W/PARAMS **********************************}
+ write('Testing function (w/nesting) results with parameter (LOC_REFERENCE)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_smallarray := func_array_mixed_nested(RESULT_U8BIT);
+ if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_largerec := func_largerecord_mixed_nested(RESULT_U8BIT);
+ if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[BIG_INDEX] <> RESULT_U8BIT) then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_bigstring := func_shortstring_mixed_nested(RESULT_U8BIT);
+ if value_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_largeset := func_largeset_mixed_nested(RESULT_U8BIT);
+ if not ('I' in value_largeset) then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing orddef/enumdef function (w/nesting) results with parameter (LOC_REGISTER)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+
+ value_u8bit := func_u8bit_mixed_nested(RESULT_U8BIT);
+ if value_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_u16bit := func_u16bit_mixed_nested(RESULT_U8BIT);
+ if value_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s32bit := func_s32bit_mixed_nested(RESULT_U8BIT);
+ if value_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s64bit := func_s64bit_mixed_nested(RESULT_U8BIT);
+ if value_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+
+ write('Testing floatdef function (w/nesting) results with parameter...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_s32real := func_s32real_mixed_nested(RESULT_U8BIT);
+ if trunc(value_s32real) <> trunc(RESULT_S32REAL) then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s64real := func_s64real_mixed_nested(RESULT_U8BIT);
+ if trunc(value_s64real) <> trunc(RESULT_S64REAL) then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing ansistring function (w/nesting) result with parameter...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+
+ value_ansistring := func_ansistring_mixed_nested(RESULT_U8BIT);
+ if value_ansistring <> RESULT_BIGSTRING then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing pointer function (w/nesting) result with parameter (LOC_REGISTER)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_ptr := func_pchar_mixed_nested(RESULT_U8BIT);
+ if value_ptr <> RESULT_PCHAR then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+end.
+
+{
$Log$
- Revision 1.4 2003-04-22 10:24:29 florian
+ Revision 1.5 2004-05-02 12:11:44 peter
+ * fixed linefeeds
+
+ Revision 1.4 2003/04/22 10:24:29 florian
* fixed defines for powerpc
-
- Revision 1.3 2002/09/07 15:40:51 peter
- * old logs removed and tabs fixed
-
- Revision 1.2 2002/05/13 13:45:36 peter
- * updated to compile tests with kylix
-
- Revision 1.1 2002/04/13 07:45:49 carl
- + Function calling tests , for different calling conventions.
-
-}
+
+ Revision 1.3 2002/09/07 15:40:51 peter
+ * old logs removed and tabs fixed
+
+ Revision 1.2 2002/05/13 13:45:36 peter
+ * updated to compile tests with kylix
+
+ Revision 1.1 2002/04/13 07:45:49 carl
+ + Function calling tests , for different calling conventions.
+
+}
diff --git a/tests/test/cg/tcalfun3.pp b/tests/test/cg/tcalfun3.pp
index 32a2b962af..c6c99cb77e 100644
--- a/tests/test/cg/tcalfun3.pp
+++ b/tests/test/cg/tcalfun3.pp
@@ -1,1417 +1,1420 @@
- {****************************************************************}
- { CODE GENERATOR TEST PROGRAM }
- { By Carl Eric Codere }
- {****************************************************************}
- { NODE TESTED : secondcallparan() }
- {****************************************************************}
- { PRE-REQUISITES: secondload() }
- { secondassign() }
- { secondtypeconv() }
- { secondtryexcept() }
- { secondcalln() }
- { secondadd() }
- {****************************************************************}
- { DEFINES: }
- { FPC = Target is FreePascal compiler }
- {****************************************************************}
- { REMARKS: This tests a subset of the secondcalln() node }
- { (function return values with cdecl calling cnvs) }
- { (also tests nested routines up to 2 level deep) }
- {****************************************************************}
- program tcalfun3;
-
- {$ifdef fpc}
- {$mode objfpc}
- {$INLINE ON}
- {$endif}
- {$R+}
- {$P-}
-
-{$ifdef VER70}
- {$define tp}
-{$endif}
-
-
- { REAL should map to single or double }
- { so it is not checked, since single }
- { double nodes are checked. }
-
- { assumes that enumdef is the same as orddef (same storage format) }
-
- const
- { should be defined depending on CPU target }
-{$ifdef fpc}
- {$ifdef cpu68k}
- BIG_INDEX = 8000;
- SMALL_INDEX = 13;
- {$else}
- BIG_INDEX = 33000;
- SMALL_INDEX = 13; { value should not be aligned! }
- {$endif}
-{$else}
- BIG_INDEX = 33000;
- SMALL_INDEX = 13; { value should not be aligned! }
-{$endif}
- RESULT_U8BIT = $55;
- RESULT_U16BIT = $500F;
- RESULT_S32BIT = $500F0000;
- RESULT_S64BIT = $500F0000;
- RESULT_S32REAL = 1777.12;
- RESULT_S64REAL = 3444.24;
- RESULT_BOOL8BIT = 1;
- RESULT_BOOL16BIT = 1;
- RESULT_BOOL32BIT = 1;
- RESULT_PCHAR = 'Hello world';
- RESULT_BIGSTRING = 'Hello world';
- RESULT_SMALLSTRING = 'H';
- RESULT_CHAR = 'I';
- RESULT_BOOLEAN = TRUE;
-
- type
- {$ifndef tp}
- tclass1 = class
- end;
- {$else}
- shortstring = string;
- {$endif}
-
- tprocedure = procedure;
-
- tsmallrecord = packed record
- b: byte;
- w: word;
- end;
-
- tlargerecord = packed record
- b: array[1..BIG_INDEX] of byte;
- end;
-
- tsmallarray = packed array[1..SMALL_INDEX] of byte;
-
- tsmallsetenum =
- (A_A,A_B,A_C,A_D);
-
- tsmallset = set of tsmallsetenum;
- tlargeset = set of char;
-
- tsmallstring = string[2];
-
-
-
-
-
- var
- global_u8bit : byte;
- global_u16bit : word;
- global_s32bit : longint;
- global_s32real : single;
- global_s64real : double;
- global_ptr : pchar;
- global_proc : tprocedure;
- global_bigstring : shortstring;
- global_boolean : boolean;
- global_char : char;
- {$ifndef tp}
- global_class : tclass1;
- global_s64bit : int64;
- value_s64bit : int64;
- value_class : tclass1;
- {$endif}
- value_ansistring : ansistring;
- value_u8bit : byte;
- value_u16bit : word;
- value_s32bit : longint;
- value_s32real : single;
- value_s64real : double;
- value_proc : tprocedure;
- value_ptr : pchar;
- value_smallrec : tsmallrecord;
- value_largerec : tlargerecord;
- value_smallset : tsmallset;
- value_smallstring : tsmallstring;
- value_bigstring : shortstring;
- value_largeset : tlargeset;
- value_smallarray : tsmallarray;
- value_boolean : boolean;
- value_char : char;
-
- procedure fail;
- begin
- WriteLn('Failure.');
- halt(1);
- end;
-
-
- procedure clear_globals;
- begin
- global_u8bit := 0;
- global_u16bit := 0;
- global_s32bit := 0;
- global_s32real := 0.0;
- global_s64real := 0.0;
- global_ptr := nil;
- global_proc := nil;
- global_bigstring := '';
- global_boolean := false;
- global_char := #0;
- global_s64bit := 0;
- global_class := nil;
- end;
-
-
- procedure clear_values;
- begin
- value_u8bit := 0;
- value_u16bit := 0;
- value_s32bit := 0;
- value_s32real := 0.0;
- value_s64real := 0.0;
- value_proc := nil;
- value_ptr := nil;
- fillchar(value_smallrec, sizeof(value_smallrec), #0);
- fillchar(value_largerec, sizeof(value_largerec), #0);
- value_smallset := [];
- value_smallstring := '';
- value_bigstring := '';
- value_largeset := [];
- fillchar(value_smallarray, sizeof(value_smallarray), #0);
- value_boolean := false;
- value_char:=#0;
- value_ansistring := '';
- {$ifndef tp}
- value_s64bit := 0;
- value_class := nil;
- {$endif}
- end;
-
-
-
- {********************************* FUNCTION RESULTS *************************}
-
-{ LOC_MEM return values }
-function func_array: tsmallarray;cdecl;
- var
- smallarray: tsmallarray;
- begin
- fillchar(smallarray, sizeof(smallarray), #0);
- smallarray[1] := RESULT_U8BIT;
- smallarray[SMALL_INDEX] := RESULT_U8BIT;
- func_array := smallarray;
- end;
-
-function func_largerecord: tlargerecord;cdecl;
- var
- largerecord : tlargerecord;
- begin
- fillchar(largerecord, sizeof(largerecord), #0);
- largerecord.b[1] := RESULT_U8BIT;
- largerecord.b[BIG_INDEX] := RESULT_U8BIT;
- func_largerecord := largerecord;
- end;
-
-function func_shortstring: shortstring;cdecl;
- begin
- func_shortstring := RESULT_BIGSTRING;
- end;
-
-function func_largeset : tlargeset;cdecl;
- var
- largeset : tlargeset;
- begin
- largeset := ['I'];
- func_largeset := largeset;
- end;
-
-function func_u8bit : byte;cdecl;
- begin
- func_u8bit := RESULT_U8BIT;
- end;
-
-function func_u16bit : word;cdecl;
- begin
- func_u16bit := RESULT_U16BIT;
- end;
-
-function func_s32bit : longint;cdecl;
- begin
- func_s32bit := RESULT_S32BIT;
- end;
-
-function func_s64bit : int64;cdecl;
- begin
- func_s64bit := RESULT_S64BIT;
- end;
-
-function func_s32real : single;cdecl;
- begin
- func_s32real := RESULT_S32REAL;
- end;
-
-function func_s64real : double;cdecl;
- begin
- func_s64real := RESULT_S64REAl;
- end;
-
-function func_ansistring : ansistring;cdecl;
- begin
- func_ansistring := RESULT_BIGSTRING;
- end;
-
-function func_pchar : pchar;cdecl;
- begin
- func_pchar := RESULT_PCHAR;
- end;
-
- {************************** FUNCTION RESULT WITH PARAMS ******************}
-{ LOC_MEM return values }
-function func_array_mixed(b: byte): tsmallarray;cdecl;
- var
- local_b: byte;
- smallarray: tsmallarray;
- begin
- fillchar(smallarray, sizeof(smallarray), #0);
- smallarray[1] := RESULT_U8BIT;
- smallarray[SMALL_INDEX] := RESULT_U8BIT;
- func_array_mixed := smallarray;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_largerecord_mixed(b: byte): tlargerecord;cdecl;
- var
- local_b: byte;
- largerecord : tlargerecord;
- begin
- fillchar(largerecord, sizeof(largerecord), #0);
- largerecord.b[1] := RESULT_U8BIT;
- largerecord.b[BIG_INDEX] := RESULT_U8BIT;
- func_largerecord_mixed := largerecord;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_shortstring_mixed(b: byte): shortstring;cdecl;
- var
- local_b: byte;
- begin
- func_shortstring_mixed := RESULT_BIGSTRING;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_largeset_mixed(b: byte) : tlargeset;cdecl;
- var
- local_b: byte;
- largeset : tlargeset;
- begin
- largeset := ['I'];
- func_largeset_mixed := largeset;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_u8bit_mixed(b: byte) : byte;cdecl;
- var
- local_b: byte;
- begin
- func_u8bit_mixed := RESULT_U8BIT;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_u16bit_mixed(b: byte) : word;cdecl;
- var
- local_b: byte;
- begin
- func_u16bit_mixed := RESULT_U16BIT;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_s32bit_mixed(b: byte) : longint;cdecl;
- var
- local_b: byte;
- begin
- func_s32bit_mixed := RESULT_S32BIT;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_s64bit_mixed(b: byte) : int64;cdecl;
- var
- local_b: byte;
- begin
- func_s64bit_mixed := RESULT_S64BIT;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_s32real_mixed(b: byte) : single;cdecl;
- var
- local_b: byte;
- begin
- func_s32real_mixed := RESULT_S32REAL;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_s64real_mixed(b: byte) : double;cdecl;
- var
- local_b: byte;
- begin
- func_s64real_mixed := RESULT_S64REAl;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_ansistring_mixed(b: byte) : ansistring;cdecl;
- var
- local_b: byte;
- begin
- func_ansistring_mixed := RESULT_BIGSTRING;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_pchar_mixed(b: byte) : pchar;cdecl;
- var
- local_b: byte;
- begin
- func_pchar_mixed := RESULT_PCHAR;
- local_b:=b;
- global_u8bit := b;
- end;
-
- {********************* FUNCTION RESULT WITH PARAMS (NESTED) ******************}
-{ LOC_MEM return values }
-function func_array_mixed_nested(b: byte): tsmallarray;cdecl;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- smallarray: tsmallarray;
- begin
- fillchar(smallarray, sizeof(smallarray), #0);
- smallarray[1] := RESULT_U8BIT;
- smallarray[SMALL_INDEX] := RESULT_U8BIT;
- func_array_mixed_nested := smallarray;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
-{ nested_one_proc(RESULT_S32BIT);}
- end;
-
-function func_largerecord_mixed_nested(b: byte): tlargerecord;cdecl;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- largerecord : tlargerecord;
- begin
- fillchar(largerecord, sizeof(largerecord), #0);
- largerecord.b[1] := RESULT_U8BIT;
- largerecord.b[BIG_INDEX] := RESULT_U8BIT;
- func_largerecord_mixed_nested := largerecord;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_shortstring_mixed_nested(b: byte): shortstring;cdecl;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
- var
- local_b: byte;
- begin
- func_shortstring_mixed_nested := RESULT_BIGSTRING;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_largeset_mixed_nested(b: byte) : tlargeset;cdecl;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- largeset : tlargeset;
- begin
- largeset := ['I'];
- func_largeset_mixed_nested := largeset;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_u8bit_mixed_nested(b: byte) : byte;cdecl;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_u8bit_mixed_nested := RESULT_U8BIT;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_u16bit_mixed_nested(b: byte) : word;cdecl;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_u16bit_mixed_nested := RESULT_U16BIT;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_s32bit_mixed_nested(b: byte) : longint;cdecl;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_s32bit_mixed_nested := RESULT_S32BIT;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_s64bit_mixed_nested(b: byte) : int64;cdecl;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_s64bit_mixed_nested := RESULT_S64BIT;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_s32real_mixed_nested(b: byte) : single;cdecl;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_s32real_mixed_nested := RESULT_S32REAL;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_s64real_mixed_nested(b: byte) : double;cdecl;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_s64real_mixed_nested := RESULT_S64REAl;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_ansistring_mixed_nested(b: byte) : ansistring;cdecl;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_ansistring_mixed_nested := RESULT_BIGSTRING;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_pchar_mixed_nested(b: byte) : pchar;cdecl;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_pchar_mixed_nested := RESULT_PCHAR;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-
-var
- failed: boolean;
-Begin
- {************************************* SIMPLE TESTS ***********************************}
- write('Testing function results (LOC_REFERENCE)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_smallarray := func_array;
- if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
- failed := true;
-
- clear_globals;
- clear_values;
- value_largerec := func_largerecord;
- if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[BIG_INDEX] <> RESULT_U8BIT) then
- failed:=true;
-
- clear_globals;
- clear_values;
- value_bigstring := func_shortstring;
- if value_bigstring <> RESULT_BIGSTRING then
- failed := true;
-
- clear_globals;
- clear_values;
- value_largeset := func_largeset;
- if not ('I' in value_largeset) then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing orddef/enumdef function results (LOC_REGISTER)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
-
- value_u8bit := func_u8bit;
- if value_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_u16bit := func_u16bit;
- if value_u16bit <> RESULT_U16BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s32bit := func_s32bit;
- if value_s32bit <> RESULT_S32BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s64bit := func_s64bit;
- if value_s64bit <> RESULT_S64BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
-
- write('Testing floatdef function results...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- clear_globals;
- clear_values;
- value_s32real := func_s32real;
- if trunc(value_s32real) <> trunc(RESULT_S32REAL) then
- failed:=true;
-
- clear_globals;
- clear_values;
- value_s64real := func_s64real;
- if trunc(value_s64real) <> trunc(RESULT_S64REAL) then
- failed:=true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing ansistring function result...');
-
- clear_globals;
- clear_values;
- failed := false;
-
-
-value_ansistring := func_ansistring;
-if value_ansistring <> RESULT_BIGSTRING then
- failed:=true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing pointer function result (LOC_REGISTER)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_ptr := func_pchar;
- if value_ptr <> RESULT_PCHAR then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- {*********************************** TESTS W/PARAMS ***********************************}
- write('Testing function results with parameter (LOC_REFERENCE)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_smallarray := func_array_mixed(RESULT_U8BIT);
- if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_largerec := func_largerecord_mixed(RESULT_U8BIT);
- if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[BIG_INDEX] <> RESULT_U8BIT) then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_bigstring := func_shortstring_mixed(RESULT_U8BIT);
- if value_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_largeset := func_largeset_mixed(RESULT_U8BIT);
- if not ('I' in value_largeset) then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing orddef/enumdef function results with parameter (LOC_REGISTER)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
-
- value_u8bit := func_u8bit_mixed(RESULT_U8BIT);
- if value_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_u16bit := func_u16bit_mixed(RESULT_U8BIT);
- if value_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s32bit := func_s32bit_mixed(RESULT_U8BIT);
- if value_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s64bit := func_s64bit_mixed(RESULT_U8BIT);
- if value_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
-
- write('Testing floatdef function results with parameter...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_s32real := func_s32real_mixed(RESULT_U8BIT);
- if trunc(value_s32real) <> trunc(RESULT_S32REAL) then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s64real := func_s64real_mixed(RESULT_U8BIT);
- if trunc(value_s64real) <> trunc(RESULT_S64REAL) then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing ansistring function result with parameter...');
-
- clear_globals;
- clear_values;
- failed := false;
-
-
- value_ansistring := func_ansistring_mixed(RESULT_U8BIT);
- if value_ansistring <> RESULT_BIGSTRING then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing pointer function result with parameter (LOC_REGISTER)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_ptr := func_pchar_mixed(RESULT_U8BIT);
- if value_ptr <> RESULT_PCHAR then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- {******************************NESTED TESTS W/PARAMS **********************************}
- write('Testing function (w/nesting) results with parameter (LOC_REFERENCE)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_smallarray := func_array_mixed_nested(RESULT_U8BIT);
- if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_largerec := func_largerecord_mixed_nested(RESULT_U8BIT);
- if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[BIG_INDEX] <> RESULT_U8BIT) then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_bigstring := func_shortstring_mixed_nested(RESULT_U8BIT);
- if value_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_largeset := func_largeset_mixed_nested(RESULT_U8BIT);
- if not ('I' in value_largeset) then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing orddef/enumdef function (w/nesting) results with parameter (LOC_REGISTER)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
-
- value_u8bit := func_u8bit_mixed_nested(RESULT_U8BIT);
- if value_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_u16bit := func_u16bit_mixed_nested(RESULT_U8BIT);
- if value_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s32bit := func_s32bit_mixed_nested(RESULT_U8BIT);
- if value_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s64bit := func_s64bit_mixed_nested(RESULT_U8BIT);
- if value_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
-
- write('Testing floatdef function (w/nesting) results with parameter...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_s32real := func_s32real_mixed_nested(RESULT_U8BIT);
- if trunc(value_s32real) <> trunc(RESULT_S32REAL) then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s64real := func_s64real_mixed_nested(RESULT_U8BIT);
- if trunc(value_s64real) <> trunc(RESULT_S64REAL) then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing ansistring function (w/nesting) result with parameter...');
-
- clear_globals;
- clear_values;
- failed := false;
-
-
- value_ansistring := func_ansistring_mixed_nested(RESULT_U8BIT);
- if value_ansistring <> RESULT_BIGSTRING then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing pointer function (w/nesting) result with parameter (LOC_REGISTER)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_ptr := func_pchar_mixed_nested(RESULT_U8BIT);
- if value_ptr <> RESULT_PCHAR then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-end.
-
-{
+ {****************************************************************}
+ { CODE GENERATOR TEST PROGRAM }
+ { By Carl Eric Codere }
+ {****************************************************************}
+ { NODE TESTED : secondcallparan() }
+ {****************************************************************}
+ { PRE-REQUISITES: secondload() }
+ { secondassign() }
+ { secondtypeconv() }
+ { secondtryexcept() }
+ { secondcalln() }
+ { secondadd() }
+ {****************************************************************}
+ { DEFINES: }
+ { FPC = Target is FreePascal compiler }
+ {****************************************************************}
+ { REMARKS: This tests a subset of the secondcalln() node }
+ { (function return values with cdecl calling cnvs) }
+ { (also tests nested routines up to 2 level deep) }
+ {****************************************************************}
+ program tcalfun3;
+
+ {$ifdef fpc}
+ {$mode objfpc}
+ {$INLINE ON}
+ {$endif}
+ {$R+}
+ {$P-}
+
+{$ifdef VER70}
+ {$define tp}
+{$endif}
+
+
+ { REAL should map to single or double }
+ { so it is not checked, since single }
+ { double nodes are checked. }
+
+ { assumes that enumdef is the same as orddef (same storage format) }
+
+ const
+ { should be defined depending on CPU target }
+{$ifdef fpc}
+ {$ifdef cpu68k}
+ BIG_INDEX = 8000;
+ SMALL_INDEX = 13;
+ {$else}
+ BIG_INDEX = 33000;
+ SMALL_INDEX = 13; { value should not be aligned! }
+ {$endif}
+{$else}
+ BIG_INDEX = 33000;
+ SMALL_INDEX = 13; { value should not be aligned! }
+{$endif}
+ RESULT_U8BIT = $55;
+ RESULT_U16BIT = $500F;
+ RESULT_S32BIT = $500F0000;
+ RESULT_S64BIT = $500F0000;
+ RESULT_S32REAL = 1777.12;
+ RESULT_S64REAL = 3444.24;
+ RESULT_BOOL8BIT = 1;
+ RESULT_BOOL16BIT = 1;
+ RESULT_BOOL32BIT = 1;
+ RESULT_PCHAR = 'Hello world';
+ RESULT_BIGSTRING = 'Hello world';
+ RESULT_SMALLSTRING = 'H';
+ RESULT_CHAR = 'I';
+ RESULT_BOOLEAN = TRUE;
+
+ type
+ {$ifndef tp}
+ tclass1 = class
+ end;
+ {$else}
+ shortstring = string;
+ {$endif}
+
+ tprocedure = procedure;
+
+ tsmallrecord = packed record
+ b: byte;
+ w: word;
+ end;
+
+ tlargerecord = packed record
+ b: array[1..BIG_INDEX] of byte;
+ end;
+
+ tsmallarray = packed array[1..SMALL_INDEX] of byte;
+
+ tsmallsetenum =
+ (A_A,A_B,A_C,A_D);
+
+ tsmallset = set of tsmallsetenum;
+ tlargeset = set of char;
+
+ tsmallstring = string[2];
+
+
+
+
+
+ var
+ global_u8bit : byte;
+ global_u16bit : word;
+ global_s32bit : longint;
+ global_s32real : single;
+ global_s64real : double;
+ global_ptr : pchar;
+ global_proc : tprocedure;
+ global_bigstring : shortstring;
+ global_boolean : boolean;
+ global_char : char;
+ {$ifndef tp}
+ global_class : tclass1;
+ global_s64bit : int64;
+ value_s64bit : int64;
+ value_class : tclass1;
+ {$endif}
+ value_ansistring : ansistring;
+ value_u8bit : byte;
+ value_u16bit : word;
+ value_s32bit : longint;
+ value_s32real : single;
+ value_s64real : double;
+ value_proc : tprocedure;
+ value_ptr : pchar;
+ value_smallrec : tsmallrecord;
+ value_largerec : tlargerecord;
+ value_smallset : tsmallset;
+ value_smallstring : tsmallstring;
+ value_bigstring : shortstring;
+ value_largeset : tlargeset;
+ value_smallarray : tsmallarray;
+ value_boolean : boolean;
+ value_char : char;
+
+ procedure fail;
+ begin
+ WriteLn('Failure.');
+ halt(1);
+ end;
+
+
+ procedure clear_globals;
+ begin
+ global_u8bit := 0;
+ global_u16bit := 0;
+ global_s32bit := 0;
+ global_s32real := 0.0;
+ global_s64real := 0.0;
+ global_ptr := nil;
+ global_proc := nil;
+ global_bigstring := '';
+ global_boolean := false;
+ global_char := #0;
+ global_s64bit := 0;
+ global_class := nil;
+ end;
+
+
+ procedure clear_values;
+ begin
+ value_u8bit := 0;
+ value_u16bit := 0;
+ value_s32bit := 0;
+ value_s32real := 0.0;
+ value_s64real := 0.0;
+ value_proc := nil;
+ value_ptr := nil;
+ fillchar(value_smallrec, sizeof(value_smallrec), #0);
+ fillchar(value_largerec, sizeof(value_largerec), #0);
+ value_smallset := [];
+ value_smallstring := '';
+ value_bigstring := '';
+ value_largeset := [];
+ fillchar(value_smallarray, sizeof(value_smallarray), #0);
+ value_boolean := false;
+ value_char:=#0;
+ value_ansistring := '';
+ {$ifndef tp}
+ value_s64bit := 0;
+ value_class := nil;
+ {$endif}
+ end;
+
+
+
+ {********************************* FUNCTION RESULTS *************************}
+
+{ LOC_MEM return values }
+function func_array: tsmallarray;cdecl;
+ var
+ smallarray: tsmallarray;
+ begin
+ fillchar(smallarray, sizeof(smallarray), #0);
+ smallarray[1] := RESULT_U8BIT;
+ smallarray[SMALL_INDEX] := RESULT_U8BIT;
+ func_array := smallarray;
+ end;
+
+function func_largerecord: tlargerecord;cdecl;
+ var
+ largerecord : tlargerecord;
+ begin
+ fillchar(largerecord, sizeof(largerecord), #0);
+ largerecord.b[1] := RESULT_U8BIT;
+ largerecord.b[BIG_INDEX] := RESULT_U8BIT;
+ func_largerecord := largerecord;
+ end;
+
+function func_shortstring: shortstring;cdecl;
+ begin
+ func_shortstring := RESULT_BIGSTRING;
+ end;
+
+function func_largeset : tlargeset;cdecl;
+ var
+ largeset : tlargeset;
+ begin
+ largeset := ['I'];
+ func_largeset := largeset;
+ end;
+
+function func_u8bit : byte;cdecl;
+ begin
+ func_u8bit := RESULT_U8BIT;
+ end;
+
+function func_u16bit : word;cdecl;
+ begin
+ func_u16bit := RESULT_U16BIT;
+ end;
+
+function func_s32bit : longint;cdecl;
+ begin
+ func_s32bit := RESULT_S32BIT;
+ end;
+
+function func_s64bit : int64;cdecl;
+ begin
+ func_s64bit := RESULT_S64BIT;
+ end;
+
+function func_s32real : single;cdecl;
+ begin
+ func_s32real := RESULT_S32REAL;
+ end;
+
+function func_s64real : double;cdecl;
+ begin
+ func_s64real := RESULT_S64REAl;
+ end;
+
+function func_ansistring : ansistring;cdecl;
+ begin
+ func_ansistring := RESULT_BIGSTRING;
+ end;
+
+function func_pchar : pchar;cdecl;
+ begin
+ func_pchar := RESULT_PCHAR;
+ end;
+
+ {************************** FUNCTION RESULT WITH PARAMS ******************}
+{ LOC_MEM return values }
+function func_array_mixed(b: byte): tsmallarray;cdecl;
+ var
+ local_b: byte;
+ smallarray: tsmallarray;
+ begin
+ fillchar(smallarray, sizeof(smallarray), #0);
+ smallarray[1] := RESULT_U8BIT;
+ smallarray[SMALL_INDEX] := RESULT_U8BIT;
+ func_array_mixed := smallarray;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_largerecord_mixed(b: byte): tlargerecord;cdecl;
+ var
+ local_b: byte;
+ largerecord : tlargerecord;
+ begin
+ fillchar(largerecord, sizeof(largerecord), #0);
+ largerecord.b[1] := RESULT_U8BIT;
+ largerecord.b[BIG_INDEX] := RESULT_U8BIT;
+ func_largerecord_mixed := largerecord;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_shortstring_mixed(b: byte): shortstring;cdecl;
+ var
+ local_b: byte;
+ begin
+ func_shortstring_mixed := RESULT_BIGSTRING;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_largeset_mixed(b: byte) : tlargeset;cdecl;
+ var
+ local_b: byte;
+ largeset : tlargeset;
+ begin
+ largeset := ['I'];
+ func_largeset_mixed := largeset;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_u8bit_mixed(b: byte) : byte;cdecl;
+ var
+ local_b: byte;
+ begin
+ func_u8bit_mixed := RESULT_U8BIT;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_u16bit_mixed(b: byte) : word;cdecl;
+ var
+ local_b: byte;
+ begin
+ func_u16bit_mixed := RESULT_U16BIT;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_s32bit_mixed(b: byte) : longint;cdecl;
+ var
+ local_b: byte;
+ begin
+ func_s32bit_mixed := RESULT_S32BIT;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_s64bit_mixed(b: byte) : int64;cdecl;
+ var
+ local_b: byte;
+ begin
+ func_s64bit_mixed := RESULT_S64BIT;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_s32real_mixed(b: byte) : single;cdecl;
+ var
+ local_b: byte;
+ begin
+ func_s32real_mixed := RESULT_S32REAL;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_s64real_mixed(b: byte) : double;cdecl;
+ var
+ local_b: byte;
+ begin
+ func_s64real_mixed := RESULT_S64REAl;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_ansistring_mixed(b: byte) : ansistring;cdecl;
+ var
+ local_b: byte;
+ begin
+ func_ansistring_mixed := RESULT_BIGSTRING;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_pchar_mixed(b: byte) : pchar;cdecl;
+ var
+ local_b: byte;
+ begin
+ func_pchar_mixed := RESULT_PCHAR;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+ {********************* FUNCTION RESULT WITH PARAMS (NESTED) ******************}
+{ LOC_MEM return values }
+function func_array_mixed_nested(b: byte): tsmallarray;cdecl;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ smallarray: tsmallarray;
+ begin
+ fillchar(smallarray, sizeof(smallarray), #0);
+ smallarray[1] := RESULT_U8BIT;
+ smallarray[SMALL_INDEX] := RESULT_U8BIT;
+ func_array_mixed_nested := smallarray;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+{ nested_one_proc(RESULT_S32BIT);}
+ end;
+
+function func_largerecord_mixed_nested(b: byte): tlargerecord;cdecl;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ largerecord : tlargerecord;
+ begin
+ fillchar(largerecord, sizeof(largerecord), #0);
+ largerecord.b[1] := RESULT_U8BIT;
+ largerecord.b[BIG_INDEX] := RESULT_U8BIT;
+ func_largerecord_mixed_nested := largerecord;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_shortstring_mixed_nested(b: byte): shortstring;cdecl;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+ var
+ local_b: byte;
+ begin
+ func_shortstring_mixed_nested := RESULT_BIGSTRING;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_largeset_mixed_nested(b: byte) : tlargeset;cdecl;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ largeset : tlargeset;
+ begin
+ largeset := ['I'];
+ func_largeset_mixed_nested := largeset;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_u8bit_mixed_nested(b: byte) : byte;cdecl;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_u8bit_mixed_nested := RESULT_U8BIT;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_u16bit_mixed_nested(b: byte) : word;cdecl;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_u16bit_mixed_nested := RESULT_U16BIT;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_s32bit_mixed_nested(b: byte) : longint;cdecl;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_s32bit_mixed_nested := RESULT_S32BIT;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_s64bit_mixed_nested(b: byte) : int64;cdecl;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_s64bit_mixed_nested := RESULT_S64BIT;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_s32real_mixed_nested(b: byte) : single;cdecl;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_s32real_mixed_nested := RESULT_S32REAL;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_s64real_mixed_nested(b: byte) : double;cdecl;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_s64real_mixed_nested := RESULT_S64REAl;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_ansistring_mixed_nested(b: byte) : ansistring;cdecl;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_ansistring_mixed_nested := RESULT_BIGSTRING;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_pchar_mixed_nested(b: byte) : pchar;cdecl;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_pchar_mixed_nested := RESULT_PCHAR;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+
+var
+ failed: boolean;
+Begin
+ {************************************* SIMPLE TESTS ***********************************}
+ write('Testing function results (LOC_REFERENCE)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_smallarray := func_array;
+ if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_largerec := func_largerecord;
+ if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[BIG_INDEX] <> RESULT_U8BIT) then
+ failed:=true;
+
+ clear_globals;
+ clear_values;
+ value_bigstring := func_shortstring;
+ if value_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_largeset := func_largeset;
+ if not ('I' in value_largeset) then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing orddef/enumdef function results (LOC_REGISTER)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+
+ value_u8bit := func_u8bit;
+ if value_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_u16bit := func_u16bit;
+ if value_u16bit <> RESULT_U16BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s32bit := func_s32bit;
+ if value_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s64bit := func_s64bit;
+ if value_s64bit <> RESULT_S64BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+
+ write('Testing floatdef function results...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ clear_globals;
+ clear_values;
+ value_s32real := func_s32real;
+ if trunc(value_s32real) <> trunc(RESULT_S32REAL) then
+ failed:=true;
+
+ clear_globals;
+ clear_values;
+ value_s64real := func_s64real;
+ if trunc(value_s64real) <> trunc(RESULT_S64REAL) then
+ failed:=true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing ansistring function result...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+
+value_ansistring := func_ansistring;
+if value_ansistring <> RESULT_BIGSTRING then
+ failed:=true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing pointer function result (LOC_REGISTER)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_ptr := func_pchar;
+ if value_ptr <> RESULT_PCHAR then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ {*********************************** TESTS W/PARAMS ***********************************}
+ write('Testing function results with parameter (LOC_REFERENCE)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_smallarray := func_array_mixed(RESULT_U8BIT);
+ if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_largerec := func_largerecord_mixed(RESULT_U8BIT);
+ if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[BIG_INDEX] <> RESULT_U8BIT) then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_bigstring := func_shortstring_mixed(RESULT_U8BIT);
+ if value_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_largeset := func_largeset_mixed(RESULT_U8BIT);
+ if not ('I' in value_largeset) then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing orddef/enumdef function results with parameter (LOC_REGISTER)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+
+ value_u8bit := func_u8bit_mixed(RESULT_U8BIT);
+ if value_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_u16bit := func_u16bit_mixed(RESULT_U8BIT);
+ if value_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s32bit := func_s32bit_mixed(RESULT_U8BIT);
+ if value_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s64bit := func_s64bit_mixed(RESULT_U8BIT);
+ if value_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+
+ write('Testing floatdef function results with parameter...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_s32real := func_s32real_mixed(RESULT_U8BIT);
+ if trunc(value_s32real) <> trunc(RESULT_S32REAL) then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s64real := func_s64real_mixed(RESULT_U8BIT);
+ if trunc(value_s64real) <> trunc(RESULT_S64REAL) then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing ansistring function result with parameter...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+
+ value_ansistring := func_ansistring_mixed(RESULT_U8BIT);
+ if value_ansistring <> RESULT_BIGSTRING then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing pointer function result with parameter (LOC_REGISTER)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_ptr := func_pchar_mixed(RESULT_U8BIT);
+ if value_ptr <> RESULT_PCHAR then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ {******************************NESTED TESTS W/PARAMS **********************************}
+ write('Testing function (w/nesting) results with parameter (LOC_REFERENCE)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_smallarray := func_array_mixed_nested(RESULT_U8BIT);
+ if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_largerec := func_largerecord_mixed_nested(RESULT_U8BIT);
+ if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[BIG_INDEX] <> RESULT_U8BIT) then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_bigstring := func_shortstring_mixed_nested(RESULT_U8BIT);
+ if value_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_largeset := func_largeset_mixed_nested(RESULT_U8BIT);
+ if not ('I' in value_largeset) then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing orddef/enumdef function (w/nesting) results with parameter (LOC_REGISTER)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+
+ value_u8bit := func_u8bit_mixed_nested(RESULT_U8BIT);
+ if value_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_u16bit := func_u16bit_mixed_nested(RESULT_U8BIT);
+ if value_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s32bit := func_s32bit_mixed_nested(RESULT_U8BIT);
+ if value_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s64bit := func_s64bit_mixed_nested(RESULT_U8BIT);
+ if value_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+
+ write('Testing floatdef function (w/nesting) results with parameter...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_s32real := func_s32real_mixed_nested(RESULT_U8BIT);
+ if trunc(value_s32real) <> trunc(RESULT_S32REAL) then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s64real := func_s64real_mixed_nested(RESULT_U8BIT);
+ if trunc(value_s64real) <> trunc(RESULT_S64REAL) then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing ansistring function (w/nesting) result with parameter...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+
+ value_ansistring := func_ansistring_mixed_nested(RESULT_U8BIT);
+ if value_ansistring <> RESULT_BIGSTRING then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing pointer function (w/nesting) result with parameter (LOC_REGISTER)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_ptr := func_pchar_mixed_nested(RESULT_U8BIT);
+ if value_ptr <> RESULT_PCHAR then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+end.
+
+{
$Log$
- Revision 1.4 2003-04-22 10:24:29 florian
+ Revision 1.5 2004-05-02 12:11:44 peter
+ * fixed linefeeds
+
+ Revision 1.4 2003/04/22 10:24:29 florian
* fixed defines for powerpc
-
- Revision 1.3 2002/09/07 15:40:51 peter
- * old logs removed and tabs fixed
-
- Revision 1.2 2002/05/13 13:45:36 peter
- * updated to compile tests with kylix
-
- Revision 1.1 2002/04/13 07:45:49 carl
- + Function calling tests , for different calling conventions.
-
-}
+
+ Revision 1.3 2002/09/07 15:40:51 peter
+ * old logs removed and tabs fixed
+
+ Revision 1.2 2002/05/13 13:45:36 peter
+ * updated to compile tests with kylix
+
+ Revision 1.1 2002/04/13 07:45:49 carl
+ + Function calling tests , for different calling conventions.
+
+}
diff --git a/tests/test/cg/tcalfun5.pp b/tests/test/cg/tcalfun5.pp
index 842d982e4b..2739fc3897 100644
--- a/tests/test/cg/tcalfun5.pp
+++ b/tests/test/cg/tcalfun5.pp
@@ -1,1417 +1,1420 @@
- {****************************************************************}
- { CODE GENERATOR TEST PROGRAM }
- { By Carl Eric Codere }
- {****************************************************************}
- { NODE TESTED : secondcallparan() }
- {****************************************************************}
- { PRE-REQUISITES: secondload() }
- { secondassign() }
- { secondtypeconv() }
- { secondtryexcept() }
- { secondcalln() }
- { secondadd() }
- {****************************************************************}
- { DEFINES: }
- { FPC = Target is FreePascal compiler }
- {****************************************************************}
- { REMARKS: This tests a subset of the secondcalln() node }
- { (function return values with safecall calling cnvs) }
- { (also tests nested routines up to 2 level deep) }
- {****************************************************************}
- program tcalfun5;
-
- {$ifdef fpc}
- {$mode objfpc}
- {$INLINE ON}
- {$endif}
- {$R+}
- {$P-}
-
-{$ifdef VER70}
- {$define tp}
-{$endif}
-
-
- { REAL should map to single or double }
- { so it is not checked, since single }
- { double nodes are checked. }
-
- { assumes that enumdef is the same as orddef (same storage format) }
-
- const
- { should be defined depending on CPU target }
-{$ifdef fpc}
- {$ifdef cpu68k}
- BIG_INDEX = 8000;
- SMALL_INDEX = 13;
- {$else}
- BIG_INDEX = 33000;
- SMALL_INDEX = 13; { value should not be aligned! }
- {$endif}
-{$else}
- BIG_INDEX = 33000;
- SMALL_INDEX = 13; { value should not be aligned! }
-{$endif}
- RESULT_U8BIT = $55;
- RESULT_U16BIT = $500F;
- RESULT_S32BIT = $500F0000;
- RESULT_S64BIT = $500F0000;
- RESULT_S32REAL = 1777.12;
- RESULT_S64REAL = 3444.24;
- RESULT_BOOL8BIT = 1;
- RESULT_BOOL16BIT = 1;
- RESULT_BOOL32BIT = 1;
- RESULT_PCHAR = 'Hello world';
- RESULT_BIGSTRING = 'Hello world';
- RESULT_SMALLSTRING = 'H';
- RESULT_CHAR = 'I';
- RESULT_BOOLEAN = TRUE;
-
- type
- {$ifndef tp}
- tclass1 = class
- end;
- {$else}
- shortstring = string;
- {$endif}
-
- tprocedure = procedure;
-
- tsmallrecord = packed record
- b: byte;
- w: word;
- end;
-
- tlargerecord = packed record
- b: array[1..BIG_INDEX] of byte;
- end;
-
- tsmallarray = packed array[1..SMALL_INDEX] of byte;
-
- tsmallsetenum =
- (A_A,A_B,A_C,A_D);
-
- tsmallset = set of tsmallsetenum;
- tlargeset = set of char;
-
- tsmallstring = string[2];
-
-
-
-
-
- var
- global_u8bit : byte;
- global_u16bit : word;
- global_s32bit : longint;
- global_s32real : single;
- global_s64real : double;
- global_ptr : pchar;
- global_proc : tprocedure;
- global_bigstring : shortstring;
- global_boolean : boolean;
- global_char : char;
- {$ifndef tp}
- global_class : tclass1;
- global_s64bit : int64;
- value_s64bit : int64;
- value_class : tclass1;
- {$endif}
- value_ansistring : ansistring;
- value_u8bit : byte;
- value_u16bit : word;
- value_s32bit : longint;
- value_s32real : single;
- value_s64real : double;
- value_proc : tprocedure;
- value_ptr : pchar;
- value_smallrec : tsmallrecord;
- value_largerec : tlargerecord;
- value_smallset : tsmallset;
- value_smallstring : tsmallstring;
- value_bigstring : shortstring;
- value_largeset : tlargeset;
- value_smallarray : tsmallarray;
- value_boolean : boolean;
- value_char : char;
-
- procedure fail;
- begin
- WriteLn('Failure.');
- halt(1);
- end;
-
-
- procedure clear_globals;
- begin
- global_u8bit := 0;
- global_u16bit := 0;
- global_s32bit := 0;
- global_s32real := 0.0;
- global_s64real := 0.0;
- global_ptr := nil;
- global_proc := nil;
- global_bigstring := '';
- global_boolean := false;
- global_char := #0;
- global_s64bit := 0;
- global_class := nil;
- end;
-
-
- procedure clear_values;
- begin
- value_u8bit := 0;
- value_u16bit := 0;
- value_s32bit := 0;
- value_s32real := 0.0;
- value_s64real := 0.0;
- value_proc := nil;
- value_ptr := nil;
- fillchar(value_smallrec, sizeof(value_smallrec), #0);
- fillchar(value_largerec, sizeof(value_largerec), #0);
- value_smallset := [];
- value_smallstring := '';
- value_bigstring := '';
- value_largeset := [];
- fillchar(value_smallarray, sizeof(value_smallarray), #0);
- value_boolean := false;
- value_char:=#0;
- value_ansistring := '';
- {$ifndef tp}
- value_s64bit := 0;
- value_class := nil;
- {$endif}
- end;
-
-
-
- {********************************* FUNCTION RESULTS *************************}
-
-{ LOC_MEM return values }
-function func_array: tsmallarray;safecall;
- var
- smallarray: tsmallarray;
- begin
- fillchar(smallarray, sizeof(smallarray), #0);
- smallarray[1] := RESULT_U8BIT;
- smallarray[SMALL_INDEX] := RESULT_U8BIT;
- func_array := smallarray;
- end;
-
-function func_largerecord: tlargerecord;safecall;
- var
- largerecord : tlargerecord;
- begin
- fillchar(largerecord, sizeof(largerecord), #0);
- largerecord.b[1] := RESULT_U8BIT;
- largerecord.b[BIG_INDEX] := RESULT_U8BIT;
- func_largerecord := largerecord;
- end;
-
-function func_shortstring: shortstring;safecall;
- begin
- func_shortstring := RESULT_BIGSTRING;
- end;
-
-function func_largeset : tlargeset;safecall;
- var
- largeset : tlargeset;
- begin
- largeset := ['I'];
- func_largeset := largeset;
- end;
-
-function func_u8bit : byte;safecall;
- begin
- func_u8bit := RESULT_U8BIT;
- end;
-
-function func_u16bit : word;safecall;
- begin
- func_u16bit := RESULT_U16BIT;
- end;
-
-function func_s32bit : longint;safecall;
- begin
- func_s32bit := RESULT_S32BIT;
- end;
-
-function func_s64bit : int64;safecall;
- begin
- func_s64bit := RESULT_S64BIT;
- end;
-
-function func_s32real : single;safecall;
- begin
- func_s32real := RESULT_S32REAL;
- end;
-
-function func_s64real : double;safecall;
- begin
- func_s64real := RESULT_S64REAl;
- end;
-
-function func_ansistring : ansistring;safecall;
- begin
- func_ansistring := RESULT_BIGSTRING;
- end;
-
-function func_pchar : pchar;safecall;
- begin
- func_pchar := RESULT_PCHAR;
- end;
-
- {************************** FUNCTION RESULT WITH PARAMS ******************}
-{ LOC_MEM return values }
-function func_array_mixed(b: byte): tsmallarray;safecall;
- var
- local_b: byte;
- smallarray: tsmallarray;
- begin
- fillchar(smallarray, sizeof(smallarray), #0);
- smallarray[1] := RESULT_U8BIT;
- smallarray[SMALL_INDEX] := RESULT_U8BIT;
- func_array_mixed := smallarray;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_largerecord_mixed(b: byte): tlargerecord;safecall;
- var
- local_b: byte;
- largerecord : tlargerecord;
- begin
- fillchar(largerecord, sizeof(largerecord), #0);
- largerecord.b[1] := RESULT_U8BIT;
- largerecord.b[BIG_INDEX] := RESULT_U8BIT;
- func_largerecord_mixed := largerecord;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_shortstring_mixed(b: byte): shortstring;safecall;
- var
- local_b: byte;
- begin
- func_shortstring_mixed := RESULT_BIGSTRING;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_largeset_mixed(b: byte) : tlargeset;safecall;
- var
- local_b: byte;
- largeset : tlargeset;
- begin
- largeset := ['I'];
- func_largeset_mixed := largeset;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_u8bit_mixed(b: byte) : byte;safecall;
- var
- local_b: byte;
- begin
- func_u8bit_mixed := RESULT_U8BIT;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_u16bit_mixed(b: byte) : word;safecall;
- var
- local_b: byte;
- begin
- func_u16bit_mixed := RESULT_U16BIT;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_s32bit_mixed(b: byte) : longint;safecall;
- var
- local_b: byte;
- begin
- func_s32bit_mixed := RESULT_S32BIT;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_s64bit_mixed(b: byte) : int64;safecall;
- var
- local_b: byte;
- begin
- func_s64bit_mixed := RESULT_S64BIT;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_s32real_mixed(b: byte) : single;safecall;
- var
- local_b: byte;
- begin
- func_s32real_mixed := RESULT_S32REAL;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_s64real_mixed(b: byte) : double;safecall;
- var
- local_b: byte;
- begin
- func_s64real_mixed := RESULT_S64REAl;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_ansistring_mixed(b: byte) : ansistring;safecall;
- var
- local_b: byte;
- begin
- func_ansistring_mixed := RESULT_BIGSTRING;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_pchar_mixed(b: byte) : pchar;safecall;
- var
- local_b: byte;
- begin
- func_pchar_mixed := RESULT_PCHAR;
- local_b:=b;
- global_u8bit := b;
- end;
-
- {********************* FUNCTION RESULT WITH PARAMS (NESTED) ******************}
-{ LOC_MEM return values }
-function func_array_mixed_nested(b: byte): tsmallarray;safecall;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- smallarray: tsmallarray;
- begin
- fillchar(smallarray, sizeof(smallarray), #0);
- smallarray[1] := RESULT_U8BIT;
- smallarray[SMALL_INDEX] := RESULT_U8BIT;
- func_array_mixed_nested := smallarray;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
-{ nested_one_proc(RESULT_S32BIT);}
- end;
-
-function func_largerecord_mixed_nested(b: byte): tlargerecord;safecall;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- largerecord : tlargerecord;
- begin
- fillchar(largerecord, sizeof(largerecord), #0);
- largerecord.b[1] := RESULT_U8BIT;
- largerecord.b[BIG_INDEX] := RESULT_U8BIT;
- func_largerecord_mixed_nested := largerecord;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_shortstring_mixed_nested(b: byte): shortstring;safecall;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
- var
- local_b: byte;
- begin
- func_shortstring_mixed_nested := RESULT_BIGSTRING;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_largeset_mixed_nested(b: byte) : tlargeset;safecall;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- largeset : tlargeset;
- begin
- largeset := ['I'];
- func_largeset_mixed_nested := largeset;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_u8bit_mixed_nested(b: byte) : byte;safecall;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_u8bit_mixed_nested := RESULT_U8BIT;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_u16bit_mixed_nested(b: byte) : word;safecall;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_u16bit_mixed_nested := RESULT_U16BIT;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_s32bit_mixed_nested(b: byte) : longint;safecall;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_s32bit_mixed_nested := RESULT_S32BIT;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_s64bit_mixed_nested(b: byte) : int64;safecall;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_s64bit_mixed_nested := RESULT_S64BIT;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_s32real_mixed_nested(b: byte) : single;safecall;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_s32real_mixed_nested := RESULT_S32REAL;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_s64real_mixed_nested(b: byte) : double;safecall;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_s64real_mixed_nested := RESULT_S64REAl;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_ansistring_mixed_nested(b: byte) : ansistring;safecall;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_ansistring_mixed_nested := RESULT_BIGSTRING;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_pchar_mixed_nested(b: byte) : pchar;safecall;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_pchar_mixed_nested := RESULT_PCHAR;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-
-var
- failed: boolean;
-Begin
- {************************************* SIMPLE TESTS ***********************************}
- write('Testing function results (LOC_REFERENCE)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_smallarray := func_array;
- if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
- failed := true;
-
- clear_globals;
- clear_values;
- value_largerec := func_largerecord;
- if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[BIG_INDEX] <> RESULT_U8BIT) then
- failed:=true;
-
- clear_globals;
- clear_values;
- value_bigstring := func_shortstring;
- if value_bigstring <> RESULT_BIGSTRING then
- failed := true;
-
- clear_globals;
- clear_values;
- value_largeset := func_largeset;
- if not ('I' in value_largeset) then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing orddef/enumdef function results (LOC_REGISTER)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
-
- value_u8bit := func_u8bit;
- if value_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_u16bit := func_u16bit;
- if value_u16bit <> RESULT_U16BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s32bit := func_s32bit;
- if value_s32bit <> RESULT_S32BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s64bit := func_s64bit;
- if value_s64bit <> RESULT_S64BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
-
- write('Testing floatdef function results...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- clear_globals;
- clear_values;
- value_s32real := func_s32real;
- if trunc(value_s32real) <> trunc(RESULT_S32REAL) then
- failed:=true;
-
- clear_globals;
- clear_values;
- value_s64real := func_s64real;
- if trunc(value_s64real) <> trunc(RESULT_S64REAL) then
- failed:=true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing ansistring function result...');
-
- clear_globals;
- clear_values;
- failed := false;
-
-
-value_ansistring := func_ansistring;
-if value_ansistring <> RESULT_BIGSTRING then
- failed:=true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing pointer function result (LOC_REGISTER)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_ptr := func_pchar;
- if value_ptr <> RESULT_PCHAR then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- {*********************************** TESTS W/PARAMS ***********************************}
- write('Testing function results with parameter (LOC_REFERENCE)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_smallarray := func_array_mixed(RESULT_U8BIT);
- if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_largerec := func_largerecord_mixed(RESULT_U8BIT);
- if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[BIG_INDEX] <> RESULT_U8BIT) then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_bigstring := func_shortstring_mixed(RESULT_U8BIT);
- if value_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_largeset := func_largeset_mixed(RESULT_U8BIT);
- if not ('I' in value_largeset) then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing orddef/enumdef function results with parameter (LOC_REGISTER)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
-
- value_u8bit := func_u8bit_mixed(RESULT_U8BIT);
- if value_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_u16bit := func_u16bit_mixed(RESULT_U8BIT);
- if value_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s32bit := func_s32bit_mixed(RESULT_U8BIT);
- if value_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s64bit := func_s64bit_mixed(RESULT_U8BIT);
- if value_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
-
- write('Testing floatdef function results with parameter...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_s32real := func_s32real_mixed(RESULT_U8BIT);
- if trunc(value_s32real) <> trunc(RESULT_S32REAL) then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s64real := func_s64real_mixed(RESULT_U8BIT);
- if trunc(value_s64real) <> trunc(RESULT_S64REAL) then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing ansistring function result with parameter...');
-
- clear_globals;
- clear_values;
- failed := false;
-
-
- value_ansistring := func_ansistring_mixed(RESULT_U8BIT);
- if value_ansistring <> RESULT_BIGSTRING then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing pointer function result with parameter (LOC_REGISTER)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_ptr := func_pchar_mixed(RESULT_U8BIT);
- if value_ptr <> RESULT_PCHAR then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- {******************************NESTED TESTS W/PARAMS **********************************}
- write('Testing function (w/nesting) results with parameter (LOC_REFERENCE)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_smallarray := func_array_mixed_nested(RESULT_U8BIT);
- if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_largerec := func_largerecord_mixed_nested(RESULT_U8BIT);
- if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[BIG_INDEX] <> RESULT_U8BIT) then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_bigstring := func_shortstring_mixed_nested(RESULT_U8BIT);
- if value_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_largeset := func_largeset_mixed_nested(RESULT_U8BIT);
- if not ('I' in value_largeset) then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing orddef/enumdef function (w/nesting) results with parameter (LOC_REGISTER)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
-
- value_u8bit := func_u8bit_mixed_nested(RESULT_U8BIT);
- if value_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_u16bit := func_u16bit_mixed_nested(RESULT_U8BIT);
- if value_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s32bit := func_s32bit_mixed_nested(RESULT_U8BIT);
- if value_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s64bit := func_s64bit_mixed_nested(RESULT_U8BIT);
- if value_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
-
- write('Testing floatdef function (w/nesting) results with parameter...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_s32real := func_s32real_mixed_nested(RESULT_U8BIT);
- if trunc(value_s32real) <> trunc(RESULT_S32REAL) then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s64real := func_s64real_mixed_nested(RESULT_U8BIT);
- if trunc(value_s64real) <> trunc(RESULT_S64REAL) then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing ansistring function (w/nesting) result with parameter...');
-
- clear_globals;
- clear_values;
- failed := false;
-
-
- value_ansistring := func_ansistring_mixed_nested(RESULT_U8BIT);
- if value_ansistring <> RESULT_BIGSTRING then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing pointer function (w/nesting) result with parameter (LOC_REGISTER)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_ptr := func_pchar_mixed_nested(RESULT_U8BIT);
- if value_ptr <> RESULT_PCHAR then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-end.
-
-{
+ {****************************************************************}
+ { CODE GENERATOR TEST PROGRAM }
+ { By Carl Eric Codere }
+ {****************************************************************}
+ { NODE TESTED : secondcallparan() }
+ {****************************************************************}
+ { PRE-REQUISITES: secondload() }
+ { secondassign() }
+ { secondtypeconv() }
+ { secondtryexcept() }
+ { secondcalln() }
+ { secondadd() }
+ {****************************************************************}
+ { DEFINES: }
+ { FPC = Target is FreePascal compiler }
+ {****************************************************************}
+ { REMARKS: This tests a subset of the secondcalln() node }
+ { (function return values with safecall calling cnvs) }
+ { (also tests nested routines up to 2 level deep) }
+ {****************************************************************}
+ program tcalfun5;
+
+ {$ifdef fpc}
+ {$mode objfpc}
+ {$INLINE ON}
+ {$endif}
+ {$R+}
+ {$P-}
+
+{$ifdef VER70}
+ {$define tp}
+{$endif}
+
+
+ { REAL should map to single or double }
+ { so it is not checked, since single }
+ { double nodes are checked. }
+
+ { assumes that enumdef is the same as orddef (same storage format) }
+
+ const
+ { should be defined depending on CPU target }
+{$ifdef fpc}
+ {$ifdef cpu68k}
+ BIG_INDEX = 8000;
+ SMALL_INDEX = 13;
+ {$else}
+ BIG_INDEX = 33000;
+ SMALL_INDEX = 13; { value should not be aligned! }
+ {$endif}
+{$else}
+ BIG_INDEX = 33000;
+ SMALL_INDEX = 13; { value should not be aligned! }
+{$endif}
+ RESULT_U8BIT = $55;
+ RESULT_U16BIT = $500F;
+ RESULT_S32BIT = $500F0000;
+ RESULT_S64BIT = $500F0000;
+ RESULT_S32REAL = 1777.12;
+ RESULT_S64REAL = 3444.24;
+ RESULT_BOOL8BIT = 1;
+ RESULT_BOOL16BIT = 1;
+ RESULT_BOOL32BIT = 1;
+ RESULT_PCHAR = 'Hello world';
+ RESULT_BIGSTRING = 'Hello world';
+ RESULT_SMALLSTRING = 'H';
+ RESULT_CHAR = 'I';
+ RESULT_BOOLEAN = TRUE;
+
+ type
+ {$ifndef tp}
+ tclass1 = class
+ end;
+ {$else}
+ shortstring = string;
+ {$endif}
+
+ tprocedure = procedure;
+
+ tsmallrecord = packed record
+ b: byte;
+ w: word;
+ end;
+
+ tlargerecord = packed record
+ b: array[1..BIG_INDEX] of byte;
+ end;
+
+ tsmallarray = packed array[1..SMALL_INDEX] of byte;
+
+ tsmallsetenum =
+ (A_A,A_B,A_C,A_D);
+
+ tsmallset = set of tsmallsetenum;
+ tlargeset = set of char;
+
+ tsmallstring = string[2];
+
+
+
+
+
+ var
+ global_u8bit : byte;
+ global_u16bit : word;
+ global_s32bit : longint;
+ global_s32real : single;
+ global_s64real : double;
+ global_ptr : pchar;
+ global_proc : tprocedure;
+ global_bigstring : shortstring;
+ global_boolean : boolean;
+ global_char : char;
+ {$ifndef tp}
+ global_class : tclass1;
+ global_s64bit : int64;
+ value_s64bit : int64;
+ value_class : tclass1;
+ {$endif}
+ value_ansistring : ansistring;
+ value_u8bit : byte;
+ value_u16bit : word;
+ value_s32bit : longint;
+ value_s32real : single;
+ value_s64real : double;
+ value_proc : tprocedure;
+ value_ptr : pchar;
+ value_smallrec : tsmallrecord;
+ value_largerec : tlargerecord;
+ value_smallset : tsmallset;
+ value_smallstring : tsmallstring;
+ value_bigstring : shortstring;
+ value_largeset : tlargeset;
+ value_smallarray : tsmallarray;
+ value_boolean : boolean;
+ value_char : char;
+
+ procedure fail;
+ begin
+ WriteLn('Failure.');
+ halt(1);
+ end;
+
+
+ procedure clear_globals;
+ begin
+ global_u8bit := 0;
+ global_u16bit := 0;
+ global_s32bit := 0;
+ global_s32real := 0.0;
+ global_s64real := 0.0;
+ global_ptr := nil;
+ global_proc := nil;
+ global_bigstring := '';
+ global_boolean := false;
+ global_char := #0;
+ global_s64bit := 0;
+ global_class := nil;
+ end;
+
+
+ procedure clear_values;
+ begin
+ value_u8bit := 0;
+ value_u16bit := 0;
+ value_s32bit := 0;
+ value_s32real := 0.0;
+ value_s64real := 0.0;
+ value_proc := nil;
+ value_ptr := nil;
+ fillchar(value_smallrec, sizeof(value_smallrec), #0);
+ fillchar(value_largerec, sizeof(value_largerec), #0);
+ value_smallset := [];
+ value_smallstring := '';
+ value_bigstring := '';
+ value_largeset := [];
+ fillchar(value_smallarray, sizeof(value_smallarray), #0);
+ value_boolean := false;
+ value_char:=#0;
+ value_ansistring := '';
+ {$ifndef tp}
+ value_s64bit := 0;
+ value_class := nil;
+ {$endif}
+ end;
+
+
+
+ {********************************* FUNCTION RESULTS *************************}
+
+{ LOC_MEM return values }
+function func_array: tsmallarray;safecall;
+ var
+ smallarray: tsmallarray;
+ begin
+ fillchar(smallarray, sizeof(smallarray), #0);
+ smallarray[1] := RESULT_U8BIT;
+ smallarray[SMALL_INDEX] := RESULT_U8BIT;
+ func_array := smallarray;
+ end;
+
+function func_largerecord: tlargerecord;safecall;
+ var
+ largerecord : tlargerecord;
+ begin
+ fillchar(largerecord, sizeof(largerecord), #0);
+ largerecord.b[1] := RESULT_U8BIT;
+ largerecord.b[BIG_INDEX] := RESULT_U8BIT;
+ func_largerecord := largerecord;
+ end;
+
+function func_shortstring: shortstring;safecall;
+ begin
+ func_shortstring := RESULT_BIGSTRING;
+ end;
+
+function func_largeset : tlargeset;safecall;
+ var
+ largeset : tlargeset;
+ begin
+ largeset := ['I'];
+ func_largeset := largeset;
+ end;
+
+function func_u8bit : byte;safecall;
+ begin
+ func_u8bit := RESULT_U8BIT;
+ end;
+
+function func_u16bit : word;safecall;
+ begin
+ func_u16bit := RESULT_U16BIT;
+ end;
+
+function func_s32bit : longint;safecall;
+ begin
+ func_s32bit := RESULT_S32BIT;
+ end;
+
+function func_s64bit : int64;safecall;
+ begin
+ func_s64bit := RESULT_S64BIT;
+ end;
+
+function func_s32real : single;safecall;
+ begin
+ func_s32real := RESULT_S32REAL;
+ end;
+
+function func_s64real : double;safecall;
+ begin
+ func_s64real := RESULT_S64REAl;
+ end;
+
+function func_ansistring : ansistring;safecall;
+ begin
+ func_ansistring := RESULT_BIGSTRING;
+ end;
+
+function func_pchar : pchar;safecall;
+ begin
+ func_pchar := RESULT_PCHAR;
+ end;
+
+ {************************** FUNCTION RESULT WITH PARAMS ******************}
+{ LOC_MEM return values }
+function func_array_mixed(b: byte): tsmallarray;safecall;
+ var
+ local_b: byte;
+ smallarray: tsmallarray;
+ begin
+ fillchar(smallarray, sizeof(smallarray), #0);
+ smallarray[1] := RESULT_U8BIT;
+ smallarray[SMALL_INDEX] := RESULT_U8BIT;
+ func_array_mixed := smallarray;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_largerecord_mixed(b: byte): tlargerecord;safecall;
+ var
+ local_b: byte;
+ largerecord : tlargerecord;
+ begin
+ fillchar(largerecord, sizeof(largerecord), #0);
+ largerecord.b[1] := RESULT_U8BIT;
+ largerecord.b[BIG_INDEX] := RESULT_U8BIT;
+ func_largerecord_mixed := largerecord;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_shortstring_mixed(b: byte): shortstring;safecall;
+ var
+ local_b: byte;
+ begin
+ func_shortstring_mixed := RESULT_BIGSTRING;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_largeset_mixed(b: byte) : tlargeset;safecall;
+ var
+ local_b: byte;
+ largeset : tlargeset;
+ begin
+ largeset := ['I'];
+ func_largeset_mixed := largeset;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_u8bit_mixed(b: byte) : byte;safecall;
+ var
+ local_b: byte;
+ begin
+ func_u8bit_mixed := RESULT_U8BIT;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_u16bit_mixed(b: byte) : word;safecall;
+ var
+ local_b: byte;
+ begin
+ func_u16bit_mixed := RESULT_U16BIT;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_s32bit_mixed(b: byte) : longint;safecall;
+ var
+ local_b: byte;
+ begin
+ func_s32bit_mixed := RESULT_S32BIT;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_s64bit_mixed(b: byte) : int64;safecall;
+ var
+ local_b: byte;
+ begin
+ func_s64bit_mixed := RESULT_S64BIT;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_s32real_mixed(b: byte) : single;safecall;
+ var
+ local_b: byte;
+ begin
+ func_s32real_mixed := RESULT_S32REAL;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_s64real_mixed(b: byte) : double;safecall;
+ var
+ local_b: byte;
+ begin
+ func_s64real_mixed := RESULT_S64REAl;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_ansistring_mixed(b: byte) : ansistring;safecall;
+ var
+ local_b: byte;
+ begin
+ func_ansistring_mixed := RESULT_BIGSTRING;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_pchar_mixed(b: byte) : pchar;safecall;
+ var
+ local_b: byte;
+ begin
+ func_pchar_mixed := RESULT_PCHAR;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+ {********************* FUNCTION RESULT WITH PARAMS (NESTED) ******************}
+{ LOC_MEM return values }
+function func_array_mixed_nested(b: byte): tsmallarray;safecall;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ smallarray: tsmallarray;
+ begin
+ fillchar(smallarray, sizeof(smallarray), #0);
+ smallarray[1] := RESULT_U8BIT;
+ smallarray[SMALL_INDEX] := RESULT_U8BIT;
+ func_array_mixed_nested := smallarray;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+{ nested_one_proc(RESULT_S32BIT);}
+ end;
+
+function func_largerecord_mixed_nested(b: byte): tlargerecord;safecall;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ largerecord : tlargerecord;
+ begin
+ fillchar(largerecord, sizeof(largerecord), #0);
+ largerecord.b[1] := RESULT_U8BIT;
+ largerecord.b[BIG_INDEX] := RESULT_U8BIT;
+ func_largerecord_mixed_nested := largerecord;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_shortstring_mixed_nested(b: byte): shortstring;safecall;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+ var
+ local_b: byte;
+ begin
+ func_shortstring_mixed_nested := RESULT_BIGSTRING;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_largeset_mixed_nested(b: byte) : tlargeset;safecall;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ largeset : tlargeset;
+ begin
+ largeset := ['I'];
+ func_largeset_mixed_nested := largeset;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_u8bit_mixed_nested(b: byte) : byte;safecall;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_u8bit_mixed_nested := RESULT_U8BIT;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_u16bit_mixed_nested(b: byte) : word;safecall;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_u16bit_mixed_nested := RESULT_U16BIT;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_s32bit_mixed_nested(b: byte) : longint;safecall;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_s32bit_mixed_nested := RESULT_S32BIT;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_s64bit_mixed_nested(b: byte) : int64;safecall;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_s64bit_mixed_nested := RESULT_S64BIT;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_s32real_mixed_nested(b: byte) : single;safecall;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_s32real_mixed_nested := RESULT_S32REAL;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_s64real_mixed_nested(b: byte) : double;safecall;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_s64real_mixed_nested := RESULT_S64REAl;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_ansistring_mixed_nested(b: byte) : ansistring;safecall;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_ansistring_mixed_nested := RESULT_BIGSTRING;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_pchar_mixed_nested(b: byte) : pchar;safecall;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_pchar_mixed_nested := RESULT_PCHAR;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+
+var
+ failed: boolean;
+Begin
+ {************************************* SIMPLE TESTS ***********************************}
+ write('Testing function results (LOC_REFERENCE)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_smallarray := func_array;
+ if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_largerec := func_largerecord;
+ if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[BIG_INDEX] <> RESULT_U8BIT) then
+ failed:=true;
+
+ clear_globals;
+ clear_values;
+ value_bigstring := func_shortstring;
+ if value_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_largeset := func_largeset;
+ if not ('I' in value_largeset) then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing orddef/enumdef function results (LOC_REGISTER)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+
+ value_u8bit := func_u8bit;
+ if value_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_u16bit := func_u16bit;
+ if value_u16bit <> RESULT_U16BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s32bit := func_s32bit;
+ if value_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s64bit := func_s64bit;
+ if value_s64bit <> RESULT_S64BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+
+ write('Testing floatdef function results...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ clear_globals;
+ clear_values;
+ value_s32real := func_s32real;
+ if trunc(value_s32real) <> trunc(RESULT_S32REAL) then
+ failed:=true;
+
+ clear_globals;
+ clear_values;
+ value_s64real := func_s64real;
+ if trunc(value_s64real) <> trunc(RESULT_S64REAL) then
+ failed:=true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing ansistring function result...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+
+value_ansistring := func_ansistring;
+if value_ansistring <> RESULT_BIGSTRING then
+ failed:=true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing pointer function result (LOC_REGISTER)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_ptr := func_pchar;
+ if value_ptr <> RESULT_PCHAR then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ {*********************************** TESTS W/PARAMS ***********************************}
+ write('Testing function results with parameter (LOC_REFERENCE)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_smallarray := func_array_mixed(RESULT_U8BIT);
+ if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_largerec := func_largerecord_mixed(RESULT_U8BIT);
+ if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[BIG_INDEX] <> RESULT_U8BIT) then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_bigstring := func_shortstring_mixed(RESULT_U8BIT);
+ if value_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_largeset := func_largeset_mixed(RESULT_U8BIT);
+ if not ('I' in value_largeset) then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing orddef/enumdef function results with parameter (LOC_REGISTER)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+
+ value_u8bit := func_u8bit_mixed(RESULT_U8BIT);
+ if value_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_u16bit := func_u16bit_mixed(RESULT_U8BIT);
+ if value_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s32bit := func_s32bit_mixed(RESULT_U8BIT);
+ if value_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s64bit := func_s64bit_mixed(RESULT_U8BIT);
+ if value_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+
+ write('Testing floatdef function results with parameter...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_s32real := func_s32real_mixed(RESULT_U8BIT);
+ if trunc(value_s32real) <> trunc(RESULT_S32REAL) then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s64real := func_s64real_mixed(RESULT_U8BIT);
+ if trunc(value_s64real) <> trunc(RESULT_S64REAL) then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing ansistring function result with parameter...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+
+ value_ansistring := func_ansistring_mixed(RESULT_U8BIT);
+ if value_ansistring <> RESULT_BIGSTRING then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing pointer function result with parameter (LOC_REGISTER)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_ptr := func_pchar_mixed(RESULT_U8BIT);
+ if value_ptr <> RESULT_PCHAR then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ {******************************NESTED TESTS W/PARAMS **********************************}
+ write('Testing function (w/nesting) results with parameter (LOC_REFERENCE)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_smallarray := func_array_mixed_nested(RESULT_U8BIT);
+ if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_largerec := func_largerecord_mixed_nested(RESULT_U8BIT);
+ if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[BIG_INDEX] <> RESULT_U8BIT) then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_bigstring := func_shortstring_mixed_nested(RESULT_U8BIT);
+ if value_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_largeset := func_largeset_mixed_nested(RESULT_U8BIT);
+ if not ('I' in value_largeset) then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing orddef/enumdef function (w/nesting) results with parameter (LOC_REGISTER)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+
+ value_u8bit := func_u8bit_mixed_nested(RESULT_U8BIT);
+ if value_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_u16bit := func_u16bit_mixed_nested(RESULT_U8BIT);
+ if value_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s32bit := func_s32bit_mixed_nested(RESULT_U8BIT);
+ if value_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s64bit := func_s64bit_mixed_nested(RESULT_U8BIT);
+ if value_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+
+ write('Testing floatdef function (w/nesting) results with parameter...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_s32real := func_s32real_mixed_nested(RESULT_U8BIT);
+ if trunc(value_s32real) <> trunc(RESULT_S32REAL) then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s64real := func_s64real_mixed_nested(RESULT_U8BIT);
+ if trunc(value_s64real) <> trunc(RESULT_S64REAL) then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing ansistring function (w/nesting) result with parameter...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+
+ value_ansistring := func_ansistring_mixed_nested(RESULT_U8BIT);
+ if value_ansistring <> RESULT_BIGSTRING then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing pointer function (w/nesting) result with parameter (LOC_REGISTER)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_ptr := func_pchar_mixed_nested(RESULT_U8BIT);
+ if value_ptr <> RESULT_PCHAR then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+end.
+
+{
$Log$
- Revision 1.4 2003-04-22 10:24:29 florian
+ Revision 1.5 2004-05-02 12:11:44 peter
+ * fixed linefeeds
+
+ Revision 1.4 2003/04/22 10:24:29 florian
* fixed defines for powerpc
-
- Revision 1.3 2002/09/07 15:40:51 peter
- * old logs removed and tabs fixed
-
- Revision 1.2 2002/05/13 13:45:36 peter
- * updated to compile tests with kylix
-
- Revision 1.1 2002/04/13 07:45:49 carl
- + Function calling tests , for different calling conventions.
-
-}
+
+ Revision 1.3 2002/09/07 15:40:51 peter
+ * old logs removed and tabs fixed
+
+ Revision 1.2 2002/05/13 13:45:36 peter
+ * updated to compile tests with kylix
+
+ Revision 1.1 2002/04/13 07:45:49 carl
+ + Function calling tests , for different calling conventions.
+
+}
diff --git a/tests/test/cg/tcalfun6.pp b/tests/test/cg/tcalfun6.pp
index b12e737cc9..c47cef3158 100644
--- a/tests/test/cg/tcalfun6.pp
+++ b/tests/test/cg/tcalfun6.pp
@@ -1,1417 +1,1420 @@
- {****************************************************************}
- { CODE GENERATOR TEST PROGRAM }
- { By Carl Eric Codere }
- {****************************************************************}
- { NODE TESTED : secondcallparan() }
- {****************************************************************}
- { PRE-REQUISITES: secondload() }
- { secondassign() }
- { secondtypeconv() }
- { secondtryexcept() }
- { secondcalln() }
- { secondadd() }
- {****************************************************************}
- { DEFINES: }
- { FPC = Target is FreePascal compiler }
- {****************************************************************}
- { REMARKS: This tests a subset of the secondcalln() node }
- { (function return values with register calling cnvs) }
- { (also tests nested routines up to 2 level deep) }
- {****************************************************************}
- program tcalfun6;
-
- {$ifdef fpc}
- {$mode objfpc}
- {$INLINE ON}
- {$endif}
- {$R+}
- {$P-}
-
-{$ifdef VER70}
- {$define tp}
-{$endif}
-
-
- { REAL should map to single or double }
- { so it is not checked, since single }
- { double nodes are checked. }
-
- { assumes that enumdef is the same as orddef (same storage format) }
-
- const
- { should be defined depending on CPU target }
-{$ifdef fpc}
- {$ifdef cpu68k}
- BIG_INDEX = 8000;
- SMALL_INDEX = 13;
- {$else}
- BIG_INDEX = 33000;
- SMALL_INDEX = 13; { value should not be aligned! }
- {$endif}
-{$else}
- BIG_INDEX = 33000;
- SMALL_INDEX = 13; { value should not be aligned! }
-{$endif}
- RESULT_U8BIT = $55;
- RESULT_U16BIT = $500F;
- RESULT_S32BIT = $500F0000;
- RESULT_S64BIT = $500F0000;
- RESULT_S32REAL = 1777.12;
- RESULT_S64REAL = 3444.24;
- RESULT_BOOL8BIT = 1;
- RESULT_BOOL16BIT = 1;
- RESULT_BOOL32BIT = 1;
- RESULT_PCHAR = 'Hello world';
- RESULT_BIGSTRING = 'Hello world';
- RESULT_SMALLSTRING = 'H';
- RESULT_CHAR = 'I';
- RESULT_BOOLEAN = TRUE;
-
- type
- {$ifndef tp}
- tclass1 = class
- end;
- {$else}
- shortstring = string;
- {$endif}
-
- tprocedure = procedure;
-
- tsmallrecord = packed record
- b: byte;
- w: word;
- end;
-
- tlargerecord = packed record
- b: array[1..BIG_INDEX] of byte;
- end;
-
- tsmallarray = packed array[1..SMALL_INDEX] of byte;
-
- tsmallsetenum =
- (A_A,A_B,A_C,A_D);
-
- tsmallset = set of tsmallsetenum;
- tlargeset = set of char;
-
- tsmallstring = string[2];
-
-
-
-
-
- var
- global_u8bit : byte;
- global_u16bit : word;
- global_s32bit : longint;
- global_s32real : single;
- global_s64real : double;
- global_ptr : pchar;
- global_proc : tprocedure;
- global_bigstring : shortstring;
- global_boolean : boolean;
- global_char : char;
- {$ifndef tp}
- global_class : tclass1;
- global_s64bit : int64;
- value_s64bit : int64;
- value_class : tclass1;
- {$endif}
- value_ansistring : ansistring;
- value_u8bit : byte;
- value_u16bit : word;
- value_s32bit : longint;
- value_s32real : single;
- value_s64real : double;
- value_proc : tprocedure;
- value_ptr : pchar;
- value_smallrec : tsmallrecord;
- value_largerec : tlargerecord;
- value_smallset : tsmallset;
- value_smallstring : tsmallstring;
- value_bigstring : shortstring;
- value_largeset : tlargeset;
- value_smallarray : tsmallarray;
- value_boolean : boolean;
- value_char : char;
-
- procedure fail;
- begin
- WriteLn('Failure.');
- halt(1);
- end;
-
-
- procedure clear_globals;
- begin
- global_u8bit := 0;
- global_u16bit := 0;
- global_s32bit := 0;
- global_s32real := 0.0;
- global_s64real := 0.0;
- global_ptr := nil;
- global_proc := nil;
- global_bigstring := '';
- global_boolean := false;
- global_char := #0;
- global_s64bit := 0;
- global_class := nil;
- end;
-
-
- procedure clear_values;
- begin
- value_u8bit := 0;
- value_u16bit := 0;
- value_s32bit := 0;
- value_s32real := 0.0;
- value_s64real := 0.0;
- value_proc := nil;
- value_ptr := nil;
- fillchar(value_smallrec, sizeof(value_smallrec), #0);
- fillchar(value_largerec, sizeof(value_largerec), #0);
- value_smallset := [];
- value_smallstring := '';
- value_bigstring := '';
- value_largeset := [];
- fillchar(value_smallarray, sizeof(value_smallarray), #0);
- value_boolean := false;
- value_char:=#0;
- value_ansistring := '';
- {$ifndef tp}
- value_s64bit := 0;
- value_class := nil;
- {$endif}
- end;
-
-
-
- {********************************* FUNCTION RESULTS *************************}
-
-{ LOC_MEM return values }
-function func_array: tsmallarray;register;
- var
- smallarray: tsmallarray;
- begin
- fillchar(smallarray, sizeof(smallarray), #0);
- smallarray[1] := RESULT_U8BIT;
- smallarray[SMALL_INDEX] := RESULT_U8BIT;
- func_array := smallarray;
- end;
-
-function func_largerecord: tlargerecord;register;
- var
- largerecord : tlargerecord;
- begin
- fillchar(largerecord, sizeof(largerecord), #0);
- largerecord.b[1] := RESULT_U8BIT;
- largerecord.b[BIG_INDEX] := RESULT_U8BIT;
- func_largerecord := largerecord;
- end;
-
-function func_shortstring: shortstring;register;
- begin
- func_shortstring := RESULT_BIGSTRING;
- end;
-
-function func_largeset : tlargeset;register;
- var
- largeset : tlargeset;
- begin
- largeset := ['I'];
- func_largeset := largeset;
- end;
-
-function func_u8bit : byte;register;
- begin
- func_u8bit := RESULT_U8BIT;
- end;
-
-function func_u16bit : word;register;
- begin
- func_u16bit := RESULT_U16BIT;
- end;
-
-function func_s32bit : longint;register;
- begin
- func_s32bit := RESULT_S32BIT;
- end;
-
-function func_s64bit : int64;register;
- begin
- func_s64bit := RESULT_S64BIT;
- end;
-
-function func_s32real : single;register;
- begin
- func_s32real := RESULT_S32REAL;
- end;
-
-function func_s64real : double;register;
- begin
- func_s64real := RESULT_S64REAl;
- end;
-
-function func_ansistring : ansistring;register;
- begin
- func_ansistring := RESULT_BIGSTRING;
- end;
-
-function func_pchar : pchar;register;
- begin
- func_pchar := RESULT_PCHAR;
- end;
-
- {************************** FUNCTION RESULT WITH PARAMS ******************}
-{ LOC_MEM return values }
-function func_array_mixed(b: byte): tsmallarray;register;
- var
- local_b: byte;
- smallarray: tsmallarray;
- begin
- fillchar(smallarray, sizeof(smallarray), #0);
- smallarray[1] := RESULT_U8BIT;
- smallarray[SMALL_INDEX] := RESULT_U8BIT;
- func_array_mixed := smallarray;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_largerecord_mixed(b: byte): tlargerecord;register;
- var
- local_b: byte;
- largerecord : tlargerecord;
- begin
- fillchar(largerecord, sizeof(largerecord), #0);
- largerecord.b[1] := RESULT_U8BIT;
- largerecord.b[BIG_INDEX] := RESULT_U8BIT;
- func_largerecord_mixed := largerecord;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_shortstring_mixed(b: byte): shortstring;register;
- var
- local_b: byte;
- begin
- func_shortstring_mixed := RESULT_BIGSTRING;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_largeset_mixed(b: byte) : tlargeset;register;
- var
- local_b: byte;
- largeset : tlargeset;
- begin
- largeset := ['I'];
- func_largeset_mixed := largeset;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_u8bit_mixed(b: byte) : byte;register;
- var
- local_b: byte;
- begin
- func_u8bit_mixed := RESULT_U8BIT;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_u16bit_mixed(b: byte) : word;register;
- var
- local_b: byte;
- begin
- func_u16bit_mixed := RESULT_U16BIT;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_s32bit_mixed(b: byte) : longint;register;
- var
- local_b: byte;
- begin
- func_s32bit_mixed := RESULT_S32BIT;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_s64bit_mixed(b: byte) : int64;register;
- var
- local_b: byte;
- begin
- func_s64bit_mixed := RESULT_S64BIT;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_s32real_mixed(b: byte) : single;register;
- var
- local_b: byte;
- begin
- func_s32real_mixed := RESULT_S32REAL;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_s64real_mixed(b: byte) : double;register;
- var
- local_b: byte;
- begin
- func_s64real_mixed := RESULT_S64REAl;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_ansistring_mixed(b: byte) : ansistring;register;
- var
- local_b: byte;
- begin
- func_ansistring_mixed := RESULT_BIGSTRING;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_pchar_mixed(b: byte) : pchar;register;
- var
- local_b: byte;
- begin
- func_pchar_mixed := RESULT_PCHAR;
- local_b:=b;
- global_u8bit := b;
- end;
-
- {********************* FUNCTION RESULT WITH PARAMS (NESTED) ******************}
-{ LOC_MEM return values }
-function func_array_mixed_nested(b: byte): tsmallarray;register;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- smallarray: tsmallarray;
- begin
- fillchar(smallarray, sizeof(smallarray), #0);
- smallarray[1] := RESULT_U8BIT;
- smallarray[SMALL_INDEX] := RESULT_U8BIT;
- func_array_mixed_nested := smallarray;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
-{ nested_one_proc(RESULT_S32BIT);}
- end;
-
-function func_largerecord_mixed_nested(b: byte): tlargerecord;register;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- largerecord : tlargerecord;
- begin
- fillchar(largerecord, sizeof(largerecord), #0);
- largerecord.b[1] := RESULT_U8BIT;
- largerecord.b[BIG_INDEX] := RESULT_U8BIT;
- func_largerecord_mixed_nested := largerecord;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_shortstring_mixed_nested(b: byte): shortstring;register;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
- var
- local_b: byte;
- begin
- func_shortstring_mixed_nested := RESULT_BIGSTRING;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_largeset_mixed_nested(b: byte) : tlargeset;register;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- largeset : tlargeset;
- begin
- largeset := ['I'];
- func_largeset_mixed_nested := largeset;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_u8bit_mixed_nested(b: byte) : byte;register;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_u8bit_mixed_nested := RESULT_U8BIT;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_u16bit_mixed_nested(b: byte) : word;register;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_u16bit_mixed_nested := RESULT_U16BIT;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_s32bit_mixed_nested(b: byte) : longint;register;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_s32bit_mixed_nested := RESULT_S32BIT;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_s64bit_mixed_nested(b: byte) : int64;register;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_s64bit_mixed_nested := RESULT_S64BIT;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_s32real_mixed_nested(b: byte) : single;register;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_s32real_mixed_nested := RESULT_S32REAL;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_s64real_mixed_nested(b: byte) : double;register;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_s64real_mixed_nested := RESULT_S64REAl;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_ansistring_mixed_nested(b: byte) : ansistring;register;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_ansistring_mixed_nested := RESULT_BIGSTRING;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_pchar_mixed_nested(b: byte) : pchar;register;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_pchar_mixed_nested := RESULT_PCHAR;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-
-var
- failed: boolean;
-Begin
- {************************************* SIMPLE TESTS ***********************************}
- write('Testing function results (LOC_REFERENCE)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_smallarray := func_array;
- if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
- failed := true;
-
- clear_globals;
- clear_values;
- value_largerec := func_largerecord;
- if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[BIG_INDEX] <> RESULT_U8BIT) then
- failed:=true;
-
- clear_globals;
- clear_values;
- value_bigstring := func_shortstring;
- if value_bigstring <> RESULT_BIGSTRING then
- failed := true;
-
- clear_globals;
- clear_values;
- value_largeset := func_largeset;
- if not ('I' in value_largeset) then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing orddef/enumdef function results (LOC_REGISTER)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
-
- value_u8bit := func_u8bit;
- if value_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_u16bit := func_u16bit;
- if value_u16bit <> RESULT_U16BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s32bit := func_s32bit;
- if value_s32bit <> RESULT_S32BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s64bit := func_s64bit;
- if value_s64bit <> RESULT_S64BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
-
- write('Testing floatdef function results...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- clear_globals;
- clear_values;
- value_s32real := func_s32real;
- if trunc(value_s32real) <> trunc(RESULT_S32REAL) then
- failed:=true;
-
- clear_globals;
- clear_values;
- value_s64real := func_s64real;
- if trunc(value_s64real) <> trunc(RESULT_S64REAL) then
- failed:=true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing ansistring function result...');
-
- clear_globals;
- clear_values;
- failed := false;
-
-
-value_ansistring := func_ansistring;
-if value_ansistring <> RESULT_BIGSTRING then
- failed:=true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing pointer function result (LOC_REGISTER)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_ptr := func_pchar;
- if value_ptr <> RESULT_PCHAR then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- {*********************************** TESTS W/PARAMS ***********************************}
- write('Testing function results with parameter (LOC_REFERENCE)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_smallarray := func_array_mixed(RESULT_U8BIT);
- if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_largerec := func_largerecord_mixed(RESULT_U8BIT);
- if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[BIG_INDEX] <> RESULT_U8BIT) then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_bigstring := func_shortstring_mixed(RESULT_U8BIT);
- if value_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_largeset := func_largeset_mixed(RESULT_U8BIT);
- if not ('I' in value_largeset) then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing orddef/enumdef function results with parameter (LOC_REGISTER)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
-
- value_u8bit := func_u8bit_mixed(RESULT_U8BIT);
- if value_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_u16bit := func_u16bit_mixed(RESULT_U8BIT);
- if value_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s32bit := func_s32bit_mixed(RESULT_U8BIT);
- if value_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s64bit := func_s64bit_mixed(RESULT_U8BIT);
- if value_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
-
- write('Testing floatdef function results with parameter...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_s32real := func_s32real_mixed(RESULT_U8BIT);
- if trunc(value_s32real) <> trunc(RESULT_S32REAL) then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s64real := func_s64real_mixed(RESULT_U8BIT);
- if trunc(value_s64real) <> trunc(RESULT_S64REAL) then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing ansistring function result with parameter...');
-
- clear_globals;
- clear_values;
- failed := false;
-
-
- value_ansistring := func_ansistring_mixed(RESULT_U8BIT);
- if value_ansistring <> RESULT_BIGSTRING then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing pointer function result with parameter (LOC_REGISTER)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_ptr := func_pchar_mixed(RESULT_U8BIT);
- if value_ptr <> RESULT_PCHAR then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- {******************************NESTED TESTS W/PARAMS **********************************}
- write('Testing function (w/nesting) results with parameter (LOC_REFERENCE)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_smallarray := func_array_mixed_nested(RESULT_U8BIT);
- if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_largerec := func_largerecord_mixed_nested(RESULT_U8BIT);
- if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[BIG_INDEX] <> RESULT_U8BIT) then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_bigstring := func_shortstring_mixed_nested(RESULT_U8BIT);
- if value_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_largeset := func_largeset_mixed_nested(RESULT_U8BIT);
- if not ('I' in value_largeset) then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing orddef/enumdef function (w/nesting) results with parameter (LOC_REGISTER)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
-
- value_u8bit := func_u8bit_mixed_nested(RESULT_U8BIT);
- if value_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_u16bit := func_u16bit_mixed_nested(RESULT_U8BIT);
- if value_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s32bit := func_s32bit_mixed_nested(RESULT_U8BIT);
- if value_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s64bit := func_s64bit_mixed_nested(RESULT_U8BIT);
- if value_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
-
- write('Testing floatdef function (w/nesting) results with parameter...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_s32real := func_s32real_mixed_nested(RESULT_U8BIT);
- if trunc(value_s32real) <> trunc(RESULT_S32REAL) then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s64real := func_s64real_mixed_nested(RESULT_U8BIT);
- if trunc(value_s64real) <> trunc(RESULT_S64REAL) then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing ansistring function (w/nesting) result with parameter...');
-
- clear_globals;
- clear_values;
- failed := false;
-
-
- value_ansistring := func_ansistring_mixed_nested(RESULT_U8BIT);
- if value_ansistring <> RESULT_BIGSTRING then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing pointer function (w/nesting) result with parameter (LOC_REGISTER)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_ptr := func_pchar_mixed_nested(RESULT_U8BIT);
- if value_ptr <> RESULT_PCHAR then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-end.
-
-{
+ {****************************************************************}
+ { CODE GENERATOR TEST PROGRAM }
+ { By Carl Eric Codere }
+ {****************************************************************}
+ { NODE TESTED : secondcallparan() }
+ {****************************************************************}
+ { PRE-REQUISITES: secondload() }
+ { secondassign() }
+ { secondtypeconv() }
+ { secondtryexcept() }
+ { secondcalln() }
+ { secondadd() }
+ {****************************************************************}
+ { DEFINES: }
+ { FPC = Target is FreePascal compiler }
+ {****************************************************************}
+ { REMARKS: This tests a subset of the secondcalln() node }
+ { (function return values with register calling cnvs) }
+ { (also tests nested routines up to 2 level deep) }
+ {****************************************************************}
+ program tcalfun6;
+
+ {$ifdef fpc}
+ {$mode objfpc}
+ {$INLINE ON}
+ {$endif}
+ {$R+}
+ {$P-}
+
+{$ifdef VER70}
+ {$define tp}
+{$endif}
+
+
+ { REAL should map to single or double }
+ { so it is not checked, since single }
+ { double nodes are checked. }
+
+ { assumes that enumdef is the same as orddef (same storage format) }
+
+ const
+ { should be defined depending on CPU target }
+{$ifdef fpc}
+ {$ifdef cpu68k}
+ BIG_INDEX = 8000;
+ SMALL_INDEX = 13;
+ {$else}
+ BIG_INDEX = 33000;
+ SMALL_INDEX = 13; { value should not be aligned! }
+ {$endif}
+{$else}
+ BIG_INDEX = 33000;
+ SMALL_INDEX = 13; { value should not be aligned! }
+{$endif}
+ RESULT_U8BIT = $55;
+ RESULT_U16BIT = $500F;
+ RESULT_S32BIT = $500F0000;
+ RESULT_S64BIT = $500F0000;
+ RESULT_S32REAL = 1777.12;
+ RESULT_S64REAL = 3444.24;
+ RESULT_BOOL8BIT = 1;
+ RESULT_BOOL16BIT = 1;
+ RESULT_BOOL32BIT = 1;
+ RESULT_PCHAR = 'Hello world';
+ RESULT_BIGSTRING = 'Hello world';
+ RESULT_SMALLSTRING = 'H';
+ RESULT_CHAR = 'I';
+ RESULT_BOOLEAN = TRUE;
+
+ type
+ {$ifndef tp}
+ tclass1 = class
+ end;
+ {$else}
+ shortstring = string;
+ {$endif}
+
+ tprocedure = procedure;
+
+ tsmallrecord = packed record
+ b: byte;
+ w: word;
+ end;
+
+ tlargerecord = packed record
+ b: array[1..BIG_INDEX] of byte;
+ end;
+
+ tsmallarray = packed array[1..SMALL_INDEX] of byte;
+
+ tsmallsetenum =
+ (A_A,A_B,A_C,A_D);
+
+ tsmallset = set of tsmallsetenum;
+ tlargeset = set of char;
+
+ tsmallstring = string[2];
+
+
+
+
+
+ var
+ global_u8bit : byte;
+ global_u16bit : word;
+ global_s32bit : longint;
+ global_s32real : single;
+ global_s64real : double;
+ global_ptr : pchar;
+ global_proc : tprocedure;
+ global_bigstring : shortstring;
+ global_boolean : boolean;
+ global_char : char;
+ {$ifndef tp}
+ global_class : tclass1;
+ global_s64bit : int64;
+ value_s64bit : int64;
+ value_class : tclass1;
+ {$endif}
+ value_ansistring : ansistring;
+ value_u8bit : byte;
+ value_u16bit : word;
+ value_s32bit : longint;
+ value_s32real : single;
+ value_s64real : double;
+ value_proc : tprocedure;
+ value_ptr : pchar;
+ value_smallrec : tsmallrecord;
+ value_largerec : tlargerecord;
+ value_smallset : tsmallset;
+ value_smallstring : tsmallstring;
+ value_bigstring : shortstring;
+ value_largeset : tlargeset;
+ value_smallarray : tsmallarray;
+ value_boolean : boolean;
+ value_char : char;
+
+ procedure fail;
+ begin
+ WriteLn('Failure.');
+ halt(1);
+ end;
+
+
+ procedure clear_globals;
+ begin
+ global_u8bit := 0;
+ global_u16bit := 0;
+ global_s32bit := 0;
+ global_s32real := 0.0;
+ global_s64real := 0.0;
+ global_ptr := nil;
+ global_proc := nil;
+ global_bigstring := '';
+ global_boolean := false;
+ global_char := #0;
+ global_s64bit := 0;
+ global_class := nil;
+ end;
+
+
+ procedure clear_values;
+ begin
+ value_u8bit := 0;
+ value_u16bit := 0;
+ value_s32bit := 0;
+ value_s32real := 0.0;
+ value_s64real := 0.0;
+ value_proc := nil;
+ value_ptr := nil;
+ fillchar(value_smallrec, sizeof(value_smallrec), #0);
+ fillchar(value_largerec, sizeof(value_largerec), #0);
+ value_smallset := [];
+ value_smallstring := '';
+ value_bigstring := '';
+ value_largeset := [];
+ fillchar(value_smallarray, sizeof(value_smallarray), #0);
+ value_boolean := false;
+ value_char:=#0;
+ value_ansistring := '';
+ {$ifndef tp}
+ value_s64bit := 0;
+ value_class := nil;
+ {$endif}
+ end;
+
+
+
+ {********************************* FUNCTION RESULTS *************************}
+
+{ LOC_MEM return values }
+function func_array: tsmallarray;register;
+ var
+ smallarray: tsmallarray;
+ begin
+ fillchar(smallarray, sizeof(smallarray), #0);
+ smallarray[1] := RESULT_U8BIT;
+ smallarray[SMALL_INDEX] := RESULT_U8BIT;
+ func_array := smallarray;
+ end;
+
+function func_largerecord: tlargerecord;register;
+ var
+ largerecord : tlargerecord;
+ begin
+ fillchar(largerecord, sizeof(largerecord), #0);
+ largerecord.b[1] := RESULT_U8BIT;
+ largerecord.b[BIG_INDEX] := RESULT_U8BIT;
+ func_largerecord := largerecord;
+ end;
+
+function func_shortstring: shortstring;register;
+ begin
+ func_shortstring := RESULT_BIGSTRING;
+ end;
+
+function func_largeset : tlargeset;register;
+ var
+ largeset : tlargeset;
+ begin
+ largeset := ['I'];
+ func_largeset := largeset;
+ end;
+
+function func_u8bit : byte;register;
+ begin
+ func_u8bit := RESULT_U8BIT;
+ end;
+
+function func_u16bit : word;register;
+ begin
+ func_u16bit := RESULT_U16BIT;
+ end;
+
+function func_s32bit : longint;register;
+ begin
+ func_s32bit := RESULT_S32BIT;
+ end;
+
+function func_s64bit : int64;register;
+ begin
+ func_s64bit := RESULT_S64BIT;
+ end;
+
+function func_s32real : single;register;
+ begin
+ func_s32real := RESULT_S32REAL;
+ end;
+
+function func_s64real : double;register;
+ begin
+ func_s64real := RESULT_S64REAl;
+ end;
+
+function func_ansistring : ansistring;register;
+ begin
+ func_ansistring := RESULT_BIGSTRING;
+ end;
+
+function func_pchar : pchar;register;
+ begin
+ func_pchar := RESULT_PCHAR;
+ end;
+
+ {************************** FUNCTION RESULT WITH PARAMS ******************}
+{ LOC_MEM return values }
+function func_array_mixed(b: byte): tsmallarray;register;
+ var
+ local_b: byte;
+ smallarray: tsmallarray;
+ begin
+ fillchar(smallarray, sizeof(smallarray), #0);
+ smallarray[1] := RESULT_U8BIT;
+ smallarray[SMALL_INDEX] := RESULT_U8BIT;
+ func_array_mixed := smallarray;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_largerecord_mixed(b: byte): tlargerecord;register;
+ var
+ local_b: byte;
+ largerecord : tlargerecord;
+ begin
+ fillchar(largerecord, sizeof(largerecord), #0);
+ largerecord.b[1] := RESULT_U8BIT;
+ largerecord.b[BIG_INDEX] := RESULT_U8BIT;
+ func_largerecord_mixed := largerecord;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_shortstring_mixed(b: byte): shortstring;register;
+ var
+ local_b: byte;
+ begin
+ func_shortstring_mixed := RESULT_BIGSTRING;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_largeset_mixed(b: byte) : tlargeset;register;
+ var
+ local_b: byte;
+ largeset : tlargeset;
+ begin
+ largeset := ['I'];
+ func_largeset_mixed := largeset;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_u8bit_mixed(b: byte) : byte;register;
+ var
+ local_b: byte;
+ begin
+ func_u8bit_mixed := RESULT_U8BIT;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_u16bit_mixed(b: byte) : word;register;
+ var
+ local_b: byte;
+ begin
+ func_u16bit_mixed := RESULT_U16BIT;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_s32bit_mixed(b: byte) : longint;register;
+ var
+ local_b: byte;
+ begin
+ func_s32bit_mixed := RESULT_S32BIT;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_s64bit_mixed(b: byte) : int64;register;
+ var
+ local_b: byte;
+ begin
+ func_s64bit_mixed := RESULT_S64BIT;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_s32real_mixed(b: byte) : single;register;
+ var
+ local_b: byte;
+ begin
+ func_s32real_mixed := RESULT_S32REAL;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_s64real_mixed(b: byte) : double;register;
+ var
+ local_b: byte;
+ begin
+ func_s64real_mixed := RESULT_S64REAl;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_ansistring_mixed(b: byte) : ansistring;register;
+ var
+ local_b: byte;
+ begin
+ func_ansistring_mixed := RESULT_BIGSTRING;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_pchar_mixed(b: byte) : pchar;register;
+ var
+ local_b: byte;
+ begin
+ func_pchar_mixed := RESULT_PCHAR;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+ {********************* FUNCTION RESULT WITH PARAMS (NESTED) ******************}
+{ LOC_MEM return values }
+function func_array_mixed_nested(b: byte): tsmallarray;register;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ smallarray: tsmallarray;
+ begin
+ fillchar(smallarray, sizeof(smallarray), #0);
+ smallarray[1] := RESULT_U8BIT;
+ smallarray[SMALL_INDEX] := RESULT_U8BIT;
+ func_array_mixed_nested := smallarray;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+{ nested_one_proc(RESULT_S32BIT);}
+ end;
+
+function func_largerecord_mixed_nested(b: byte): tlargerecord;register;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ largerecord : tlargerecord;
+ begin
+ fillchar(largerecord, sizeof(largerecord), #0);
+ largerecord.b[1] := RESULT_U8BIT;
+ largerecord.b[BIG_INDEX] := RESULT_U8BIT;
+ func_largerecord_mixed_nested := largerecord;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_shortstring_mixed_nested(b: byte): shortstring;register;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+ var
+ local_b: byte;
+ begin
+ func_shortstring_mixed_nested := RESULT_BIGSTRING;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_largeset_mixed_nested(b: byte) : tlargeset;register;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ largeset : tlargeset;
+ begin
+ largeset := ['I'];
+ func_largeset_mixed_nested := largeset;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_u8bit_mixed_nested(b: byte) : byte;register;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_u8bit_mixed_nested := RESULT_U8BIT;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_u16bit_mixed_nested(b: byte) : word;register;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_u16bit_mixed_nested := RESULT_U16BIT;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_s32bit_mixed_nested(b: byte) : longint;register;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_s32bit_mixed_nested := RESULT_S32BIT;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_s64bit_mixed_nested(b: byte) : int64;register;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_s64bit_mixed_nested := RESULT_S64BIT;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_s32real_mixed_nested(b: byte) : single;register;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_s32real_mixed_nested := RESULT_S32REAL;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_s64real_mixed_nested(b: byte) : double;register;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_s64real_mixed_nested := RESULT_S64REAl;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_ansistring_mixed_nested(b: byte) : ansistring;register;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_ansistring_mixed_nested := RESULT_BIGSTRING;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_pchar_mixed_nested(b: byte) : pchar;register;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_pchar_mixed_nested := RESULT_PCHAR;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+
+var
+ failed: boolean;
+Begin
+ {************************************* SIMPLE TESTS ***********************************}
+ write('Testing function results (LOC_REFERENCE)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_smallarray := func_array;
+ if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_largerec := func_largerecord;
+ if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[BIG_INDEX] <> RESULT_U8BIT) then
+ failed:=true;
+
+ clear_globals;
+ clear_values;
+ value_bigstring := func_shortstring;
+ if value_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_largeset := func_largeset;
+ if not ('I' in value_largeset) then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing orddef/enumdef function results (LOC_REGISTER)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+
+ value_u8bit := func_u8bit;
+ if value_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_u16bit := func_u16bit;
+ if value_u16bit <> RESULT_U16BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s32bit := func_s32bit;
+ if value_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s64bit := func_s64bit;
+ if value_s64bit <> RESULT_S64BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+
+ write('Testing floatdef function results...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ clear_globals;
+ clear_values;
+ value_s32real := func_s32real;
+ if trunc(value_s32real) <> trunc(RESULT_S32REAL) then
+ failed:=true;
+
+ clear_globals;
+ clear_values;
+ value_s64real := func_s64real;
+ if trunc(value_s64real) <> trunc(RESULT_S64REAL) then
+ failed:=true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing ansistring function result...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+
+value_ansistring := func_ansistring;
+if value_ansistring <> RESULT_BIGSTRING then
+ failed:=true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing pointer function result (LOC_REGISTER)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_ptr := func_pchar;
+ if value_ptr <> RESULT_PCHAR then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ {*********************************** TESTS W/PARAMS ***********************************}
+ write('Testing function results with parameter (LOC_REFERENCE)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_smallarray := func_array_mixed(RESULT_U8BIT);
+ if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_largerec := func_largerecord_mixed(RESULT_U8BIT);
+ if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[BIG_INDEX] <> RESULT_U8BIT) then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_bigstring := func_shortstring_mixed(RESULT_U8BIT);
+ if value_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_largeset := func_largeset_mixed(RESULT_U8BIT);
+ if not ('I' in value_largeset) then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing orddef/enumdef function results with parameter (LOC_REGISTER)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+
+ value_u8bit := func_u8bit_mixed(RESULT_U8BIT);
+ if value_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_u16bit := func_u16bit_mixed(RESULT_U8BIT);
+ if value_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s32bit := func_s32bit_mixed(RESULT_U8BIT);
+ if value_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s64bit := func_s64bit_mixed(RESULT_U8BIT);
+ if value_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+
+ write('Testing floatdef function results with parameter...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_s32real := func_s32real_mixed(RESULT_U8BIT);
+ if trunc(value_s32real) <> trunc(RESULT_S32REAL) then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s64real := func_s64real_mixed(RESULT_U8BIT);
+ if trunc(value_s64real) <> trunc(RESULT_S64REAL) then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing ansistring function result with parameter...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+
+ value_ansistring := func_ansistring_mixed(RESULT_U8BIT);
+ if value_ansistring <> RESULT_BIGSTRING then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing pointer function result with parameter (LOC_REGISTER)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_ptr := func_pchar_mixed(RESULT_U8BIT);
+ if value_ptr <> RESULT_PCHAR then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ {******************************NESTED TESTS W/PARAMS **********************************}
+ write('Testing function (w/nesting) results with parameter (LOC_REFERENCE)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_smallarray := func_array_mixed_nested(RESULT_U8BIT);
+ if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_largerec := func_largerecord_mixed_nested(RESULT_U8BIT);
+ if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[BIG_INDEX] <> RESULT_U8BIT) then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_bigstring := func_shortstring_mixed_nested(RESULT_U8BIT);
+ if value_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_largeset := func_largeset_mixed_nested(RESULT_U8BIT);
+ if not ('I' in value_largeset) then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing orddef/enumdef function (w/nesting) results with parameter (LOC_REGISTER)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+
+ value_u8bit := func_u8bit_mixed_nested(RESULT_U8BIT);
+ if value_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_u16bit := func_u16bit_mixed_nested(RESULT_U8BIT);
+ if value_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s32bit := func_s32bit_mixed_nested(RESULT_U8BIT);
+ if value_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s64bit := func_s64bit_mixed_nested(RESULT_U8BIT);
+ if value_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+
+ write('Testing floatdef function (w/nesting) results with parameter...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_s32real := func_s32real_mixed_nested(RESULT_U8BIT);
+ if trunc(value_s32real) <> trunc(RESULT_S32REAL) then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s64real := func_s64real_mixed_nested(RESULT_U8BIT);
+ if trunc(value_s64real) <> trunc(RESULT_S64REAL) then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing ansistring function (w/nesting) result with parameter...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+
+ value_ansistring := func_ansistring_mixed_nested(RESULT_U8BIT);
+ if value_ansistring <> RESULT_BIGSTRING then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing pointer function (w/nesting) result with parameter (LOC_REGISTER)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_ptr := func_pchar_mixed_nested(RESULT_U8BIT);
+ if value_ptr <> RESULT_PCHAR then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+end.
+
+{
$Log$
- Revision 1.4 2003-04-22 10:24:29 florian
+ Revision 1.5 2004-05-02 12:11:44 peter
+ * fixed linefeeds
+
+ Revision 1.4 2003/04/22 10:24:29 florian
* fixed defines for powerpc
-
- Revision 1.3 2002/09/07 15:40:51 peter
- * old logs removed and tabs fixed
-
- Revision 1.2 2002/05/13 13:45:36 peter
- * updated to compile tests with kylix
-
- Revision 1.1 2002/04/13 07:45:49 carl
- + Function calling tests , for different calling conventions.
-
-}
+
+ Revision 1.3 2002/09/07 15:40:51 peter
+ * old logs removed and tabs fixed
+
+ Revision 1.2 2002/05/13 13:45:36 peter
+ * updated to compile tests with kylix
+
+ Revision 1.1 2002/04/13 07:45:49 carl
+ + Function calling tests , for different calling conventions.
+
+}
diff --git a/tests/test/cg/tcalfun7.pp b/tests/test/cg/tcalfun7.pp
index 7f2bb72f47..4223aae807 100644
--- a/tests/test/cg/tcalfun7.pp
+++ b/tests/test/cg/tcalfun7.pp
@@ -1,1417 +1,1420 @@
- {****************************************************************}
- { CODE GENERATOR TEST PROGRAM }
- { By Carl Eric Codere }
- {****************************************************************}
- { NODE TESTED : secondcallparan() }
- {****************************************************************}
- { PRE-REQUISITES: secondload() }
- { secondassign() }
- { secondtypeconv() }
- { secondtryexcept() }
- { secondcalln() }
- { secondadd() }
- {****************************************************************}
- { DEFINES: }
- { FPC = Target is FreePascal compiler }
- {****************************************************************}
- { REMARKS: This tests a subset of the secondcalln() node }
- { (function return values with stdcall calling cnvs) }
- { (also tests nested routines up to 2 level deep) }
- {****************************************************************}
- program tcalfun7;
-
- {$ifdef fpc}
- {$mode objfpc}
- {$INLINE ON}
- {$endif}
- {$R+}
- {$P-}
-
-{$ifdef VER70}
- {$define tp}
-{$endif}
-
-
- { REAL should map to single or double }
- { so it is not checked, since single }
- { double nodes are checked. }
-
- { assumes that enumdef is the same as orddef (same storage format) }
-
- const
- { should be defined depending on CPU target }
-{$ifdef fpc}
- {$ifdef cpu68k}
- BIG_INDEX = 8000;
- SMALL_INDEX = 13;
- {$else}
- BIG_INDEX = 33000;
- SMALL_INDEX = 13; { value should not be aligned! }
- {$endif}
-{$else}
- BIG_INDEX = 33000;
- SMALL_INDEX = 13; { value should not be aligned! }
-{$endif}
- RESULT_U8BIT = $55;
- RESULT_U16BIT = $500F;
- RESULT_S32BIT = $500F0000;
- RESULT_S64BIT = $500F0000;
- RESULT_S32REAL = 1777.12;
- RESULT_S64REAL = 3444.24;
- RESULT_BOOL8BIT = 1;
- RESULT_BOOL16BIT = 1;
- RESULT_BOOL32BIT = 1;
- RESULT_PCHAR = 'Hello world';
- RESULT_BIGSTRING = 'Hello world';
- RESULT_SMALLSTRING = 'H';
- RESULT_CHAR = 'I';
- RESULT_BOOLEAN = TRUE;
-
- type
- {$ifndef tp}
- tclass1 = class
- end;
- {$else}
- shortstring = string;
- {$endif}
-
- tprocedure = procedure;
-
- tsmallrecord = packed record
- b: byte;
- w: word;
- end;
-
- tlargerecord = packed record
- b: array[1..BIG_INDEX] of byte;
- end;
-
- tsmallarray = packed array[1..SMALL_INDEX] of byte;
-
- tsmallsetenum =
- (A_A,A_B,A_C,A_D);
-
- tsmallset = set of tsmallsetenum;
- tlargeset = set of char;
-
- tsmallstring = string[2];
-
-
-
-
-
- var
- global_u8bit : byte;
- global_u16bit : word;
- global_s32bit : longint;
- global_s32real : single;
- global_s64real : double;
- global_ptr : pchar;
- global_proc : tprocedure;
- global_bigstring : shortstring;
- global_boolean : boolean;
- global_char : char;
- {$ifndef tp}
- global_class : tclass1;
- global_s64bit : int64;
- value_s64bit : int64;
- value_class : tclass1;
- {$endif}
- value_ansistring : ansistring;
- value_u8bit : byte;
- value_u16bit : word;
- value_s32bit : longint;
- value_s32real : single;
- value_s64real : double;
- value_proc : tprocedure;
- value_ptr : pchar;
- value_smallrec : tsmallrecord;
- value_largerec : tlargerecord;
- value_smallset : tsmallset;
- value_smallstring : tsmallstring;
- value_bigstring : shortstring;
- value_largeset : tlargeset;
- value_smallarray : tsmallarray;
- value_boolean : boolean;
- value_char : char;
-
- procedure fail;
- begin
- WriteLn('Failure.');
- halt(1);
- end;
-
-
- procedure clear_globals;
- begin
- global_u8bit := 0;
- global_u16bit := 0;
- global_s32bit := 0;
- global_s32real := 0.0;
- global_s64real := 0.0;
- global_ptr := nil;
- global_proc := nil;
- global_bigstring := '';
- global_boolean := false;
- global_char := #0;
- global_s64bit := 0;
- global_class := nil;
- end;
-
-
- procedure clear_values;
- begin
- value_u8bit := 0;
- value_u16bit := 0;
- value_s32bit := 0;
- value_s32real := 0.0;
- value_s64real := 0.0;
- value_proc := nil;
- value_ptr := nil;
- fillchar(value_smallrec, sizeof(value_smallrec), #0);
- fillchar(value_largerec, sizeof(value_largerec), #0);
- value_smallset := [];
- value_smallstring := '';
- value_bigstring := '';
- value_largeset := [];
- fillchar(value_smallarray, sizeof(value_smallarray), #0);
- value_boolean := false;
- value_char:=#0;
- value_ansistring := '';
- {$ifndef tp}
- value_s64bit := 0;
- value_class := nil;
- {$endif}
- end;
-
-
-
- {********************************* FUNCTION RESULTS *************************}
-
-{ LOC_MEM return values }
-function func_array: tsmallarray;stdcall;
- var
- smallarray: tsmallarray;
- begin
- fillchar(smallarray, sizeof(smallarray), #0);
- smallarray[1] := RESULT_U8BIT;
- smallarray[SMALL_INDEX] := RESULT_U8BIT;
- func_array := smallarray;
- end;
-
-function func_largerecord: tlargerecord;stdcall;
- var
- largerecord : tlargerecord;
- begin
- fillchar(largerecord, sizeof(largerecord), #0);
- largerecord.b[1] := RESULT_U8BIT;
- largerecord.b[BIG_INDEX] := RESULT_U8BIT;
- func_largerecord := largerecord;
- end;
-
-function func_shortstring: shortstring;stdcall;
- begin
- func_shortstring := RESULT_BIGSTRING;
- end;
-
-function func_largeset : tlargeset;stdcall;
- var
- largeset : tlargeset;
- begin
- largeset := ['I'];
- func_largeset := largeset;
- end;
-
-function func_u8bit : byte;stdcall;
- begin
- func_u8bit := RESULT_U8BIT;
- end;
-
-function func_u16bit : word;stdcall;
- begin
- func_u16bit := RESULT_U16BIT;
- end;
-
-function func_s32bit : longint;stdcall;
- begin
- func_s32bit := RESULT_S32BIT;
- end;
-
-function func_s64bit : int64;stdcall;
- begin
- func_s64bit := RESULT_S64BIT;
- end;
-
-function func_s32real : single;stdcall;
- begin
- func_s32real := RESULT_S32REAL;
- end;
-
-function func_s64real : double;stdcall;
- begin
- func_s64real := RESULT_S64REAl;
- end;
-
-function func_ansistring : ansistring;stdcall;
- begin
- func_ansistring := RESULT_BIGSTRING;
- end;
-
-function func_pchar : pchar;stdcall;
- begin
- func_pchar := RESULT_PCHAR;
- end;
-
- {************************** FUNCTION RESULT WITH PARAMS ******************}
-{ LOC_MEM return values }
-function func_array_mixed(b: byte): tsmallarray;stdcall;
- var
- local_b: byte;
- smallarray: tsmallarray;
- begin
- fillchar(smallarray, sizeof(smallarray), #0);
- smallarray[1] := RESULT_U8BIT;
- smallarray[SMALL_INDEX] := RESULT_U8BIT;
- func_array_mixed := smallarray;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_largerecord_mixed(b: byte): tlargerecord;stdcall;
- var
- local_b: byte;
- largerecord : tlargerecord;
- begin
- fillchar(largerecord, sizeof(largerecord), #0);
- largerecord.b[1] := RESULT_U8BIT;
- largerecord.b[BIG_INDEX] := RESULT_U8BIT;
- func_largerecord_mixed := largerecord;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_shortstring_mixed(b: byte): shortstring;stdcall;
- var
- local_b: byte;
- begin
- func_shortstring_mixed := RESULT_BIGSTRING;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_largeset_mixed(b: byte) : tlargeset;stdcall;
- var
- local_b: byte;
- largeset : tlargeset;
- begin
- largeset := ['I'];
- func_largeset_mixed := largeset;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_u8bit_mixed(b: byte) : byte;stdcall;
- var
- local_b: byte;
- begin
- func_u8bit_mixed := RESULT_U8BIT;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_u16bit_mixed(b: byte) : word;stdcall;
- var
- local_b: byte;
- begin
- func_u16bit_mixed := RESULT_U16BIT;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_s32bit_mixed(b: byte) : longint;stdcall;
- var
- local_b: byte;
- begin
- func_s32bit_mixed := RESULT_S32BIT;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_s64bit_mixed(b: byte) : int64;stdcall;
- var
- local_b: byte;
- begin
- func_s64bit_mixed := RESULT_S64BIT;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_s32real_mixed(b: byte) : single;stdcall;
- var
- local_b: byte;
- begin
- func_s32real_mixed := RESULT_S32REAL;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_s64real_mixed(b: byte) : double;stdcall;
- var
- local_b: byte;
- begin
- func_s64real_mixed := RESULT_S64REAl;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_ansistring_mixed(b: byte) : ansistring;stdcall;
- var
- local_b: byte;
- begin
- func_ansistring_mixed := RESULT_BIGSTRING;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_pchar_mixed(b: byte) : pchar;stdcall;
- var
- local_b: byte;
- begin
- func_pchar_mixed := RESULT_PCHAR;
- local_b:=b;
- global_u8bit := b;
- end;
-
- {********************* FUNCTION RESULT WITH PARAMS (NESTED) ******************}
-{ LOC_MEM return values }
-function func_array_mixed_nested(b: byte): tsmallarray;stdcall;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- smallarray: tsmallarray;
- begin
- fillchar(smallarray, sizeof(smallarray), #0);
- smallarray[1] := RESULT_U8BIT;
- smallarray[SMALL_INDEX] := RESULT_U8BIT;
- func_array_mixed_nested := smallarray;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
-{ nested_one_proc(RESULT_S32BIT);}
- end;
-
-function func_largerecord_mixed_nested(b: byte): tlargerecord;stdcall;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- largerecord : tlargerecord;
- begin
- fillchar(largerecord, sizeof(largerecord), #0);
- largerecord.b[1] := RESULT_U8BIT;
- largerecord.b[BIG_INDEX] := RESULT_U8BIT;
- func_largerecord_mixed_nested := largerecord;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_shortstring_mixed_nested(b: byte): shortstring;stdcall;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
- var
- local_b: byte;
- begin
- func_shortstring_mixed_nested := RESULT_BIGSTRING;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_largeset_mixed_nested(b: byte) : tlargeset;stdcall;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- largeset : tlargeset;
- begin
- largeset := ['I'];
- func_largeset_mixed_nested := largeset;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_u8bit_mixed_nested(b: byte) : byte;stdcall;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_u8bit_mixed_nested := RESULT_U8BIT;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_u16bit_mixed_nested(b: byte) : word;stdcall;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_u16bit_mixed_nested := RESULT_U16BIT;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_s32bit_mixed_nested(b: byte) : longint;stdcall;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_s32bit_mixed_nested := RESULT_S32BIT;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_s64bit_mixed_nested(b: byte) : int64;stdcall;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_s64bit_mixed_nested := RESULT_S64BIT;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_s32real_mixed_nested(b: byte) : single;stdcall;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_s32real_mixed_nested := RESULT_S32REAL;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_s64real_mixed_nested(b: byte) : double;stdcall;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_s64real_mixed_nested := RESULT_S64REAl;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_ansistring_mixed_nested(b: byte) : ansistring;stdcall;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_ansistring_mixed_nested := RESULT_BIGSTRING;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_pchar_mixed_nested(b: byte) : pchar;stdcall;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_pchar_mixed_nested := RESULT_PCHAR;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-
-var
- failed: boolean;
-Begin
- {************************************* SIMPLE TESTS ***********************************}
- write('Testing function results (LOC_REFERENCE)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_smallarray := func_array;
- if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
- failed := true;
-
- clear_globals;
- clear_values;
- value_largerec := func_largerecord;
- if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[BIG_INDEX] <> RESULT_U8BIT) then
- failed:=true;
-
- clear_globals;
- clear_values;
- value_bigstring := func_shortstring;
- if value_bigstring <> RESULT_BIGSTRING then
- failed := true;
-
- clear_globals;
- clear_values;
- value_largeset := func_largeset;
- if not ('I' in value_largeset) then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing orddef/enumdef function results (LOC_REGISTER)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
-
- value_u8bit := func_u8bit;
- if value_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_u16bit := func_u16bit;
- if value_u16bit <> RESULT_U16BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s32bit := func_s32bit;
- if value_s32bit <> RESULT_S32BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s64bit := func_s64bit;
- if value_s64bit <> RESULT_S64BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
-
- write('Testing floatdef function results...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- clear_globals;
- clear_values;
- value_s32real := func_s32real;
- if trunc(value_s32real) <> trunc(RESULT_S32REAL) then
- failed:=true;
-
- clear_globals;
- clear_values;
- value_s64real := func_s64real;
- if trunc(value_s64real) <> trunc(RESULT_S64REAL) then
- failed:=true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing ansistring function result...');
-
- clear_globals;
- clear_values;
- failed := false;
-
-
-value_ansistring := func_ansistring;
-if value_ansistring <> RESULT_BIGSTRING then
- failed:=true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing pointer function result (LOC_REGISTER)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_ptr := func_pchar;
- if value_ptr <> RESULT_PCHAR then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- {*********************************** TESTS W/PARAMS ***********************************}
- write('Testing function results with parameter (LOC_REFERENCE)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_smallarray := func_array_mixed(RESULT_U8BIT);
- if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_largerec := func_largerecord_mixed(RESULT_U8BIT);
- if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[BIG_INDEX] <> RESULT_U8BIT) then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_bigstring := func_shortstring_mixed(RESULT_U8BIT);
- if value_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_largeset := func_largeset_mixed(RESULT_U8BIT);
- if not ('I' in value_largeset) then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing orddef/enumdef function results with parameter (LOC_REGISTER)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
-
- value_u8bit := func_u8bit_mixed(RESULT_U8BIT);
- if value_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_u16bit := func_u16bit_mixed(RESULT_U8BIT);
- if value_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s32bit := func_s32bit_mixed(RESULT_U8BIT);
- if value_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s64bit := func_s64bit_mixed(RESULT_U8BIT);
- if value_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
-
- write('Testing floatdef function results with parameter...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_s32real := func_s32real_mixed(RESULT_U8BIT);
- if trunc(value_s32real) <> trunc(RESULT_S32REAL) then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s64real := func_s64real_mixed(RESULT_U8BIT);
- if trunc(value_s64real) <> trunc(RESULT_S64REAL) then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing ansistring function result with parameter...');
-
- clear_globals;
- clear_values;
- failed := false;
-
-
- value_ansistring := func_ansistring_mixed(RESULT_U8BIT);
- if value_ansistring <> RESULT_BIGSTRING then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing pointer function result with parameter (LOC_REGISTER)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_ptr := func_pchar_mixed(RESULT_U8BIT);
- if value_ptr <> RESULT_PCHAR then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- {******************************NESTED TESTS W/PARAMS **********************************}
- write('Testing function (w/nesting) results with parameter (LOC_REFERENCE)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_smallarray := func_array_mixed_nested(RESULT_U8BIT);
- if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_largerec := func_largerecord_mixed_nested(RESULT_U8BIT);
- if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[BIG_INDEX] <> RESULT_U8BIT) then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_bigstring := func_shortstring_mixed_nested(RESULT_U8BIT);
- if value_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_largeset := func_largeset_mixed_nested(RESULT_U8BIT);
- if not ('I' in value_largeset) then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing orddef/enumdef function (w/nesting) results with parameter (LOC_REGISTER)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
-
- value_u8bit := func_u8bit_mixed_nested(RESULT_U8BIT);
- if value_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_u16bit := func_u16bit_mixed_nested(RESULT_U8BIT);
- if value_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s32bit := func_s32bit_mixed_nested(RESULT_U8BIT);
- if value_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s64bit := func_s64bit_mixed_nested(RESULT_U8BIT);
- if value_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
-
- write('Testing floatdef function (w/nesting) results with parameter...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_s32real := func_s32real_mixed_nested(RESULT_U8BIT);
- if trunc(value_s32real) <> trunc(RESULT_S32REAL) then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s64real := func_s64real_mixed_nested(RESULT_U8BIT);
- if trunc(value_s64real) <> trunc(RESULT_S64REAL) then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing ansistring function (w/nesting) result with parameter...');
-
- clear_globals;
- clear_values;
- failed := false;
-
-
- value_ansistring := func_ansistring_mixed_nested(RESULT_U8BIT);
- if value_ansistring <> RESULT_BIGSTRING then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing pointer function (w/nesting) result with parameter (LOC_REGISTER)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_ptr := func_pchar_mixed_nested(RESULT_U8BIT);
- if value_ptr <> RESULT_PCHAR then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-end.
-
-{
+ {****************************************************************}
+ { CODE GENERATOR TEST PROGRAM }
+ { By Carl Eric Codere }
+ {****************************************************************}
+ { NODE TESTED : secondcallparan() }
+ {****************************************************************}
+ { PRE-REQUISITES: secondload() }
+ { secondassign() }
+ { secondtypeconv() }
+ { secondtryexcept() }
+ { secondcalln() }
+ { secondadd() }
+ {****************************************************************}
+ { DEFINES: }
+ { FPC = Target is FreePascal compiler }
+ {****************************************************************}
+ { REMARKS: This tests a subset of the secondcalln() node }
+ { (function return values with stdcall calling cnvs) }
+ { (also tests nested routines up to 2 level deep) }
+ {****************************************************************}
+ program tcalfun7;
+
+ {$ifdef fpc}
+ {$mode objfpc}
+ {$INLINE ON}
+ {$endif}
+ {$R+}
+ {$P-}
+
+{$ifdef VER70}
+ {$define tp}
+{$endif}
+
+
+ { REAL should map to single or double }
+ { so it is not checked, since single }
+ { double nodes are checked. }
+
+ { assumes that enumdef is the same as orddef (same storage format) }
+
+ const
+ { should be defined depending on CPU target }
+{$ifdef fpc}
+ {$ifdef cpu68k}
+ BIG_INDEX = 8000;
+ SMALL_INDEX = 13;
+ {$else}
+ BIG_INDEX = 33000;
+ SMALL_INDEX = 13; { value should not be aligned! }
+ {$endif}
+{$else}
+ BIG_INDEX = 33000;
+ SMALL_INDEX = 13; { value should not be aligned! }
+{$endif}
+ RESULT_U8BIT = $55;
+ RESULT_U16BIT = $500F;
+ RESULT_S32BIT = $500F0000;
+ RESULT_S64BIT = $500F0000;
+ RESULT_S32REAL = 1777.12;
+ RESULT_S64REAL = 3444.24;
+ RESULT_BOOL8BIT = 1;
+ RESULT_BOOL16BIT = 1;
+ RESULT_BOOL32BIT = 1;
+ RESULT_PCHAR = 'Hello world';
+ RESULT_BIGSTRING = 'Hello world';
+ RESULT_SMALLSTRING = 'H';
+ RESULT_CHAR = 'I';
+ RESULT_BOOLEAN = TRUE;
+
+ type
+ {$ifndef tp}
+ tclass1 = class
+ end;
+ {$else}
+ shortstring = string;
+ {$endif}
+
+ tprocedure = procedure;
+
+ tsmallrecord = packed record
+ b: byte;
+ w: word;
+ end;
+
+ tlargerecord = packed record
+ b: array[1..BIG_INDEX] of byte;
+ end;
+
+ tsmallarray = packed array[1..SMALL_INDEX] of byte;
+
+ tsmallsetenum =
+ (A_A,A_B,A_C,A_D);
+
+ tsmallset = set of tsmallsetenum;
+ tlargeset = set of char;
+
+ tsmallstring = string[2];
+
+
+
+
+
+ var
+ global_u8bit : byte;
+ global_u16bit : word;
+ global_s32bit : longint;
+ global_s32real : single;
+ global_s64real : double;
+ global_ptr : pchar;
+ global_proc : tprocedure;
+ global_bigstring : shortstring;
+ global_boolean : boolean;
+ global_char : char;
+ {$ifndef tp}
+ global_class : tclass1;
+ global_s64bit : int64;
+ value_s64bit : int64;
+ value_class : tclass1;
+ {$endif}
+ value_ansistring : ansistring;
+ value_u8bit : byte;
+ value_u16bit : word;
+ value_s32bit : longint;
+ value_s32real : single;
+ value_s64real : double;
+ value_proc : tprocedure;
+ value_ptr : pchar;
+ value_smallrec : tsmallrecord;
+ value_largerec : tlargerecord;
+ value_smallset : tsmallset;
+ value_smallstring : tsmallstring;
+ value_bigstring : shortstring;
+ value_largeset : tlargeset;
+ value_smallarray : tsmallarray;
+ value_boolean : boolean;
+ value_char : char;
+
+ procedure fail;
+ begin
+ WriteLn('Failure.');
+ halt(1);
+ end;
+
+
+ procedure clear_globals;
+ begin
+ global_u8bit := 0;
+ global_u16bit := 0;
+ global_s32bit := 0;
+ global_s32real := 0.0;
+ global_s64real := 0.0;
+ global_ptr := nil;
+ global_proc := nil;
+ global_bigstring := '';
+ global_boolean := false;
+ global_char := #0;
+ global_s64bit := 0;
+ global_class := nil;
+ end;
+
+
+ procedure clear_values;
+ begin
+ value_u8bit := 0;
+ value_u16bit := 0;
+ value_s32bit := 0;
+ value_s32real := 0.0;
+ value_s64real := 0.0;
+ value_proc := nil;
+ value_ptr := nil;
+ fillchar(value_smallrec, sizeof(value_smallrec), #0);
+ fillchar(value_largerec, sizeof(value_largerec), #0);
+ value_smallset := [];
+ value_smallstring := '';
+ value_bigstring := '';
+ value_largeset := [];
+ fillchar(value_smallarray, sizeof(value_smallarray), #0);
+ value_boolean := false;
+ value_char:=#0;
+ value_ansistring := '';
+ {$ifndef tp}
+ value_s64bit := 0;
+ value_class := nil;
+ {$endif}
+ end;
+
+
+
+ {********************************* FUNCTION RESULTS *************************}
+
+{ LOC_MEM return values }
+function func_array: tsmallarray;stdcall;
+ var
+ smallarray: tsmallarray;
+ begin
+ fillchar(smallarray, sizeof(smallarray), #0);
+ smallarray[1] := RESULT_U8BIT;
+ smallarray[SMALL_INDEX] := RESULT_U8BIT;
+ func_array := smallarray;
+ end;
+
+function func_largerecord: tlargerecord;stdcall;
+ var
+ largerecord : tlargerecord;
+ begin
+ fillchar(largerecord, sizeof(largerecord), #0);
+ largerecord.b[1] := RESULT_U8BIT;
+ largerecord.b[BIG_INDEX] := RESULT_U8BIT;
+ func_largerecord := largerecord;
+ end;
+
+function func_shortstring: shortstring;stdcall;
+ begin
+ func_shortstring := RESULT_BIGSTRING;
+ end;
+
+function func_largeset : tlargeset;stdcall;
+ var
+ largeset : tlargeset;
+ begin
+ largeset := ['I'];
+ func_largeset := largeset;
+ end;
+
+function func_u8bit : byte;stdcall;
+ begin
+ func_u8bit := RESULT_U8BIT;
+ end;
+
+function func_u16bit : word;stdcall;
+ begin
+ func_u16bit := RESULT_U16BIT;
+ end;
+
+function func_s32bit : longint;stdcall;
+ begin
+ func_s32bit := RESULT_S32BIT;
+ end;
+
+function func_s64bit : int64;stdcall;
+ begin
+ func_s64bit := RESULT_S64BIT;
+ end;
+
+function func_s32real : single;stdcall;
+ begin
+ func_s32real := RESULT_S32REAL;
+ end;
+
+function func_s64real : double;stdcall;
+ begin
+ func_s64real := RESULT_S64REAl;
+ end;
+
+function func_ansistring : ansistring;stdcall;
+ begin
+ func_ansistring := RESULT_BIGSTRING;
+ end;
+
+function func_pchar : pchar;stdcall;
+ begin
+ func_pchar := RESULT_PCHAR;
+ end;
+
+ {************************** FUNCTION RESULT WITH PARAMS ******************}
+{ LOC_MEM return values }
+function func_array_mixed(b: byte): tsmallarray;stdcall;
+ var
+ local_b: byte;
+ smallarray: tsmallarray;
+ begin
+ fillchar(smallarray, sizeof(smallarray), #0);
+ smallarray[1] := RESULT_U8BIT;
+ smallarray[SMALL_INDEX] := RESULT_U8BIT;
+ func_array_mixed := smallarray;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_largerecord_mixed(b: byte): tlargerecord;stdcall;
+ var
+ local_b: byte;
+ largerecord : tlargerecord;
+ begin
+ fillchar(largerecord, sizeof(largerecord), #0);
+ largerecord.b[1] := RESULT_U8BIT;
+ largerecord.b[BIG_INDEX] := RESULT_U8BIT;
+ func_largerecord_mixed := largerecord;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_shortstring_mixed(b: byte): shortstring;stdcall;
+ var
+ local_b: byte;
+ begin
+ func_shortstring_mixed := RESULT_BIGSTRING;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_largeset_mixed(b: byte) : tlargeset;stdcall;
+ var
+ local_b: byte;
+ largeset : tlargeset;
+ begin
+ largeset := ['I'];
+ func_largeset_mixed := largeset;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_u8bit_mixed(b: byte) : byte;stdcall;
+ var
+ local_b: byte;
+ begin
+ func_u8bit_mixed := RESULT_U8BIT;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_u16bit_mixed(b: byte) : word;stdcall;
+ var
+ local_b: byte;
+ begin
+ func_u16bit_mixed := RESULT_U16BIT;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_s32bit_mixed(b: byte) : longint;stdcall;
+ var
+ local_b: byte;
+ begin
+ func_s32bit_mixed := RESULT_S32BIT;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_s64bit_mixed(b: byte) : int64;stdcall;
+ var
+ local_b: byte;
+ begin
+ func_s64bit_mixed := RESULT_S64BIT;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_s32real_mixed(b: byte) : single;stdcall;
+ var
+ local_b: byte;
+ begin
+ func_s32real_mixed := RESULT_S32REAL;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_s64real_mixed(b: byte) : double;stdcall;
+ var
+ local_b: byte;
+ begin
+ func_s64real_mixed := RESULT_S64REAl;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_ansistring_mixed(b: byte) : ansistring;stdcall;
+ var
+ local_b: byte;
+ begin
+ func_ansistring_mixed := RESULT_BIGSTRING;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_pchar_mixed(b: byte) : pchar;stdcall;
+ var
+ local_b: byte;
+ begin
+ func_pchar_mixed := RESULT_PCHAR;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+ {********************* FUNCTION RESULT WITH PARAMS (NESTED) ******************}
+{ LOC_MEM return values }
+function func_array_mixed_nested(b: byte): tsmallarray;stdcall;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ smallarray: tsmallarray;
+ begin
+ fillchar(smallarray, sizeof(smallarray), #0);
+ smallarray[1] := RESULT_U8BIT;
+ smallarray[SMALL_INDEX] := RESULT_U8BIT;
+ func_array_mixed_nested := smallarray;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+{ nested_one_proc(RESULT_S32BIT);}
+ end;
+
+function func_largerecord_mixed_nested(b: byte): tlargerecord;stdcall;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ largerecord : tlargerecord;
+ begin
+ fillchar(largerecord, sizeof(largerecord), #0);
+ largerecord.b[1] := RESULT_U8BIT;
+ largerecord.b[BIG_INDEX] := RESULT_U8BIT;
+ func_largerecord_mixed_nested := largerecord;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_shortstring_mixed_nested(b: byte): shortstring;stdcall;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+ var
+ local_b: byte;
+ begin
+ func_shortstring_mixed_nested := RESULT_BIGSTRING;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_largeset_mixed_nested(b: byte) : tlargeset;stdcall;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ largeset : tlargeset;
+ begin
+ largeset := ['I'];
+ func_largeset_mixed_nested := largeset;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_u8bit_mixed_nested(b: byte) : byte;stdcall;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_u8bit_mixed_nested := RESULT_U8BIT;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_u16bit_mixed_nested(b: byte) : word;stdcall;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_u16bit_mixed_nested := RESULT_U16BIT;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_s32bit_mixed_nested(b: byte) : longint;stdcall;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_s32bit_mixed_nested := RESULT_S32BIT;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_s64bit_mixed_nested(b: byte) : int64;stdcall;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_s64bit_mixed_nested := RESULT_S64BIT;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_s32real_mixed_nested(b: byte) : single;stdcall;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_s32real_mixed_nested := RESULT_S32REAL;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_s64real_mixed_nested(b: byte) : double;stdcall;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_s64real_mixed_nested := RESULT_S64REAl;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_ansistring_mixed_nested(b: byte) : ansistring;stdcall;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_ansistring_mixed_nested := RESULT_BIGSTRING;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_pchar_mixed_nested(b: byte) : pchar;stdcall;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_pchar_mixed_nested := RESULT_PCHAR;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+
+var
+ failed: boolean;
+Begin
+ {************************************* SIMPLE TESTS ***********************************}
+ write('Testing function results (LOC_REFERENCE)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_smallarray := func_array;
+ if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_largerec := func_largerecord;
+ if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[BIG_INDEX] <> RESULT_U8BIT) then
+ failed:=true;
+
+ clear_globals;
+ clear_values;
+ value_bigstring := func_shortstring;
+ if value_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_largeset := func_largeset;
+ if not ('I' in value_largeset) then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing orddef/enumdef function results (LOC_REGISTER)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+
+ value_u8bit := func_u8bit;
+ if value_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_u16bit := func_u16bit;
+ if value_u16bit <> RESULT_U16BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s32bit := func_s32bit;
+ if value_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s64bit := func_s64bit;
+ if value_s64bit <> RESULT_S64BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+
+ write('Testing floatdef function results...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ clear_globals;
+ clear_values;
+ value_s32real := func_s32real;
+ if trunc(value_s32real) <> trunc(RESULT_S32REAL) then
+ failed:=true;
+
+ clear_globals;
+ clear_values;
+ value_s64real := func_s64real;
+ if trunc(value_s64real) <> trunc(RESULT_S64REAL) then
+ failed:=true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing ansistring function result...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+
+value_ansistring := func_ansistring;
+if value_ansistring <> RESULT_BIGSTRING then
+ failed:=true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing pointer function result (LOC_REGISTER)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_ptr := func_pchar;
+ if value_ptr <> RESULT_PCHAR then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ {*********************************** TESTS W/PARAMS ***********************************}
+ write('Testing function results with parameter (LOC_REFERENCE)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_smallarray := func_array_mixed(RESULT_U8BIT);
+ if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_largerec := func_largerecord_mixed(RESULT_U8BIT);
+ if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[BIG_INDEX] <> RESULT_U8BIT) then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_bigstring := func_shortstring_mixed(RESULT_U8BIT);
+ if value_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_largeset := func_largeset_mixed(RESULT_U8BIT);
+ if not ('I' in value_largeset) then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing orddef/enumdef function results with parameter (LOC_REGISTER)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+
+ value_u8bit := func_u8bit_mixed(RESULT_U8BIT);
+ if value_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_u16bit := func_u16bit_mixed(RESULT_U8BIT);
+ if value_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s32bit := func_s32bit_mixed(RESULT_U8BIT);
+ if value_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s64bit := func_s64bit_mixed(RESULT_U8BIT);
+ if value_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+
+ write('Testing floatdef function results with parameter...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_s32real := func_s32real_mixed(RESULT_U8BIT);
+ if trunc(value_s32real) <> trunc(RESULT_S32REAL) then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s64real := func_s64real_mixed(RESULT_U8BIT);
+ if trunc(value_s64real) <> trunc(RESULT_S64REAL) then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing ansistring function result with parameter...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+
+ value_ansistring := func_ansistring_mixed(RESULT_U8BIT);
+ if value_ansistring <> RESULT_BIGSTRING then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing pointer function result with parameter (LOC_REGISTER)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_ptr := func_pchar_mixed(RESULT_U8BIT);
+ if value_ptr <> RESULT_PCHAR then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ {******************************NESTED TESTS W/PARAMS **********************************}
+ write('Testing function (w/nesting) results with parameter (LOC_REFERENCE)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_smallarray := func_array_mixed_nested(RESULT_U8BIT);
+ if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_largerec := func_largerecord_mixed_nested(RESULT_U8BIT);
+ if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[BIG_INDEX] <> RESULT_U8BIT) then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_bigstring := func_shortstring_mixed_nested(RESULT_U8BIT);
+ if value_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_largeset := func_largeset_mixed_nested(RESULT_U8BIT);
+ if not ('I' in value_largeset) then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing orddef/enumdef function (w/nesting) results with parameter (LOC_REGISTER)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+
+ value_u8bit := func_u8bit_mixed_nested(RESULT_U8BIT);
+ if value_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_u16bit := func_u16bit_mixed_nested(RESULT_U8BIT);
+ if value_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s32bit := func_s32bit_mixed_nested(RESULT_U8BIT);
+ if value_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s64bit := func_s64bit_mixed_nested(RESULT_U8BIT);
+ if value_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+
+ write('Testing floatdef function (w/nesting) results with parameter...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_s32real := func_s32real_mixed_nested(RESULT_U8BIT);
+ if trunc(value_s32real) <> trunc(RESULT_S32REAL) then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s64real := func_s64real_mixed_nested(RESULT_U8BIT);
+ if trunc(value_s64real) <> trunc(RESULT_S64REAL) then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing ansistring function (w/nesting) result with parameter...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+
+ value_ansistring := func_ansistring_mixed_nested(RESULT_U8BIT);
+ if value_ansistring <> RESULT_BIGSTRING then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing pointer function (w/nesting) result with parameter (LOC_REGISTER)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_ptr := func_pchar_mixed_nested(RESULT_U8BIT);
+ if value_ptr <> RESULT_PCHAR then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+end.
+
+{
$Log$
- Revision 1.4 2003-04-22 10:24:29 florian
+ Revision 1.5 2004-05-02 12:11:44 peter
+ * fixed linefeeds
+
+ Revision 1.4 2003/04/22 10:24:29 florian
* fixed defines for powerpc
-
- Revision 1.3 2002/09/07 15:40:51 peter
- * old logs removed and tabs fixed
-
- Revision 1.2 2002/05/13 13:45:36 peter
- * updated to compile tests with kylix
-
- Revision 1.1 2002/04/13 07:45:49 carl
- + Function calling tests , for different calling conventions.
-
-}
+
+ Revision 1.3 2002/09/07 15:40:51 peter
+ * old logs removed and tabs fixed
+
+ Revision 1.2 2002/05/13 13:45:36 peter
+ * updated to compile tests with kylix
+
+ Revision 1.1 2002/04/13 07:45:49 carl
+ + Function calling tests , for different calling conventions.
+
+}
diff --git a/tests/test/cg/tcalfun9.pp b/tests/test/cg/tcalfun9.pp
index 29e1c338e1..5bfc0b6808 100644
--- a/tests/test/cg/tcalfun9.pp
+++ b/tests/test/cg/tcalfun9.pp
@@ -1,1447 +1,1450 @@
- {****************************************************************}
- { CODE GENERATOR TEST PROGRAM }
- { By Carl Eric Codere }
- {****************************************************************}
- { NODE TESTED : secondcallparan() }
- {****************************************************************}
- { PRE-REQUISITES: secondload() }
- { secondassign() }
- { secondtypeconv() }
- { secondtryexcept() }
- { secondcalln() }
- { secondadd() }
- {****************************************************************}
- { DEFINES: }
- { FPC = Target is FreePascal compiler }
- {****************************************************************}
- { REMARKS: This tests a subset of the secondcalln() node }
- { (function return values with saveregs calling cnvs) }
- { (also tests nested routines up to 2 level deep) }
- {****************************************************************}
- program tcalfun9;
-
- {$ifdef fpc}
- {$mode objfpc}
- {$INLINE ON}
- {$endif}
- {$R+}
- {$P-}
-
-{$ifdef VER70}
- {$define tp}
-{$endif}
-
-
- { REAL should map to single or double }
- { so it is not checked, since single }
- { double nodes are checked. }
-
- { assumes that enumdef is the same as orddef (same storage format) }
-
- const
- { should be defined depending on CPU target }
-{$ifdef fpc}
- {$ifdef cpu68k}
- BIG_INDEX = 12000;
- MEDIUM_INDEX = 5000;
- SMALL_INDEX = 13;
- {$else}
- BIG_INDEX = 33000;
- MEDIUM_INDEX = 5000;
- SMALL_INDEX = 13; { value should not be aligned! }
- {$endif}
-{$else}
- BIG_INDEX = 33000;
- MEDIUM_INDEX = 5000;
- SMALL_INDEX = 13; { value should not be aligned! }
-{$endif}
- RESULT_U8BIT = $55;
- RESULT_U16BIT = $500F;
- RESULT_S32BIT = $500F0000;
- RESULT_S64BIT = $500F0000;
- RESULT_S32REAL = 1777.12;
- RESULT_S64REAL = 3444.24;
- RESULT_BOOL8BIT = 1;
- RESULT_BOOL16BIT = 1;
- RESULT_BOOL32BIT = 1;
- RESULT_PCHAR = 'Hello world';
- RESULT_BIGSTRING = 'Hello world';
- RESULT_SMALLSTRING = 'H';
- RESULT_CHAR = 'I';
- RESULT_BOOLEAN = TRUE;
-
- type
- {$ifndef tp}
- tclass1 = class
- end;
- {$else}
- shortstring = string;
- {$endif}
-
- tprocedure = procedure;
-
- tsmallrecord = packed record
- b: byte;
- w: word;
- end;
-
- tlargerecord = packed record
- b: array[1..BIG_INDEX] of byte;
- end;
-
- tmediumrecord = packed record
- b: array[1..MEDIUM_INDEX] of byte;
- end;
-
- tsmallarray = packed array[1..SMALL_INDEX] of byte;
-
- tsmallsetenum =
- (A_A,A_B,A_C,A_D);
-
- tsmallset = set of tsmallsetenum;
- tlargeset = set of char;
-
- tsmallstring = string[2];
-
-
-
-
-
- var
- global_u8bit : byte;
- global_u16bit : word;
- global_s32bit : longint;
- global_s32real : single;
- global_s64real : double;
- global_ptr : pchar;
- global_proc : tprocedure;
- global_bigstring : shortstring;
- global_boolean : boolean;
- global_char : char;
- {$ifndef tp}
- global_class : tclass1;
- global_s64bit : int64;
- value_s64bit : int64;
- value_class : tclass1;
- {$endif}
- value_ansistring : ansistring;
- value_u8bit : byte;
- value_u16bit : word;
- value_s32bit : longint;
- value_s32real : single;
- value_s64real : double;
- value_proc : tprocedure;
- value_ptr : pchar;
- value_smallrec : tsmallrecord;
- value_largerec : tlargerecord;
- value_mediumrec : tmediumrecord;
- value_smallset : tsmallset;
- value_smallstring : tsmallstring;
- value_bigstring : shortstring;
- value_largeset : tlargeset;
- value_smallarray : tsmallarray;
- value_boolean : boolean;
- value_char : char;
-
- procedure fail;
- begin
- WriteLn('Failure.');
- halt(1);
- end;
-
-
- procedure clear_globals;
- begin
- global_u8bit := 0;
- global_u16bit := 0;
- global_s32bit := 0;
- global_s32real := 0.0;
- global_s64real := 0.0;
- global_ptr := nil;
- global_proc := nil;
- global_bigstring := '';
- global_boolean := false;
- global_char := #0;
- global_s64bit := 0;
- global_class := nil;
- end;
-
-
- procedure clear_values;
- begin
- value_u8bit := 0;
- value_u16bit := 0;
- value_s32bit := 0;
- value_s32real := 0.0;
- value_s64real := 0.0;
- value_proc := nil;
- value_ptr := nil;
- fillchar(value_smallrec, sizeof(value_smallrec), #0);
- fillchar(value_largerec, sizeof(value_largerec), #0);
- fillchar(value_mediumrec, sizeof(value_mediumrec), #0);
- value_smallset := [];
- value_smallstring := '';
- value_bigstring := '';
- value_largeset := [];
- fillchar(value_smallarray, sizeof(value_smallarray), #0);
- value_boolean := false;
- value_char:=#0;
- value_ansistring := '';
- {$ifndef tp}
- value_s64bit := 0;
- value_class := nil;
- {$endif}
- end;
-
-
-
- {********************************* FUNCTION RESULTS *************************}
-
-{ LOC_MEM return values }
-function func_array: tsmallarray;saveregisters;
- var
- smallarray: tsmallarray;
- begin
- fillchar(smallarray, sizeof(smallarray), #0);
- smallarray[1] := RESULT_U8BIT;
- smallarray[SMALL_INDEX] := RESULT_U8BIT;
- func_array := smallarray;
- end;
-
-function func_largerecord: tlargerecord;saveregisters;
- var
- largerecord : tlargerecord;
- begin
- fillchar(largerecord, sizeof(largerecord), #0);
- largerecord.b[1] := RESULT_U8BIT;
- largerecord.b[BIG_INDEX] := RESULT_U8BIT;
- func_largerecord := largerecord;
- end;
-
-function func_mediumrecord: tmediumrecord;saveregisters;
- var
- mediumrecord : tmediumrecord;
- begin
- fillchar(mediumrecord, sizeof(mediumrecord), #0);
- mediumrecord.b[1] := RESULT_U8BIT;
- mediumrecord.b[MEDIUM_INDEX] := RESULT_U8BIT;
- func_mediumrecord := mediumrecord;
- end;
-
-
-function func_shortstring: shortstring;saveregisters;
- begin
- func_shortstring := RESULT_BIGSTRING;
- end;
-
-function func_largeset : tlargeset;saveregisters;
- var
- largeset : tlargeset;
- begin
- largeset := ['I'];
- func_largeset := largeset;
- end;
-
-function func_u8bit : byte;saveregisters;
- begin
- func_u8bit := RESULT_U8BIT;
- end;
-
-function func_u16bit : word;saveregisters;
- begin
- func_u16bit := RESULT_U16BIT;
- end;
-
-function func_s32bit : longint;saveregisters;
- begin
- func_s32bit := RESULT_S32BIT;
- end;
-
-function func_s64bit : int64;saveregisters;
- begin
- func_s64bit := RESULT_S64BIT;
- end;
-
-function func_s32real : single;saveregisters;
- begin
- func_s32real := RESULT_S32REAL;
- end;
-
-function func_s64real : double;saveregisters;
- begin
- func_s64real := RESULT_S64REAl;
- end;
-
-function func_ansistring : ansistring;saveregisters;
- begin
- func_ansistring := RESULT_BIGSTRING;
- end;
-
-function func_pchar : pchar;saveregisters;
- begin
- func_pchar := RESULT_PCHAR;
- end;
-
- {************************** FUNCTION RESULT WITH PARAMS ******************}
-{ LOC_MEM return values }
-function func_array_mixed(b: byte): tsmallarray;saveregisters;
- var
- local_b: byte;
- smallarray: tsmallarray;
- begin
- fillchar(smallarray, sizeof(smallarray), #0);
- smallarray[1] := RESULT_U8BIT;
- smallarray[SMALL_INDEX] := RESULT_U8BIT;
- func_array_mixed := smallarray;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_largerecord_mixed(b: byte): tlargerecord;saveregisters;
- var
- local_b: byte;
- largerecord : tlargerecord;
- begin
- fillchar(largerecord, sizeof(largerecord), #0);
- largerecord.b[1] := RESULT_U8BIT;
- largerecord.b[BIG_INDEX] := RESULT_U8BIT;
- func_largerecord_mixed := largerecord;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_shortstring_mixed(b: byte): shortstring;saveregisters;
- var
- local_b: byte;
- begin
- func_shortstring_mixed := RESULT_BIGSTRING;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_largeset_mixed(b: byte) : tlargeset;saveregisters;
- var
- local_b: byte;
- largeset : tlargeset;
- begin
- largeset := ['I'];
- func_largeset_mixed := largeset;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_u8bit_mixed(b: byte) : byte;saveregisters;
- var
- local_b: byte;
- begin
- func_u8bit_mixed := RESULT_U8BIT;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_u16bit_mixed(b: byte) : word;saveregisters;
- var
- local_b: byte;
- begin
- func_u16bit_mixed := RESULT_U16BIT;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_s32bit_mixed(b: byte) : longint;saveregisters;
- var
- local_b: byte;
- begin
- func_s32bit_mixed := RESULT_S32BIT;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_s64bit_mixed(b: byte) : int64;saveregisters;
- var
- local_b: byte;
- begin
- func_s64bit_mixed := RESULT_S64BIT;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_s32real_mixed(b: byte) : single;saveregisters;
- var
- local_b: byte;
- begin
- func_s32real_mixed := RESULT_S32REAL;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_s64real_mixed(b: byte) : double;saveregisters;
- var
- local_b: byte;
- begin
- func_s64real_mixed := RESULT_S64REAl;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_ansistring_mixed(b: byte) : ansistring;saveregisters;
- var
- local_b: byte;
- begin
- func_ansistring_mixed := RESULT_BIGSTRING;
- local_b:=b;
- global_u8bit := b;
- end;
-
-function func_pchar_mixed(b: byte) : pchar;saveregisters;
- var
- local_b: byte;
- begin
- func_pchar_mixed := RESULT_PCHAR;
- local_b:=b;
- global_u8bit := b;
- end;
-
- {********************* FUNCTION RESULT WITH PARAMS (NESTED) ******************}
-{ LOC_MEM return values }
-function func_array_mixed_nested(b: byte): tsmallarray;saveregisters;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- smallarray: tsmallarray;
- begin
- fillchar(smallarray, sizeof(smallarray), #0);
- smallarray[1] := RESULT_U8BIT;
- smallarray[SMALL_INDEX] := RESULT_U8BIT;
- func_array_mixed_nested := smallarray;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
-{ nested_one_proc(RESULT_S32BIT);}
- end;
-
-function func_largerecord_mixed_nested(b: byte): tlargerecord;saveregisters;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- largerecord : tlargerecord;
- begin
- fillchar(largerecord, sizeof(largerecord), #0);
- largerecord.b[1] := RESULT_U8BIT;
- largerecord.b[BIG_INDEX] := RESULT_U8BIT;
- func_largerecord_mixed_nested := largerecord;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_shortstring_mixed_nested(b: byte): shortstring;saveregisters;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
- var
- local_b: byte;
- begin
- func_shortstring_mixed_nested := RESULT_BIGSTRING;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_largeset_mixed_nested(b: byte) : tlargeset;saveregisters;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- largeset : tlargeset;
- begin
- largeset := ['I'];
- func_largeset_mixed_nested := largeset;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_u8bit_mixed_nested(b: byte) : byte;saveregisters;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_u8bit_mixed_nested := RESULT_U8BIT;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_u16bit_mixed_nested(b: byte) : word;saveregisters;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_u16bit_mixed_nested := RESULT_U16BIT;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_s32bit_mixed_nested(b: byte) : longint;saveregisters;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_s32bit_mixed_nested := RESULT_S32BIT;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_s64bit_mixed_nested(b: byte) : int64;saveregisters;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_s64bit_mixed_nested := RESULT_S64BIT;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_s32real_mixed_nested(b: byte) : single;saveregisters;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_s32real_mixed_nested := RESULT_S32REAL;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_s64real_mixed_nested(b: byte) : double;saveregisters;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_s64real_mixed_nested := RESULT_S64REAl;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_ansistring_mixed_nested(b: byte) : ansistring;saveregisters;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_ansistring_mixed_nested := RESULT_BIGSTRING;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-function func_pchar_mixed_nested(b: byte) : pchar;saveregisters;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := b;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- begin
- func_pchar_mixed_nested := RESULT_PCHAR;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
- end;
-
-
-var
- failed: boolean;
-Begin
- {************************************* SIMPLE TESTS ***********************************}
- write('Testing function results (LOC_REFERENCE)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_smallarray := func_array;
- if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
- failed := true;
-
- clear_globals;
- clear_values;
- value_largerec := func_largerecord;
- if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[BIG_INDEX] <> RESULT_U8BIT) then
- failed:=true;
-
- clear_globals;
- clear_values;
- value_mediumrec := func_mediumrecord;
- if (value_mediumrec.b[1] <> RESULT_U8BIT) or (value_mediumrec.b[MEDIUM_INDEX] <> RESULT_U8BIT) then
- failed:=true;
-
-
- clear_globals;
- clear_values;
- value_bigstring := func_shortstring;
- if value_bigstring <> RESULT_BIGSTRING then
- failed := true;
-
- clear_globals;
- clear_values;
- value_largeset := func_largeset;
- if not ('I' in value_largeset) then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing orddef/enumdef function results (LOC_REGISTER)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
-
- value_u8bit := func_u8bit;
- if value_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_u16bit := func_u16bit;
- if value_u16bit <> RESULT_U16BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s32bit := func_s32bit;
- if value_s32bit <> RESULT_S32BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s64bit := func_s64bit;
- if value_s64bit <> RESULT_S64BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
-
- write('Testing floatdef function results...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- clear_globals;
- clear_values;
- value_s32real := func_s32real;
- if trunc(value_s32real) <> trunc(RESULT_S32REAL) then
- failed:=true;
-
- clear_globals;
- clear_values;
- value_s64real := func_s64real;
- if trunc(value_s64real) <> trunc(RESULT_S64REAL) then
- failed:=true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing ansistring function result...');
-
- clear_globals;
- clear_values;
- failed := false;
-
-
-value_ansistring := func_ansistring;
-if value_ansistring <> RESULT_BIGSTRING then
- failed:=true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing pointer function result (LOC_REGISTER)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_ptr := func_pchar;
- if value_ptr <> RESULT_PCHAR then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- {*********************************** TESTS W/PARAMS ***********************************}
- write('Testing function results with parameter (LOC_REFERENCE)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_smallarray := func_array_mixed(RESULT_U8BIT);
- if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_largerec := func_largerecord_mixed(RESULT_U8BIT);
- if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[BIG_INDEX] <> RESULT_U8BIT) then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_bigstring := func_shortstring_mixed(RESULT_U8BIT);
- if value_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_largeset := func_largeset_mixed(RESULT_U8BIT);
- if not ('I' in value_largeset) then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing orddef/enumdef function results with parameter (LOC_REGISTER)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
-
- value_u8bit := func_u8bit_mixed(RESULT_U8BIT);
- if value_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_u16bit := func_u16bit_mixed(RESULT_U8BIT);
- if value_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s32bit := func_s32bit_mixed(RESULT_U8BIT);
- if value_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s64bit := func_s64bit_mixed(RESULT_U8BIT);
- if value_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
-
- write('Testing floatdef function results with parameter...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_s32real := func_s32real_mixed(RESULT_U8BIT);
- if trunc(value_s32real) <> trunc(RESULT_S32REAL) then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s64real := func_s64real_mixed(RESULT_U8BIT);
- if trunc(value_s64real) <> trunc(RESULT_S64REAL) then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing ansistring function result with parameter...');
-
- clear_globals;
- clear_values;
- failed := false;
-
-
- value_ansistring := func_ansistring_mixed(RESULT_U8BIT);
- if value_ansistring <> RESULT_BIGSTRING then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing pointer function result with parameter (LOC_REGISTER)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_ptr := func_pchar_mixed(RESULT_U8BIT);
- if value_ptr <> RESULT_PCHAR then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- {******************************NESTED TESTS W/PARAMS **********************************}
- write('Testing function (w/nesting) results with parameter (LOC_REFERENCE)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_smallarray := func_array_mixed_nested(RESULT_U8BIT);
- if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_largerec := func_largerecord_mixed_nested(RESULT_U8BIT);
- if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[BIG_INDEX] <> RESULT_U8BIT) then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_bigstring := func_shortstring_mixed_nested(RESULT_U8BIT);
- if value_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_largeset := func_largeset_mixed_nested(RESULT_U8BIT);
- if not ('I' in value_largeset) then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing orddef/enumdef function (w/nesting) results with parameter (LOC_REGISTER)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
-
- value_u8bit := func_u8bit_mixed_nested(RESULT_U8BIT);
- if value_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_u16bit := func_u16bit_mixed_nested(RESULT_U8BIT);
- if value_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s32bit := func_s32bit_mixed_nested(RESULT_U8BIT);
- if value_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s64bit := func_s64bit_mixed_nested(RESULT_U8BIT);
- if value_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
-
- write('Testing floatdef function (w/nesting) results with parameter...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_s32real := func_s32real_mixed_nested(RESULT_U8BIT);
- if trunc(value_s32real) <> trunc(RESULT_S32REAL) then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- value_s64real := func_s64real_mixed_nested(RESULT_U8BIT);
- if trunc(value_s64real) <> trunc(RESULT_S64REAL) then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing ansistring function (w/nesting) result with parameter...');
-
- clear_globals;
- clear_values;
- failed := false;
-
-
- value_ansistring := func_ansistring_mixed_nested(RESULT_U8BIT);
- if value_ansistring <> RESULT_BIGSTRING then
- failed:=true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- write('Testing pointer function (w/nesting) result with parameter (LOC_REGISTER)...');
-
- clear_globals;
- clear_values;
- failed := false;
-
- value_ptr := func_pchar_mixed_nested(RESULT_U8BIT);
- if value_ptr <> RESULT_PCHAR then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-end.
-
-{
+ {****************************************************************}
+ { CODE GENERATOR TEST PROGRAM }
+ { By Carl Eric Codere }
+ {****************************************************************}
+ { NODE TESTED : secondcallparan() }
+ {****************************************************************}
+ { PRE-REQUISITES: secondload() }
+ { secondassign() }
+ { secondtypeconv() }
+ { secondtryexcept() }
+ { secondcalln() }
+ { secondadd() }
+ {****************************************************************}
+ { DEFINES: }
+ { FPC = Target is FreePascal compiler }
+ {****************************************************************}
+ { REMARKS: This tests a subset of the secondcalln() node }
+ { (function return values with saveregs calling cnvs) }
+ { (also tests nested routines up to 2 level deep) }
+ {****************************************************************}
+ program tcalfun9;
+
+ {$ifdef fpc}
+ {$mode objfpc}
+ {$INLINE ON}
+ {$endif}
+ {$R+}
+ {$P-}
+
+{$ifdef VER70}
+ {$define tp}
+{$endif}
+
+
+ { REAL should map to single or double }
+ { so it is not checked, since single }
+ { double nodes are checked. }
+
+ { assumes that enumdef is the same as orddef (same storage format) }
+
+ const
+ { should be defined depending on CPU target }
+{$ifdef fpc}
+ {$ifdef cpu68k}
+ BIG_INDEX = 12000;
+ MEDIUM_INDEX = 5000;
+ SMALL_INDEX = 13;
+ {$else}
+ BIG_INDEX = 33000;
+ MEDIUM_INDEX = 5000;
+ SMALL_INDEX = 13; { value should not be aligned! }
+ {$endif}
+{$else}
+ BIG_INDEX = 33000;
+ MEDIUM_INDEX = 5000;
+ SMALL_INDEX = 13; { value should not be aligned! }
+{$endif}
+ RESULT_U8BIT = $55;
+ RESULT_U16BIT = $500F;
+ RESULT_S32BIT = $500F0000;
+ RESULT_S64BIT = $500F0000;
+ RESULT_S32REAL = 1777.12;
+ RESULT_S64REAL = 3444.24;
+ RESULT_BOOL8BIT = 1;
+ RESULT_BOOL16BIT = 1;
+ RESULT_BOOL32BIT = 1;
+ RESULT_PCHAR = 'Hello world';
+ RESULT_BIGSTRING = 'Hello world';
+ RESULT_SMALLSTRING = 'H';
+ RESULT_CHAR = 'I';
+ RESULT_BOOLEAN = TRUE;
+
+ type
+ {$ifndef tp}
+ tclass1 = class
+ end;
+ {$else}
+ shortstring = string;
+ {$endif}
+
+ tprocedure = procedure;
+
+ tsmallrecord = packed record
+ b: byte;
+ w: word;
+ end;
+
+ tlargerecord = packed record
+ b: array[1..BIG_INDEX] of byte;
+ end;
+
+ tmediumrecord = packed record
+ b: array[1..MEDIUM_INDEX] of byte;
+ end;
+
+ tsmallarray = packed array[1..SMALL_INDEX] of byte;
+
+ tsmallsetenum =
+ (A_A,A_B,A_C,A_D);
+
+ tsmallset = set of tsmallsetenum;
+ tlargeset = set of char;
+
+ tsmallstring = string[2];
+
+
+
+
+
+ var
+ global_u8bit : byte;
+ global_u16bit : word;
+ global_s32bit : longint;
+ global_s32real : single;
+ global_s64real : double;
+ global_ptr : pchar;
+ global_proc : tprocedure;
+ global_bigstring : shortstring;
+ global_boolean : boolean;
+ global_char : char;
+ {$ifndef tp}
+ global_class : tclass1;
+ global_s64bit : int64;
+ value_s64bit : int64;
+ value_class : tclass1;
+ {$endif}
+ value_ansistring : ansistring;
+ value_u8bit : byte;
+ value_u16bit : word;
+ value_s32bit : longint;
+ value_s32real : single;
+ value_s64real : double;
+ value_proc : tprocedure;
+ value_ptr : pchar;
+ value_smallrec : tsmallrecord;
+ value_largerec : tlargerecord;
+ value_mediumrec : tmediumrecord;
+ value_smallset : tsmallset;
+ value_smallstring : tsmallstring;
+ value_bigstring : shortstring;
+ value_largeset : tlargeset;
+ value_smallarray : tsmallarray;
+ value_boolean : boolean;
+ value_char : char;
+
+ procedure fail;
+ begin
+ WriteLn('Failure.');
+ halt(1);
+ end;
+
+
+ procedure clear_globals;
+ begin
+ global_u8bit := 0;
+ global_u16bit := 0;
+ global_s32bit := 0;
+ global_s32real := 0.0;
+ global_s64real := 0.0;
+ global_ptr := nil;
+ global_proc := nil;
+ global_bigstring := '';
+ global_boolean := false;
+ global_char := #0;
+ global_s64bit := 0;
+ global_class := nil;
+ end;
+
+
+ procedure clear_values;
+ begin
+ value_u8bit := 0;
+ value_u16bit := 0;
+ value_s32bit := 0;
+ value_s32real := 0.0;
+ value_s64real := 0.0;
+ value_proc := nil;
+ value_ptr := nil;
+ fillchar(value_smallrec, sizeof(value_smallrec), #0);
+ fillchar(value_largerec, sizeof(value_largerec), #0);
+ fillchar(value_mediumrec, sizeof(value_mediumrec), #0);
+ value_smallset := [];
+ value_smallstring := '';
+ value_bigstring := '';
+ value_largeset := [];
+ fillchar(value_smallarray, sizeof(value_smallarray), #0);
+ value_boolean := false;
+ value_char:=#0;
+ value_ansistring := '';
+ {$ifndef tp}
+ value_s64bit := 0;
+ value_class := nil;
+ {$endif}
+ end;
+
+
+
+ {********************************* FUNCTION RESULTS *************************}
+
+{ LOC_MEM return values }
+function func_array: tsmallarray;saveregisters;
+ var
+ smallarray: tsmallarray;
+ begin
+ fillchar(smallarray, sizeof(smallarray), #0);
+ smallarray[1] := RESULT_U8BIT;
+ smallarray[SMALL_INDEX] := RESULT_U8BIT;
+ func_array := smallarray;
+ end;
+
+function func_largerecord: tlargerecord;saveregisters;
+ var
+ largerecord : tlargerecord;
+ begin
+ fillchar(largerecord, sizeof(largerecord), #0);
+ largerecord.b[1] := RESULT_U8BIT;
+ largerecord.b[BIG_INDEX] := RESULT_U8BIT;
+ func_largerecord := largerecord;
+ end;
+
+function func_mediumrecord: tmediumrecord;saveregisters;
+ var
+ mediumrecord : tmediumrecord;
+ begin
+ fillchar(mediumrecord, sizeof(mediumrecord), #0);
+ mediumrecord.b[1] := RESULT_U8BIT;
+ mediumrecord.b[MEDIUM_INDEX] := RESULT_U8BIT;
+ func_mediumrecord := mediumrecord;
+ end;
+
+
+function func_shortstring: shortstring;saveregisters;
+ begin
+ func_shortstring := RESULT_BIGSTRING;
+ end;
+
+function func_largeset : tlargeset;saveregisters;
+ var
+ largeset : tlargeset;
+ begin
+ largeset := ['I'];
+ func_largeset := largeset;
+ end;
+
+function func_u8bit : byte;saveregisters;
+ begin
+ func_u8bit := RESULT_U8BIT;
+ end;
+
+function func_u16bit : word;saveregisters;
+ begin
+ func_u16bit := RESULT_U16BIT;
+ end;
+
+function func_s32bit : longint;saveregisters;
+ begin
+ func_s32bit := RESULT_S32BIT;
+ end;
+
+function func_s64bit : int64;saveregisters;
+ begin
+ func_s64bit := RESULT_S64BIT;
+ end;
+
+function func_s32real : single;saveregisters;
+ begin
+ func_s32real := RESULT_S32REAL;
+ end;
+
+function func_s64real : double;saveregisters;
+ begin
+ func_s64real := RESULT_S64REAl;
+ end;
+
+function func_ansistring : ansistring;saveregisters;
+ begin
+ func_ansistring := RESULT_BIGSTRING;
+ end;
+
+function func_pchar : pchar;saveregisters;
+ begin
+ func_pchar := RESULT_PCHAR;
+ end;
+
+ {************************** FUNCTION RESULT WITH PARAMS ******************}
+{ LOC_MEM return values }
+function func_array_mixed(b: byte): tsmallarray;saveregisters;
+ var
+ local_b: byte;
+ smallarray: tsmallarray;
+ begin
+ fillchar(smallarray, sizeof(smallarray), #0);
+ smallarray[1] := RESULT_U8BIT;
+ smallarray[SMALL_INDEX] := RESULT_U8BIT;
+ func_array_mixed := smallarray;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_largerecord_mixed(b: byte): tlargerecord;saveregisters;
+ var
+ local_b: byte;
+ largerecord : tlargerecord;
+ begin
+ fillchar(largerecord, sizeof(largerecord), #0);
+ largerecord.b[1] := RESULT_U8BIT;
+ largerecord.b[BIG_INDEX] := RESULT_U8BIT;
+ func_largerecord_mixed := largerecord;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_shortstring_mixed(b: byte): shortstring;saveregisters;
+ var
+ local_b: byte;
+ begin
+ func_shortstring_mixed := RESULT_BIGSTRING;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_largeset_mixed(b: byte) : tlargeset;saveregisters;
+ var
+ local_b: byte;
+ largeset : tlargeset;
+ begin
+ largeset := ['I'];
+ func_largeset_mixed := largeset;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_u8bit_mixed(b: byte) : byte;saveregisters;
+ var
+ local_b: byte;
+ begin
+ func_u8bit_mixed := RESULT_U8BIT;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_u16bit_mixed(b: byte) : word;saveregisters;
+ var
+ local_b: byte;
+ begin
+ func_u16bit_mixed := RESULT_U16BIT;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_s32bit_mixed(b: byte) : longint;saveregisters;
+ var
+ local_b: byte;
+ begin
+ func_s32bit_mixed := RESULT_S32BIT;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_s64bit_mixed(b: byte) : int64;saveregisters;
+ var
+ local_b: byte;
+ begin
+ func_s64bit_mixed := RESULT_S64BIT;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_s32real_mixed(b: byte) : single;saveregisters;
+ var
+ local_b: byte;
+ begin
+ func_s32real_mixed := RESULT_S32REAL;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_s64real_mixed(b: byte) : double;saveregisters;
+ var
+ local_b: byte;
+ begin
+ func_s64real_mixed := RESULT_S64REAl;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_ansistring_mixed(b: byte) : ansistring;saveregisters;
+ var
+ local_b: byte;
+ begin
+ func_ansistring_mixed := RESULT_BIGSTRING;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+function func_pchar_mixed(b: byte) : pchar;saveregisters;
+ var
+ local_b: byte;
+ begin
+ func_pchar_mixed := RESULT_PCHAR;
+ local_b:=b;
+ global_u8bit := b;
+ end;
+
+ {********************* FUNCTION RESULT WITH PARAMS (NESTED) ******************}
+{ LOC_MEM return values }
+function func_array_mixed_nested(b: byte): tsmallarray;saveregisters;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ smallarray: tsmallarray;
+ begin
+ fillchar(smallarray, sizeof(smallarray), #0);
+ smallarray[1] := RESULT_U8BIT;
+ smallarray[SMALL_INDEX] := RESULT_U8BIT;
+ func_array_mixed_nested := smallarray;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+{ nested_one_proc(RESULT_S32BIT);}
+ end;
+
+function func_largerecord_mixed_nested(b: byte): tlargerecord;saveregisters;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ largerecord : tlargerecord;
+ begin
+ fillchar(largerecord, sizeof(largerecord), #0);
+ largerecord.b[1] := RESULT_U8BIT;
+ largerecord.b[BIG_INDEX] := RESULT_U8BIT;
+ func_largerecord_mixed_nested := largerecord;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_shortstring_mixed_nested(b: byte): shortstring;saveregisters;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+ var
+ local_b: byte;
+ begin
+ func_shortstring_mixed_nested := RESULT_BIGSTRING;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_largeset_mixed_nested(b: byte) : tlargeset;saveregisters;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ largeset : tlargeset;
+ begin
+ largeset := ['I'];
+ func_largeset_mixed_nested := largeset;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_u8bit_mixed_nested(b: byte) : byte;saveregisters;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_u8bit_mixed_nested := RESULT_U8BIT;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_u16bit_mixed_nested(b: byte) : word;saveregisters;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_u16bit_mixed_nested := RESULT_U16BIT;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_s32bit_mixed_nested(b: byte) : longint;saveregisters;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_s32bit_mixed_nested := RESULT_S32BIT;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_s64bit_mixed_nested(b: byte) : int64;saveregisters;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_s64bit_mixed_nested := RESULT_S64BIT;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_s32real_mixed_nested(b: byte) : single;saveregisters;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_s32real_mixed_nested := RESULT_S32REAL;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_s64real_mixed_nested(b: byte) : double;saveregisters;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_s64real_mixed_nested := RESULT_S64REAl;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_ansistring_mixed_nested(b: byte) : ansistring;saveregisters;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_ansistring_mixed_nested := RESULT_BIGSTRING;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+function func_pchar_mixed_nested(b: byte) : pchar;saveregisters;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := b;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ begin
+ func_pchar_mixed_nested := RESULT_PCHAR;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, RESULT_BIGSTRING);
+ end;
+
+
+var
+ failed: boolean;
+Begin
+ {************************************* SIMPLE TESTS ***********************************}
+ write('Testing function results (LOC_REFERENCE)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_smallarray := func_array;
+ if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_largerec := func_largerecord;
+ if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[BIG_INDEX] <> RESULT_U8BIT) then
+ failed:=true;
+
+ clear_globals;
+ clear_values;
+ value_mediumrec := func_mediumrecord;
+ if (value_mediumrec.b[1] <> RESULT_U8BIT) or (value_mediumrec.b[MEDIUM_INDEX] <> RESULT_U8BIT) then
+ failed:=true;
+
+
+ clear_globals;
+ clear_values;
+ value_bigstring := func_shortstring;
+ if value_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_largeset := func_largeset;
+ if not ('I' in value_largeset) then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing orddef/enumdef function results (LOC_REGISTER)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+
+ value_u8bit := func_u8bit;
+ if value_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_u16bit := func_u16bit;
+ if value_u16bit <> RESULT_U16BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s32bit := func_s32bit;
+ if value_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s64bit := func_s64bit;
+ if value_s64bit <> RESULT_S64BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+
+ write('Testing floatdef function results...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ clear_globals;
+ clear_values;
+ value_s32real := func_s32real;
+ if trunc(value_s32real) <> trunc(RESULT_S32REAL) then
+ failed:=true;
+
+ clear_globals;
+ clear_values;
+ value_s64real := func_s64real;
+ if trunc(value_s64real) <> trunc(RESULT_S64REAL) then
+ failed:=true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing ansistring function result...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+
+value_ansistring := func_ansistring;
+if value_ansistring <> RESULT_BIGSTRING then
+ failed:=true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing pointer function result (LOC_REGISTER)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_ptr := func_pchar;
+ if value_ptr <> RESULT_PCHAR then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ {*********************************** TESTS W/PARAMS ***********************************}
+ write('Testing function results with parameter (LOC_REFERENCE)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_smallarray := func_array_mixed(RESULT_U8BIT);
+ if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_largerec := func_largerecord_mixed(RESULT_U8BIT);
+ if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[BIG_INDEX] <> RESULT_U8BIT) then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_bigstring := func_shortstring_mixed(RESULT_U8BIT);
+ if value_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_largeset := func_largeset_mixed(RESULT_U8BIT);
+ if not ('I' in value_largeset) then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing orddef/enumdef function results with parameter (LOC_REGISTER)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+
+ value_u8bit := func_u8bit_mixed(RESULT_U8BIT);
+ if value_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_u16bit := func_u16bit_mixed(RESULT_U8BIT);
+ if value_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s32bit := func_s32bit_mixed(RESULT_U8BIT);
+ if value_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s64bit := func_s64bit_mixed(RESULT_U8BIT);
+ if value_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+
+ write('Testing floatdef function results with parameter...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_s32real := func_s32real_mixed(RESULT_U8BIT);
+ if trunc(value_s32real) <> trunc(RESULT_S32REAL) then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s64real := func_s64real_mixed(RESULT_U8BIT);
+ if trunc(value_s64real) <> trunc(RESULT_S64REAL) then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing ansistring function result with parameter...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+
+ value_ansistring := func_ansistring_mixed(RESULT_U8BIT);
+ if value_ansistring <> RESULT_BIGSTRING then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing pointer function result with parameter (LOC_REGISTER)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_ptr := func_pchar_mixed(RESULT_U8BIT);
+ if value_ptr <> RESULT_PCHAR then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ {******************************NESTED TESTS W/PARAMS **********************************}
+ write('Testing function (w/nesting) results with parameter (LOC_REFERENCE)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_smallarray := func_array_mixed_nested(RESULT_U8BIT);
+ if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_largerec := func_largerecord_mixed_nested(RESULT_U8BIT);
+ if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[BIG_INDEX] <> RESULT_U8BIT) then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_bigstring := func_shortstring_mixed_nested(RESULT_U8BIT);
+ if value_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_largeset := func_largeset_mixed_nested(RESULT_U8BIT);
+ if not ('I' in value_largeset) then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing orddef/enumdef function (w/nesting) results with parameter (LOC_REGISTER)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+
+ value_u8bit := func_u8bit_mixed_nested(RESULT_U8BIT);
+ if value_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_u16bit := func_u16bit_mixed_nested(RESULT_U8BIT);
+ if value_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s32bit := func_s32bit_mixed_nested(RESULT_U8BIT);
+ if value_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s64bit := func_s64bit_mixed_nested(RESULT_U8BIT);
+ if value_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+
+ write('Testing floatdef function (w/nesting) results with parameter...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_s32real := func_s32real_mixed_nested(RESULT_U8BIT);
+ if trunc(value_s32real) <> trunc(RESULT_S32REAL) then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ value_s64real := func_s64real_mixed_nested(RESULT_U8BIT);
+ if trunc(value_s64real) <> trunc(RESULT_S64REAL) then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing ansistring function (w/nesting) result with parameter...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+
+ value_ansistring := func_ansistring_mixed_nested(RESULT_U8BIT);
+ if value_ansistring <> RESULT_BIGSTRING then
+ failed:=true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ write('Testing pointer function (w/nesting) result with parameter (LOC_REGISTER)...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ value_ptr := func_pchar_mixed_nested(RESULT_U8BIT);
+ if value_ptr <> RESULT_PCHAR then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+end.
+
+{
$Log$
- Revision 1.5 2003-04-22 10:24:29 florian
+ Revision 1.6 2004-05-02 12:11:44 peter
+ * fixed linefeeds
+
+ Revision 1.5 2003/04/22 10:24:29 florian
* fixed defines for powerpc
-
- Revision 1.4 2002/09/27 17:44:50 carl
- * add testing for window-page size 4K, so as to test stack corruption
-
- Revision 1.3 2002/09/07 15:40:51 peter
- * old logs removed and tabs fixed
-
- Revision 1.2 2002/05/13 13:45:37 peter
- * updated to compile tests with kylix
-
- Revision 1.1 2002/04/13 17:47:57 carl
- + function calling withy saveregisters convention
-
-}
+
+ Revision 1.4 2002/09/27 17:44:50 carl
+ * add testing for window-page size 4K, so as to test stack corruption
+
+ Revision 1.3 2002/09/07 15:40:51 peter
+ * old logs removed and tabs fixed
+
+ Revision 1.2 2002/05/13 13:45:37 peter
+ * updated to compile tests with kylix
+
+ Revision 1.1 2002/04/13 17:47:57 carl
+ + function calling withy saveregisters convention
+
+}
diff --git a/tests/test/cg/tcalobj3.pp b/tests/test/cg/tcalobj3.pp
index a2cc6e141b..e206d423fd 100644
--- a/tests/test/cg/tcalobj3.pp
+++ b/tests/test/cg/tcalobj3.pp
@@ -1,3326 +1,3329 @@
-{****************************************************************}
-{ CODE GENERATOR TEST PROGRAM }
-{ Copyright (c) 2002 Carl Eric Codere }
-{****************************************************************}
-{ NODE TESTED : secondcalln() }
-{****************************************************************}
-{ PRE-REQUISITES: secondload() }
-{ secondassign() }
-{ secondtypeconv() }
-{ secondtryexcept() }
-{****************************************************************}
-{ DEFINES: }
-{ FPC = Target is FreePascal compiler }
-{****************************************************************}
-{ REMARKS: This tests secondcalln(), genentrycode() and }
-{ genexitcode() for standard object with the cdecl }
-{ calling convention. }
-{ }
-{****************************************************************}
-program tcalobj3;
-{$STATIC ON}
-{$R+}
-
- const
- { should be defined depending on CPU target }
- {$ifdef cpu68k}
- BIG_INDEX = 8000;
- SMALL_INDEX = 13;
- {$else}
- BIG_INDEX = 33000;
- SMALL_INDEX = 13; { value should not be aligned! }
- {$endif}
- RESULT_U8BIT = $55;
- RESULT_U16BIT = 2*RESULT_U8BIT;
- RESULT_S32BIT = $500F0000;
- RESULT_S64BIT = $500F0000;
- RESULT_S32REAL = 1777.12;
- RESULT_S64REAL = 3444.24;
- RESULT_BOOL8BIT = 1;
- RESULT_BOOL16BIT = 1;
- RESULT_BOOL32BIT = 1;
- RESULT_PCHAR = 'Hello world';
- RESULT_BIGSTRING = 'Hello world';
- RESULT_SMALLSTRING = 'H';
- RESULT_CHAR = 'I';
- RESULT_BOOLEAN = TRUE;
-
- type
-
- tprocedure = procedure;
-
- tsmallrecord = packed record
- b: byte;
- w: word;
- end;
-
- tlargerecord = packed record
- b: array[1..BIG_INDEX] of byte;
- end;
-
- tsmallarray = packed array[1..SMALL_INDEX] of byte;
-
- tsmallsetenum =
- (A_A,A_B,A_C,A_D);
-
- tsmallset = set of tsmallsetenum;
- tlargeset = set of char;
-
- tsmallstring = string[2];
-
-
- var
- global_u8bit : byte;
- global_u16bit : word;
- global_s32bit : longint;
- global_s32real : single;
- global_s64real : double;
- global_ptr : pchar;
- global_proc : tprocedure;
- global_bigstring : shortstring;
- global_boolean : boolean;
- global_char : char;
- global_s64bit : int64;
- value_s64bit : int64;
- value_ansistring : ansistring;
- value_u8bit : byte;
- value_u16bit : word;
- value_s32bit : longint;
- value_s32real : single;
- value_s64real : double;
- value_proc : tprocedure;
- value_ptr : pchar;
- value_smallrec : tsmallrecord;
- value_largerec : tlargerecord;
- value_smallset : tsmallset;
- value_smallstring : tsmallstring;
- value_bigstring : shortstring;
- value_largeset : tlargeset;
- value_smallarray : tsmallarray;
- value_boolean : boolean;
- value_char : char;
-
- procedure fail;
- begin
- WriteLn('Failure.');
- halt(1);
- end;
-
-
- procedure clear_globals;
- begin
- global_u8bit := 0;
- global_u16bit := 0;
- global_s32bit := 0;
- global_s32real := 0.0;
- global_s64real := 0.0;
- global_ptr := nil;
- global_proc := nil;
- global_bigstring := '';
- global_boolean := false;
- global_char := #0;
- global_s64bit := 0;
- end;
-
-
- procedure clear_values;
- begin
- value_u8bit := 0;
- value_u16bit := 0;
- value_s32bit := 0;
- value_s32real := 0.0;
- value_s64real := 0.0;
- value_proc := nil;
- value_ptr := nil;
- fillchar(value_smallrec, sizeof(value_smallrec), #0);
- fillchar(value_largerec, sizeof(value_largerec), #0);
- value_smallset := [];
- value_smallstring := '';
- value_bigstring := '';
- value_largeset := [];
- fillchar(value_smallarray, sizeof(value_smallarray), #0);
- value_boolean := false;
- value_char:=#0;
- value_ansistring := '';
- value_s64bit := 0;
- end;
-
-
- function getu8: byte;
- begin
- getu8 := RESULT_U8BIT;
- end;
-
-
-type
-
- { object without vmt }
- pnovmtobject = ^tnovmtobject;
- tnovmtobject = object
- public
- object_bigstring : shortstring;
- object_u16bit : word;
- { no parameter testing }
- procedure method_public_none;cdecl;
- procedure method_public_static_none; static;cdecl;
- procedure method_call_private_none;cdecl;
- procedure method_call_private_static_none; static;cdecl;
- { simple value parameter testing }
- procedure method_public_u8(x : byte);cdecl;
- procedure method_public_static_u8(x: byte); static;cdecl;
- procedure method_call_private_u8(x: byte);cdecl;
- procedure method_call_private_static_u8(x: byte); static;cdecl;
- function func_array_mixed_nested(b: byte): tsmallarray;cdecl;
- private
- procedure method_private_none;cdecl;
- procedure method_private_static_none; static;cdecl;
- function func_getu16bit : word;cdecl;
- { simple value parameter testing }
- procedure method_private_u8(x: byte);cdecl;
- procedure method_private_static_u8(x: byte); static;cdecl;
- end;
-
-
- { object with vmt }
- pvmtobject = ^tvmtobject;
- tvmtobject = object
- public
- object_u8bit : byte;
- object_u16bit : word;
- object_bigstring : shortstring;
- object_s32bit : longint;
- object_s64bit : int64;
- constructor constructor_params_mixed(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);
- constructor constructor_init;
- destructor destructor_params_done;
- procedure method_normal_params_mixed(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);cdecl;
- procedure method_virtual_params_mixed(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);virtual;
- procedure method_virtual_overriden_params_mixed(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);virtual;
- procedure method_static_params_mixed(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);static;cdecl;
- procedure method_normal_call_inherited_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);cdecl;
-
- { virtual methods which call other methods }
- procedure method_virtual_call_static_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;
- procedure method_virtual_call_virtual_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;
- procedure method_virtual_call_overriden_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;
- procedure method_virtual_call_normal_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;
- procedure method_virtual_call_constructor_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;
- procedure method_virtual_call_inherited_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;
-
- end;
-
- pheritedvmtobject = ^theritedvmtobject;
- theritedvmtobject = object(tvmtobject)
- constructor constructor_params_mixed_call_virtual(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);
- constructor constructor_params_mixed_call_overriden(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);
- constructor constructor_params_mixed_call_static(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);
- constructor constructor_params_mixed_call_normal(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);
- constructor constructor_params_mixed_call_inherited(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);
- procedure method_virtual_overriden_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;
-
- { normal methods which call other methods }
- procedure method_normal_call_static_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);cdecl;
- procedure method_normal_call_virtual_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);cdecl;
- procedure method_normal_call_overriden_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);cdecl;
- procedure method_normal_call_normal_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);cdecl;
- procedure method_normal_call_constructor_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);cdecl;
- procedure method_normal_call_inherited_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);cdecl;
-
- { virtual methods which call other methods }
- procedure method_virtual_call_inherited_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;
-
- end;
-
- pfailvmtobject = ^tfailvmtobject;
- tfailvmtobject = object(tvmtobject)
- public
- constructor constructor_public_none;
- end;
-
-
-
-{**************************************************************************}
-{ NO VMT OBJECT }
-{**************************************************************************}
-
- {****************** NO PARAMETERS ******************}
- procedure tnovmtobject.method_public_none;cdecl;
- begin
- global_u8bit := RESULT_U8BIT;
- end;
-
-
- procedure tnovmtobject.method_public_static_none;cdecl;
- begin
- global_u8bit := RESULT_U8BIT;
- end;
-
-
- procedure tnovmtobject.method_call_private_none;cdecl;
- begin
- method_private_none;
- method_private_static_none;
- end;
-
- procedure tnovmtobject.method_call_private_static_none;cdecl;
- begin
- method_private_static_none;
- end;
-
-
- procedure tnovmtobject.method_private_none;cdecl;
- begin
- Inc(global_u16bit, RESULT_U8BIT);
- end;
-
-
- procedure tnovmtobject.method_private_static_none;cdecl;
- begin
- Inc(global_u16bit, RESULT_U8BIT);
- end;
-
- {******************** PARAMETERS ******************}
-
- procedure tnovmtobject.method_public_u8(x : byte);cdecl;
- begin
- global_u8bit := x;
- end;
-
- procedure tnovmtobject.method_public_static_u8(x: byte);cdecl;
- begin
- global_u8bit := x;
- end;
-
- procedure tnovmtobject.method_call_private_u8(x: byte);cdecl;
- begin
- method_private_static_u8(x);
- method_private_u8(x);
- end;
-
- procedure tnovmtobject. method_call_private_static_u8(x: byte);cdecl;
- begin
- method_private_static_u8(x);
- end;
-
- procedure tnovmtobject.method_private_u8(x: byte);cdecl;
- begin
- Inc(global_u16bit,x);
- end;
-
- procedure tnovmtobject.method_private_static_u8(x: byte);cdecl;
- begin
- Inc(global_u16bit,x);
- end;
-
-
- function tnovmtobject.func_getu16bit : word;cdecl;
- begin
- func_getu16bit := object_u16bit;
- end;
-
- {
- complex testing, nested field access, with parameters and
- comple return value.
-
- On exit : global_u8bit := x;
- global_u16bit := object_u16bit (from func_getu16bit);
- global_s32bit := RESULT_S32BIT
- global_bigstring := object_bigstring
- global_s64bit := x;
- }
- function tnovmtobject.func_array_mixed_nested(b: byte): tsmallarray;cdecl;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := func_getu16bit;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- smallarray: tsmallarray;
- begin
- fillchar(smallarray, sizeof(smallarray), #0);
- smallarray[1] := RESULT_U8BIT;
- smallarray[SMALL_INDEX] := RESULT_U8BIT;
- func_array_mixed_nested := smallarray;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, object_bigstring);
- end;
-
-{**************************************************************************}
-{ FAILED OBJECT }
-{**************************************************************************}
-constructor tfailvmtobject.constructor_public_none;
- begin
- { this calls the constructor fail special keyword }
- fail;
- end;
-
-{**************************************************************************}
-{ VMT OBJECT }
-{**************************************************************************}
-constructor tvmtobject.constructor_params_mixed(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);
- begin
- object_u8bit := u8;
- object_u16bit := u16;
- object_bigstring := bigstring;
- object_s32bit := s32;
- object_s64bit := s64;
- end;
-
-
-constructor tvmtobject.constructor_init;
- begin
- object_u8bit := 0;
- object_u16bit := 0;
- object_bigstring := '';
- object_s32bit := 0;
- object_s64bit := 0;
- end;
-
-destructor tvmtobject.destructor_params_done;
- begin
- object_u8bit := 0;
- object_u16bit := 0;
- object_bigstring := '';
- object_s32bit := 0;
- object_s64bit := 0;
- end;
-
-
-procedure tvmtobject.method_normal_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);cdecl;
- begin
- object_u8bit := u8;
- object_u16bit := u16;
- object_bigstring := bigstring;
- object_s32bit := s32;
- object_s64bit := s64;
- end;
-
-procedure tvmtobject.method_virtual_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
- begin
- object_u8bit := u8;
- object_u16bit := u16;
- object_bigstring := bigstring;
- object_s32bit := s32;
- object_s64bit := s64;
- end;
-
-{ this one should be overriden }
-procedure tvmtobject.method_virtual_overriden_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
- begin
- RunError(211);
- end;
-
-{ can't access field of instances in static methods }
-procedure tvmtobject.method_static_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);cdecl;
- begin
- global_u8bit := u8;
- global_u16bit := u16;
- global_bigstring := bigstring;
- global_s32bit := s32;
- global_s64bit := s64;
- end;
-
-procedure tvmtobject.method_normal_call_inherited_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);cdecl;
- begin
- object_u8bit := u8;
- object_u16bit := u16;
- object_bigstring := bigstring;
- object_s32bit := s32;
- object_s64bit := s64;
- end;
-
-
-procedure tvmtobject.method_virtual_call_static_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
- begin
- method_static_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-procedure tvmtobject.method_virtual_call_virtual_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
- begin
- method_virtual_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-procedure tvmtobject.method_virtual_call_overriden_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
- begin
- method_virtual_overriden_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-
-procedure tvmtobject.method_virtual_call_normal_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
- begin
- method_normal_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-procedure tvmtobject.method_virtual_call_constructor_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
- begin
- constructor_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-procedure tvmtobject.method_virtual_call_inherited_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
- begin
- object_u8bit := u8;
- object_u16bit := u16;
- object_bigstring := bigstring;
- object_s32bit := s32;
- object_s64bit := s64;
- end;
-
-
-{**************************************************************************}
-{ INHERITED VMT OBJECT }
-{**************************************************************************}
-constructor theritedvmtobject.constructor_params_mixed_call_virtual(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
- begin
- object_u8bit := 0;
- object_u16bit := 0;
- object_bigstring := '';
- object_s32bit := 0;
- object_s64bit := 0;
- method_virtual_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-constructor theritedvmtobject.constructor_params_mixed_call_overriden(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
- begin
- object_u8bit := 0;
- object_u16bit := 0;
- object_bigstring := '';
- object_s32bit := 0;
- object_s64bit := 0;
- method_virtual_overriden_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-constructor theritedvmtobject.constructor_params_mixed_call_static(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
- begin
- object_u8bit := 0;
- object_u16bit := 0;
- object_bigstring := '';
- object_s32bit := 0;
- object_s64bit := 0;
- method_static_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-constructor theritedvmtobject.constructor_params_mixed_call_normal(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
- begin
- object_u8bit := 0;
- object_u16bit := 0;
- object_bigstring := '';
- object_s32bit := 0;
- object_s64bit := 0;
- method_normal_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-constructor theritedvmtobject.constructor_params_mixed_call_inherited
- (u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
- begin
- object_u8bit := 0;
- object_u16bit := 0;
- object_bigstring := '';
- object_s32bit := 0;
- object_s64bit := 0;
- inherited constructor_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-{ this one should be overriden }
-procedure theritedvmtobject.method_virtual_overriden_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
- begin
- object_u8bit := u8;
- object_u16bit := u16;
- object_bigstring := bigstring;
- object_s32bit := s32;
- object_s64bit := s64;
- end;
-
-procedure theritedvmtobject.method_normal_call_static_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);cdecl;
- begin
- method_static_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-procedure theritedvmtobject.method_normal_call_virtual_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);cdecl;
- begin
- method_virtual_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-procedure theritedvmtobject.method_normal_call_overriden_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);cdecl;
- begin
- method_virtual_overriden_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-
-procedure theritedvmtobject.method_normal_call_normal_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);cdecl;
- begin
- method_normal_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-procedure theritedvmtobject.method_normal_call_constructor_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);cdecl;
- begin
- constructor_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-procedure theritedvmtobject.method_normal_call_inherited_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);cdecl;
- begin
- Inherited method_normal_call_inherited_params_mixed(u8, u16, bigstring,
- s32, s64);
- end;
-
-procedure theritedvmtobject.method_virtual_call_inherited_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
- begin
- Inherited method_virtual_call_inherited_params_mixed(u8, u16, bigstring,
- s32, s64);
- end;
-
-
-procedure testnovmtobject;
-var
- novmtobject : tnovmtobject;
- failed : boolean;
-begin
- {******************** STATIC / METHOD SIMPLE CALL **********************}
- Write('No parameter / method call testing...');
- failed := false;
-
- clear_globals;
- clear_values;
-
- tnovmtobject.method_public_static_none;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- novmtobject.method_public_static_none;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- tnovmtobject.method_call_private_static_none;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_call_private_static_none;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_public_none;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_call_private_none;
- if global_u16bit <> (RESULT_U16BIT) then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- Write('Simple parameter (LOC_CONSTANT) / method call testing...');
- failed := false;
-
- clear_globals;
- clear_values;
-
- { parameter is LOC_CONSTANT }
- novmtobject.method_public_u8(RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- tnovmtobject.method_public_static_u8(RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_public_static_u8(RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_call_private_u8(RESULT_U8BIT);
- if global_u16bit <> (RESULT_U16BIT) then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_call_private_static_u8(RESULT_U8BIT);
- if global_u16bit <> (RESULT_U8BIT) then
- failed := true;
-
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
-
- Write('Simple parameter (LOC_REFERENCE) / method call testing...');
- failed := false;
-
- clear_globals;
- clear_values;
-
- value_u8bit := RESULT_U8BIT;
- novmtobject.method_public_u8(value_u8bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- value_u8bit := RESULT_U8BIT;
- tnovmtobject.method_public_static_u8(value_u8bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- value_u8bit := RESULT_U8BIT;
- novmtobject.method_public_static_u8(value_u8bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- value_u8bit := RESULT_U8BIT;
- novmtobject.method_call_private_u8(value_u8bit);
- if global_u16bit <> (RESULT_U16BIT) then
- failed := true;
-
- clear_globals;
- clear_values;
-
- value_u8bit := RESULT_U8BIT;
- novmtobject.method_call_private_static_u8(value_u8bit);
- if global_u16bit <> (RESULT_U8BIT) then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- Write('Simple parameter (LOC_REGISTER) / method call testing...');
- failed := false;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_public_u8(getu8);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- tnovmtobject.method_public_static_u8(getu8);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_public_static_u8(getu8);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_call_private_u8(getu8);
- if global_u16bit <> (RESULT_U16BIT) then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_call_private_static_u8(getu8);
- if global_u16bit <> (RESULT_U8BIT) then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- Write('Simple parameter / complex return / nested method access testing...');
-
- clear_globals;
- clear_values;
- failed := false;
- novmtobject.object_bigstring := RESULT_BIGSTRING;
- novmtobject.object_u16bit := RESULT_U16BIT;
-
- value_smallarray := novmtobject.func_array_mixed_nested(RESULT_U8BIT);
- if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-end;
-
-
-procedure testfailedobject;
-var
- failedobject : tfailvmtobject;
- begin
- Write('Testing constructor return value...');
- if failedobject.constructor_public_none then
- fail
- else
- Writeln('Passed!');
- end;
-
-
- procedure testvmtobject;
- var
- vmtobject : tvmtobject;
- failed : boolean;
- begin
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call...');
- vmtobject.constructor_params_mixed(RESULT_U8BIT, RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.constructor_params_mixed(value_u8bit, value_u16bit, value_bigstring,
- value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- end;
-
-
- procedure testheritedvmtobject;
- var
- vmtobject : theritedvmtobject;
- failed : boolean;
- begin
- {********************** CONSTRUCTOR TESTING ************************}
- {********************** DESTRUCTOR TESTING ************************}
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) inherited constructor call...');
- vmtobject.constructor_params_mixed_call_inherited(RESULT_U8BIT, RESULT_U16BIT, RESULT_BIGSTRING,
- RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) inherited constructor call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.constructor_params_mixed_call_inherited(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
- vmtobject.constructor_params_mixed_call_virtual(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.constructor_params_mixed_call_virtual(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
- vmtobject.constructor_params_mixed_call_overriden(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.constructor_params_mixed_call_overriden(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/method call...');
- vmtobject.constructor_params_mixed_call_normal(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.constructor_params_mixed_call_normal(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/static call...');
- vmtobject.constructor_params_mixed_call_static(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/static call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.constructor_params_mixed_call_static(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- {************************* METHOD TESTING **************************}
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
- vmtobject.method_virtual_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_virtual_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
- vmtobject.method_virtual_overriden_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_virtual_overriden_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call...');
- vmtobject.method_normal_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_normal_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) static method call...');
- vmtobject.method_static_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) static method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_static_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { ********************************************************************
- This calls methods which in turn call other methods, or a constructor
- or a destructor.
- *********************************************************************
- }
- clear_globals;
- clear_values;
- failed := false;
- { Calls the ancestor virtual method }
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
- vmtobject.method_normal_call_virtual_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_normal_call_virtual_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { The virtual method has been overriden by the object in this case }
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
- vmtobject.method_normal_call_overriden_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_normal_call_overriden_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/normal call...');
- vmtobject.method_normal_call_normal_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/normal call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_normal_call_normal_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- (* constructor call inside a normal method *)
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/constructor call...');
- vmtobject.method_normal_call_constructor_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/constructor call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_normal_call_constructor_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { static method call }
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/static call...');
- vmtobject.method_normal_call_static_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/static call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_normal_call_static_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- (* calls the inherited method *)
- clear_globals;
- clear_values;
- failed := false;
- { Calls the ancestor virtual method }
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/inherited call...');
- vmtobject.method_normal_call_inherited_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/inherited call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_normal_call_inherited_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { ********************************************************************
- This calls virtual methods which in turn call other methods,
- or a constructor or a destructor.
- *********************************************************************
- }
- clear_globals;
- clear_values;
- failed := false;
- { Calls the ancestor virtual method }
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
- vmtobject.method_virtual_call_virtual_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_virtual_call_virtual_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { The virtual method has been overriden by the object in this case }
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
- vmtobject.method_virtual_call_overriden_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_virtual_call_overriden_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/normal call...');
- vmtobject.method_virtual_call_normal_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/normal call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_virtual_call_normal_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- (* constructor call inside a normal method *)
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/constructor call...');
- vmtobject.method_virtual_call_constructor_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/constructor call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_virtual_call_constructor_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { static virtual call }
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/static call...');
- vmtobject.method_virtual_call_static_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/static call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_virtual_call_static_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- (* calls the inherited method *)
- clear_globals;
- clear_values;
- failed := false;
- { Calls the ancestor virtual method }
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/inherited call...');
- vmtobject.method_virtual_call_inherited_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/inherited call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_virtual_call_inherited_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
-
- end;
-
- { same as testvmtherited, except uses with statement }
- procedure testwith;
- var
- vmtobject : theritedvmtobject;
- failed : boolean;
- begin
- with vmtobject do
- begin
- {********************** CONSTRUCTOR TESTING ************************}
- {********************** DESTRUCTOR TESTING ************************}
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) inherited constructor call...');
- constructor_params_mixed_call_inherited(RESULT_U8BIT, RESULT_U16BIT, RESULT_BIGSTRING,
- RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) inherited constructor call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- constructor_params_mixed_call_inherited(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
- constructor_params_mixed_call_virtual(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- constructor_params_mixed_call_virtual(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
- constructor_params_mixed_call_overriden(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- constructor_params_mixed_call_overriden(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/method call...');
- constructor_params_mixed_call_normal(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- constructor_params_mixed_call_normal(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/static call...');
- constructor_params_mixed_call_static(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/static call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- constructor_params_mixed_call_static(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- {************************* METHOD TESTING **************************}
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
- method_virtual_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_virtual_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
- method_virtual_overriden_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_virtual_overriden_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call...');
- method_normal_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_normal_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) static method call...');
- method_static_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) static method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_static_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { ********************************************************************
- This calls methods which in turn call other methods, or a constructor
- or a destructor.
- *********************************************************************
- }
- clear_globals;
- clear_values;
- failed := false;
- { Calls the ancestor virtual method }
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
- method_normal_call_virtual_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_normal_call_virtual_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { The virtual method has been overriden by the object in this case }
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
- method_normal_call_overriden_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_normal_call_overriden_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/normal call...');
- method_normal_call_normal_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/normal call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_normal_call_normal_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- (* constructor call inside a normal method *)
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/constructor call...');
- method_normal_call_constructor_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/constructor call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_normal_call_constructor_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { static method call }
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/static call...');
- method_normal_call_static_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/static call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_normal_call_static_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- (* calls the inherited method *)
- clear_globals;
- clear_values;
- failed := false;
- { Calls the ancestor virtual method }
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/inherited call...');
- method_normal_call_inherited_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/inherited call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_normal_call_inherited_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { ********************************************************************
- This calls virtual methods which in turn call other methods,
- or a constructor or a destructor.
- *********************************************************************
- }
- clear_globals;
- clear_values;
- failed := false;
- { Calls the ancestor virtual method }
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
- method_virtual_call_virtual_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_virtual_call_virtual_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { The virtual method has been overriden by the object in this case }
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
- method_virtual_call_overriden_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_virtual_call_overriden_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/normal call...');
- method_virtual_call_normal_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/normal call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_virtual_call_normal_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- (* constructor call inside a normal method *)
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/constructor call...');
- method_virtual_call_constructor_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/constructor call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_virtual_call_constructor_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { static virtual call }
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/static call...');
- method_virtual_call_static_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/static call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_virtual_call_static_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- (* calls the inherited method *)
- clear_globals;
- clear_values;
- failed := false;
- { Calls the ancestor virtual method }
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/inherited call...');
- method_virtual_call_inherited_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/inherited call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_virtual_call_inherited_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
- end; { end with }
- end;
-
-
-begin
- WriteLN('*********************** NO VMT OBJECT TESTS ********************');
- testnovmtobject;
- WriteLN('************************ VMT OBJECT FAIL **********************');
- testfailedobject;
- WriteLN('************************* VMT OBJECT TESTS *********************');
- testvmtobject;
- testheritedvmtobject;
- WriteLN('**************** VMT OBJECT TESTS USING WITH *******************');
- testwith;
-end.
-
-{
+{****************************************************************}
+{ CODE GENERATOR TEST PROGRAM }
+{ Copyright (c) 2002 Carl Eric Codere }
+{****************************************************************}
+{ NODE TESTED : secondcalln() }
+{****************************************************************}
+{ PRE-REQUISITES: secondload() }
+{ secondassign() }
+{ secondtypeconv() }
+{ secondtryexcept() }
+{****************************************************************}
+{ DEFINES: }
+{ FPC = Target is FreePascal compiler }
+{****************************************************************}
+{ REMARKS: This tests secondcalln(), genentrycode() and }
+{ genexitcode() for standard object with the cdecl }
+{ calling convention. }
+{ }
+{****************************************************************}
+program tcalobj3;
+{$STATIC ON}
+{$R+}
+
+ const
+ { should be defined depending on CPU target }
+ {$ifdef cpu68k}
+ BIG_INDEX = 8000;
+ SMALL_INDEX = 13;
+ {$else}
+ BIG_INDEX = 33000;
+ SMALL_INDEX = 13; { value should not be aligned! }
+ {$endif}
+ RESULT_U8BIT = $55;
+ RESULT_U16BIT = 2*RESULT_U8BIT;
+ RESULT_S32BIT = $500F0000;
+ RESULT_S64BIT = $500F0000;
+ RESULT_S32REAL = 1777.12;
+ RESULT_S64REAL = 3444.24;
+ RESULT_BOOL8BIT = 1;
+ RESULT_BOOL16BIT = 1;
+ RESULT_BOOL32BIT = 1;
+ RESULT_PCHAR = 'Hello world';
+ RESULT_BIGSTRING = 'Hello world';
+ RESULT_SMALLSTRING = 'H';
+ RESULT_CHAR = 'I';
+ RESULT_BOOLEAN = TRUE;
+
+ type
+
+ tprocedure = procedure;
+
+ tsmallrecord = packed record
+ b: byte;
+ w: word;
+ end;
+
+ tlargerecord = packed record
+ b: array[1..BIG_INDEX] of byte;
+ end;
+
+ tsmallarray = packed array[1..SMALL_INDEX] of byte;
+
+ tsmallsetenum =
+ (A_A,A_B,A_C,A_D);
+
+ tsmallset = set of tsmallsetenum;
+ tlargeset = set of char;
+
+ tsmallstring = string[2];
+
+
+ var
+ global_u8bit : byte;
+ global_u16bit : word;
+ global_s32bit : longint;
+ global_s32real : single;
+ global_s64real : double;
+ global_ptr : pchar;
+ global_proc : tprocedure;
+ global_bigstring : shortstring;
+ global_boolean : boolean;
+ global_char : char;
+ global_s64bit : int64;
+ value_s64bit : int64;
+ value_ansistring : ansistring;
+ value_u8bit : byte;
+ value_u16bit : word;
+ value_s32bit : longint;
+ value_s32real : single;
+ value_s64real : double;
+ value_proc : tprocedure;
+ value_ptr : pchar;
+ value_smallrec : tsmallrecord;
+ value_largerec : tlargerecord;
+ value_smallset : tsmallset;
+ value_smallstring : tsmallstring;
+ value_bigstring : shortstring;
+ value_largeset : tlargeset;
+ value_smallarray : tsmallarray;
+ value_boolean : boolean;
+ value_char : char;
+
+ procedure fail;
+ begin
+ WriteLn('Failure.');
+ halt(1);
+ end;
+
+
+ procedure clear_globals;
+ begin
+ global_u8bit := 0;
+ global_u16bit := 0;
+ global_s32bit := 0;
+ global_s32real := 0.0;
+ global_s64real := 0.0;
+ global_ptr := nil;
+ global_proc := nil;
+ global_bigstring := '';
+ global_boolean := false;
+ global_char := #0;
+ global_s64bit := 0;
+ end;
+
+
+ procedure clear_values;
+ begin
+ value_u8bit := 0;
+ value_u16bit := 0;
+ value_s32bit := 0;
+ value_s32real := 0.0;
+ value_s64real := 0.0;
+ value_proc := nil;
+ value_ptr := nil;
+ fillchar(value_smallrec, sizeof(value_smallrec), #0);
+ fillchar(value_largerec, sizeof(value_largerec), #0);
+ value_smallset := [];
+ value_smallstring := '';
+ value_bigstring := '';
+ value_largeset := [];
+ fillchar(value_smallarray, sizeof(value_smallarray), #0);
+ value_boolean := false;
+ value_char:=#0;
+ value_ansistring := '';
+ value_s64bit := 0;
+ end;
+
+
+ function getu8: byte;
+ begin
+ getu8 := RESULT_U8BIT;
+ end;
+
+
+type
+
+ { object without vmt }
+ pnovmtobject = ^tnovmtobject;
+ tnovmtobject = object
+ public
+ object_bigstring : shortstring;
+ object_u16bit : word;
+ { no parameter testing }
+ procedure method_public_none;cdecl;
+ procedure method_public_static_none; static;cdecl;
+ procedure method_call_private_none;cdecl;
+ procedure method_call_private_static_none; static;cdecl;
+ { simple value parameter testing }
+ procedure method_public_u8(x : byte);cdecl;
+ procedure method_public_static_u8(x: byte); static;cdecl;
+ procedure method_call_private_u8(x: byte);cdecl;
+ procedure method_call_private_static_u8(x: byte); static;cdecl;
+ function func_array_mixed_nested(b: byte): tsmallarray;cdecl;
+ private
+ procedure method_private_none;cdecl;
+ procedure method_private_static_none; static;cdecl;
+ function func_getu16bit : word;cdecl;
+ { simple value parameter testing }
+ procedure method_private_u8(x: byte);cdecl;
+ procedure method_private_static_u8(x: byte); static;cdecl;
+ end;
+
+
+ { object with vmt }
+ pvmtobject = ^tvmtobject;
+ tvmtobject = object
+ public
+ object_u8bit : byte;
+ object_u16bit : word;
+ object_bigstring : shortstring;
+ object_s32bit : longint;
+ object_s64bit : int64;
+ constructor constructor_params_mixed(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);
+ constructor constructor_init;
+ destructor destructor_params_done;
+ procedure method_normal_params_mixed(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);cdecl;
+ procedure method_virtual_params_mixed(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);virtual;
+ procedure method_virtual_overriden_params_mixed(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);virtual;
+ procedure method_static_params_mixed(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);static;cdecl;
+ procedure method_normal_call_inherited_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);cdecl;
+
+ { virtual methods which call other methods }
+ procedure method_virtual_call_static_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;
+ procedure method_virtual_call_virtual_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;
+ procedure method_virtual_call_overriden_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;
+ procedure method_virtual_call_normal_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;
+ procedure method_virtual_call_constructor_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;
+ procedure method_virtual_call_inherited_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;
+
+ end;
+
+ pheritedvmtobject = ^theritedvmtobject;
+ theritedvmtobject = object(tvmtobject)
+ constructor constructor_params_mixed_call_virtual(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);
+ constructor constructor_params_mixed_call_overriden(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);
+ constructor constructor_params_mixed_call_static(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);
+ constructor constructor_params_mixed_call_normal(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);
+ constructor constructor_params_mixed_call_inherited(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);
+ procedure method_virtual_overriden_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;
+
+ { normal methods which call other methods }
+ procedure method_normal_call_static_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);cdecl;
+ procedure method_normal_call_virtual_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);cdecl;
+ procedure method_normal_call_overriden_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);cdecl;
+ procedure method_normal_call_normal_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);cdecl;
+ procedure method_normal_call_constructor_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);cdecl;
+ procedure method_normal_call_inherited_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);cdecl;
+
+ { virtual methods which call other methods }
+ procedure method_virtual_call_inherited_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;
+
+ end;
+
+ pfailvmtobject = ^tfailvmtobject;
+ tfailvmtobject = object(tvmtobject)
+ public
+ constructor constructor_public_none;
+ end;
+
+
+
+{**************************************************************************}
+{ NO VMT OBJECT }
+{**************************************************************************}
+
+ {****************** NO PARAMETERS ******************}
+ procedure tnovmtobject.method_public_none;cdecl;
+ begin
+ global_u8bit := RESULT_U8BIT;
+ end;
+
+
+ procedure tnovmtobject.method_public_static_none;cdecl;
+ begin
+ global_u8bit := RESULT_U8BIT;
+ end;
+
+
+ procedure tnovmtobject.method_call_private_none;cdecl;
+ begin
+ method_private_none;
+ method_private_static_none;
+ end;
+
+ procedure tnovmtobject.method_call_private_static_none;cdecl;
+ begin
+ method_private_static_none;
+ end;
+
+
+ procedure tnovmtobject.method_private_none;cdecl;
+ begin
+ Inc(global_u16bit, RESULT_U8BIT);
+ end;
+
+
+ procedure tnovmtobject.method_private_static_none;cdecl;
+ begin
+ Inc(global_u16bit, RESULT_U8BIT);
+ end;
+
+ {******************** PARAMETERS ******************}
+
+ procedure tnovmtobject.method_public_u8(x : byte);cdecl;
+ begin
+ global_u8bit := x;
+ end;
+
+ procedure tnovmtobject.method_public_static_u8(x: byte);cdecl;
+ begin
+ global_u8bit := x;
+ end;
+
+ procedure tnovmtobject.method_call_private_u8(x: byte);cdecl;
+ begin
+ method_private_static_u8(x);
+ method_private_u8(x);
+ end;
+
+ procedure tnovmtobject. method_call_private_static_u8(x: byte);cdecl;
+ begin
+ method_private_static_u8(x);
+ end;
+
+ procedure tnovmtobject.method_private_u8(x: byte);cdecl;
+ begin
+ Inc(global_u16bit,x);
+ end;
+
+ procedure tnovmtobject.method_private_static_u8(x: byte);cdecl;
+ begin
+ Inc(global_u16bit,x);
+ end;
+
+
+ function tnovmtobject.func_getu16bit : word;cdecl;
+ begin
+ func_getu16bit := object_u16bit;
+ end;
+
+ {
+ complex testing, nested field access, with parameters and
+ comple return value.
+
+ On exit : global_u8bit := x;
+ global_u16bit := object_u16bit (from func_getu16bit);
+ global_s32bit := RESULT_S32BIT
+ global_bigstring := object_bigstring
+ global_s64bit := x;
+ }
+ function tnovmtobject.func_array_mixed_nested(b: byte): tsmallarray;cdecl;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := func_getu16bit;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ smallarray: tsmallarray;
+ begin
+ fillchar(smallarray, sizeof(smallarray), #0);
+ smallarray[1] := RESULT_U8BIT;
+ smallarray[SMALL_INDEX] := RESULT_U8BIT;
+ func_array_mixed_nested := smallarray;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, object_bigstring);
+ end;
+
+{**************************************************************************}
+{ FAILED OBJECT }
+{**************************************************************************}
+constructor tfailvmtobject.constructor_public_none;
+ begin
+ { this calls the constructor fail special keyword }
+ fail;
+ end;
+
+{**************************************************************************}
+{ VMT OBJECT }
+{**************************************************************************}
+constructor tvmtobject.constructor_params_mixed(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);
+ begin
+ object_u8bit := u8;
+ object_u16bit := u16;
+ object_bigstring := bigstring;
+ object_s32bit := s32;
+ object_s64bit := s64;
+ end;
+
+
+constructor tvmtobject.constructor_init;
+ begin
+ object_u8bit := 0;
+ object_u16bit := 0;
+ object_bigstring := '';
+ object_s32bit := 0;
+ object_s64bit := 0;
+ end;
+
+destructor tvmtobject.destructor_params_done;
+ begin
+ object_u8bit := 0;
+ object_u16bit := 0;
+ object_bigstring := '';
+ object_s32bit := 0;
+ object_s64bit := 0;
+ end;
+
+
+procedure tvmtobject.method_normal_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);cdecl;
+ begin
+ object_u8bit := u8;
+ object_u16bit := u16;
+ object_bigstring := bigstring;
+ object_s32bit := s32;
+ object_s64bit := s64;
+ end;
+
+procedure tvmtobject.method_virtual_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
+ begin
+ object_u8bit := u8;
+ object_u16bit := u16;
+ object_bigstring := bigstring;
+ object_s32bit := s32;
+ object_s64bit := s64;
+ end;
+
+{ this one should be overriden }
+procedure tvmtobject.method_virtual_overriden_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
+ begin
+ RunError(211);
+ end;
+
+{ can't access field of instances in static methods }
+procedure tvmtobject.method_static_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);cdecl;
+ begin
+ global_u8bit := u8;
+ global_u16bit := u16;
+ global_bigstring := bigstring;
+ global_s32bit := s32;
+ global_s64bit := s64;
+ end;
+
+procedure tvmtobject.method_normal_call_inherited_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);cdecl;
+ begin
+ object_u8bit := u8;
+ object_u16bit := u16;
+ object_bigstring := bigstring;
+ object_s32bit := s32;
+ object_s64bit := s64;
+ end;
+
+
+procedure tvmtobject.method_virtual_call_static_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
+ begin
+ method_static_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+procedure tvmtobject.method_virtual_call_virtual_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
+ begin
+ method_virtual_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+procedure tvmtobject.method_virtual_call_overriden_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
+ begin
+ method_virtual_overriden_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+
+procedure tvmtobject.method_virtual_call_normal_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
+ begin
+ method_normal_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+procedure tvmtobject.method_virtual_call_constructor_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
+ begin
+ constructor_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+procedure tvmtobject.method_virtual_call_inherited_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
+ begin
+ object_u8bit := u8;
+ object_u16bit := u16;
+ object_bigstring := bigstring;
+ object_s32bit := s32;
+ object_s64bit := s64;
+ end;
+
+
+{**************************************************************************}
+{ INHERITED VMT OBJECT }
+{**************************************************************************}
+constructor theritedvmtobject.constructor_params_mixed_call_virtual(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
+ begin
+ object_u8bit := 0;
+ object_u16bit := 0;
+ object_bigstring := '';
+ object_s32bit := 0;
+ object_s64bit := 0;
+ method_virtual_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+constructor theritedvmtobject.constructor_params_mixed_call_overriden(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
+ begin
+ object_u8bit := 0;
+ object_u16bit := 0;
+ object_bigstring := '';
+ object_s32bit := 0;
+ object_s64bit := 0;
+ method_virtual_overriden_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+constructor theritedvmtobject.constructor_params_mixed_call_static(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
+ begin
+ object_u8bit := 0;
+ object_u16bit := 0;
+ object_bigstring := '';
+ object_s32bit := 0;
+ object_s64bit := 0;
+ method_static_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+constructor theritedvmtobject.constructor_params_mixed_call_normal(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
+ begin
+ object_u8bit := 0;
+ object_u16bit := 0;
+ object_bigstring := '';
+ object_s32bit := 0;
+ object_s64bit := 0;
+ method_normal_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+constructor theritedvmtobject.constructor_params_mixed_call_inherited
+ (u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
+ begin
+ object_u8bit := 0;
+ object_u16bit := 0;
+ object_bigstring := '';
+ object_s32bit := 0;
+ object_s64bit := 0;
+ inherited constructor_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+{ this one should be overriden }
+procedure theritedvmtobject.method_virtual_overriden_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
+ begin
+ object_u8bit := u8;
+ object_u16bit := u16;
+ object_bigstring := bigstring;
+ object_s32bit := s32;
+ object_s64bit := s64;
+ end;
+
+procedure theritedvmtobject.method_normal_call_static_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);cdecl;
+ begin
+ method_static_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+procedure theritedvmtobject.method_normal_call_virtual_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);cdecl;
+ begin
+ method_virtual_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+procedure theritedvmtobject.method_normal_call_overriden_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);cdecl;
+ begin
+ method_virtual_overriden_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+
+procedure theritedvmtobject.method_normal_call_normal_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);cdecl;
+ begin
+ method_normal_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+procedure theritedvmtobject.method_normal_call_constructor_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);cdecl;
+ begin
+ constructor_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+procedure theritedvmtobject.method_normal_call_inherited_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);cdecl;
+ begin
+ Inherited method_normal_call_inherited_params_mixed(u8, u16, bigstring,
+ s32, s64);
+ end;
+
+procedure theritedvmtobject.method_virtual_call_inherited_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
+ begin
+ Inherited method_virtual_call_inherited_params_mixed(u8, u16, bigstring,
+ s32, s64);
+ end;
+
+
+procedure testnovmtobject;
+var
+ novmtobject : tnovmtobject;
+ failed : boolean;
+begin
+ {******************** STATIC / METHOD SIMPLE CALL **********************}
+ Write('No parameter / method call testing...');
+ failed := false;
+
+ clear_globals;
+ clear_values;
+
+ tnovmtobject.method_public_static_none;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ novmtobject.method_public_static_none;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ tnovmtobject.method_call_private_static_none;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_call_private_static_none;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_public_none;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_call_private_none;
+ if global_u16bit <> (RESULT_U16BIT) then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ Write('Simple parameter (LOC_CONSTANT) / method call testing...');
+ failed := false;
+
+ clear_globals;
+ clear_values;
+
+ { parameter is LOC_CONSTANT }
+ novmtobject.method_public_u8(RESULT_U8BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ tnovmtobject.method_public_static_u8(RESULT_U8BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_public_static_u8(RESULT_U8BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_call_private_u8(RESULT_U8BIT);
+ if global_u16bit <> (RESULT_U16BIT) then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_call_private_static_u8(RESULT_U8BIT);
+ if global_u16bit <> (RESULT_U8BIT) then
+ failed := true;
+
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+
+ Write('Simple parameter (LOC_REFERENCE) / method call testing...');
+ failed := false;
+
+ clear_globals;
+ clear_values;
+
+ value_u8bit := RESULT_U8BIT;
+ novmtobject.method_public_u8(value_u8bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ value_u8bit := RESULT_U8BIT;
+ tnovmtobject.method_public_static_u8(value_u8bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ value_u8bit := RESULT_U8BIT;
+ novmtobject.method_public_static_u8(value_u8bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ value_u8bit := RESULT_U8BIT;
+ novmtobject.method_call_private_u8(value_u8bit);
+ if global_u16bit <> (RESULT_U16BIT) then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ value_u8bit := RESULT_U8BIT;
+ novmtobject.method_call_private_static_u8(value_u8bit);
+ if global_u16bit <> (RESULT_U8BIT) then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ Write('Simple parameter (LOC_REGISTER) / method call testing...');
+ failed := false;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_public_u8(getu8);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ tnovmtobject.method_public_static_u8(getu8);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_public_static_u8(getu8);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_call_private_u8(getu8);
+ if global_u16bit <> (RESULT_U16BIT) then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_call_private_static_u8(getu8);
+ if global_u16bit <> (RESULT_U8BIT) then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ Write('Simple parameter / complex return / nested method access testing...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+ novmtobject.object_bigstring := RESULT_BIGSTRING;
+ novmtobject.object_u16bit := RESULT_U16BIT;
+
+ value_smallarray := novmtobject.func_array_mixed_nested(RESULT_U8BIT);
+ if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+end;
+
+
+procedure testfailedobject;
+var
+ failedobject : tfailvmtobject;
+ begin
+ Write('Testing constructor return value...');
+ if failedobject.constructor_public_none then
+ fail
+ else
+ Writeln('Passed!');
+ end;
+
+
+ procedure testvmtobject;
+ var
+ vmtobject : tvmtobject;
+ failed : boolean;
+ begin
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call...');
+ vmtobject.constructor_params_mixed(RESULT_U8BIT, RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.constructor_params_mixed(value_u8bit, value_u16bit, value_bigstring,
+ value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ end;
+
+
+ procedure testheritedvmtobject;
+ var
+ vmtobject : theritedvmtobject;
+ failed : boolean;
+ begin
+ {********************** CONSTRUCTOR TESTING ************************}
+ {********************** DESTRUCTOR TESTING ************************}
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) inherited constructor call...');
+ vmtobject.constructor_params_mixed_call_inherited(RESULT_U8BIT, RESULT_U16BIT, RESULT_BIGSTRING,
+ RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) inherited constructor call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.constructor_params_mixed_call_inherited(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
+ vmtobject.constructor_params_mixed_call_virtual(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.constructor_params_mixed_call_virtual(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
+ vmtobject.constructor_params_mixed_call_overriden(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.constructor_params_mixed_call_overriden(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/method call...');
+ vmtobject.constructor_params_mixed_call_normal(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.constructor_params_mixed_call_normal(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/static call...');
+ vmtobject.constructor_params_mixed_call_static(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/static call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.constructor_params_mixed_call_static(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ {************************* METHOD TESTING **************************}
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
+ vmtobject.method_virtual_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_virtual_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
+ vmtobject.method_virtual_overriden_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_virtual_overriden_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call...');
+ vmtobject.method_normal_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_normal_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) static method call...');
+ vmtobject.method_static_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) static method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_static_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { ********************************************************************
+ This calls methods which in turn call other methods, or a constructor
+ or a destructor.
+ *********************************************************************
+ }
+ clear_globals;
+ clear_values;
+ failed := false;
+ { Calls the ancestor virtual method }
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
+ vmtobject.method_normal_call_virtual_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_normal_call_virtual_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { The virtual method has been overriden by the object in this case }
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
+ vmtobject.method_normal_call_overriden_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_normal_call_overriden_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/normal call...');
+ vmtobject.method_normal_call_normal_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/normal call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_normal_call_normal_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ (* constructor call inside a normal method *)
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/constructor call...');
+ vmtobject.method_normal_call_constructor_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/constructor call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_normal_call_constructor_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { static method call }
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/static call...');
+ vmtobject.method_normal_call_static_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/static call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_normal_call_static_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ (* calls the inherited method *)
+ clear_globals;
+ clear_values;
+ failed := false;
+ { Calls the ancestor virtual method }
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/inherited call...');
+ vmtobject.method_normal_call_inherited_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/inherited call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_normal_call_inherited_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { ********************************************************************
+ This calls virtual methods which in turn call other methods,
+ or a constructor or a destructor.
+ *********************************************************************
+ }
+ clear_globals;
+ clear_values;
+ failed := false;
+ { Calls the ancestor virtual method }
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
+ vmtobject.method_virtual_call_virtual_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_virtual_call_virtual_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { The virtual method has been overriden by the object in this case }
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
+ vmtobject.method_virtual_call_overriden_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_virtual_call_overriden_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/normal call...');
+ vmtobject.method_virtual_call_normal_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/normal call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_virtual_call_normal_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ (* constructor call inside a normal method *)
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/constructor call...');
+ vmtobject.method_virtual_call_constructor_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/constructor call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_virtual_call_constructor_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { static virtual call }
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/static call...');
+ vmtobject.method_virtual_call_static_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/static call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_virtual_call_static_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ (* calls the inherited method *)
+ clear_globals;
+ clear_values;
+ failed := false;
+ { Calls the ancestor virtual method }
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/inherited call...');
+ vmtobject.method_virtual_call_inherited_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/inherited call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_virtual_call_inherited_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+
+ end;
+
+ { same as testvmtherited, except uses with statement }
+ procedure testwith;
+ var
+ vmtobject : theritedvmtobject;
+ failed : boolean;
+ begin
+ with vmtobject do
+ begin
+ {********************** CONSTRUCTOR TESTING ************************}
+ {********************** DESTRUCTOR TESTING ************************}
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) inherited constructor call...');
+ constructor_params_mixed_call_inherited(RESULT_U8BIT, RESULT_U16BIT, RESULT_BIGSTRING,
+ RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) inherited constructor call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ constructor_params_mixed_call_inherited(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
+ constructor_params_mixed_call_virtual(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ constructor_params_mixed_call_virtual(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
+ constructor_params_mixed_call_overriden(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ constructor_params_mixed_call_overriden(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/method call...');
+ constructor_params_mixed_call_normal(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ constructor_params_mixed_call_normal(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/static call...');
+ constructor_params_mixed_call_static(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/static call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ constructor_params_mixed_call_static(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ {************************* METHOD TESTING **************************}
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
+ method_virtual_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_virtual_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
+ method_virtual_overriden_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_virtual_overriden_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call...');
+ method_normal_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_normal_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) static method call...');
+ method_static_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) static method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_static_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { ********************************************************************
+ This calls methods which in turn call other methods, or a constructor
+ or a destructor.
+ *********************************************************************
+ }
+ clear_globals;
+ clear_values;
+ failed := false;
+ { Calls the ancestor virtual method }
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
+ method_normal_call_virtual_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_normal_call_virtual_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { The virtual method has been overriden by the object in this case }
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
+ method_normal_call_overriden_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_normal_call_overriden_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/normal call...');
+ method_normal_call_normal_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/normal call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_normal_call_normal_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ (* constructor call inside a normal method *)
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/constructor call...');
+ method_normal_call_constructor_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/constructor call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_normal_call_constructor_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { static method call }
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/static call...');
+ method_normal_call_static_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/static call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_normal_call_static_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ (* calls the inherited method *)
+ clear_globals;
+ clear_values;
+ failed := false;
+ { Calls the ancestor virtual method }
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/inherited call...');
+ method_normal_call_inherited_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/inherited call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_normal_call_inherited_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { ********************************************************************
+ This calls virtual methods which in turn call other methods,
+ or a constructor or a destructor.
+ *********************************************************************
+ }
+ clear_globals;
+ clear_values;
+ failed := false;
+ { Calls the ancestor virtual method }
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
+ method_virtual_call_virtual_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_virtual_call_virtual_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { The virtual method has been overriden by the object in this case }
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
+ method_virtual_call_overriden_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_virtual_call_overriden_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/normal call...');
+ method_virtual_call_normal_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/normal call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_virtual_call_normal_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ (* constructor call inside a normal method *)
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/constructor call...');
+ method_virtual_call_constructor_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/constructor call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_virtual_call_constructor_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { static virtual call }
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/static call...');
+ method_virtual_call_static_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/static call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_virtual_call_static_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ (* calls the inherited method *)
+ clear_globals;
+ clear_values;
+ failed := false;
+ { Calls the ancestor virtual method }
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/inherited call...');
+ method_virtual_call_inherited_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/inherited call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_virtual_call_inherited_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+ end; { end with }
+ end;
+
+
+begin
+ WriteLN('*********************** NO VMT OBJECT TESTS ********************');
+ testnovmtobject;
+ WriteLN('************************ VMT OBJECT FAIL **********************');
+ testfailedobject;
+ WriteLN('************************* VMT OBJECT TESTS *********************');
+ testvmtobject;
+ testheritedvmtobject;
+ WriteLN('**************** VMT OBJECT TESTS USING WITH *******************');
+ testwith;
+end.
+
+{
$Log$
- Revision 1.9 2003-04-22 10:24:29 florian
+ Revision 1.10 2004-05-02 12:11:44 peter
+ * fixed linefeeds
+
+ Revision 1.9 2003/04/22 10:24:29 florian
* fixed defines for powerpc
-
- Revision 1.8 2002/12/29 15:30:55 peter
- * updated for 1.1 compiler that does not allow calling conventions
- for constructor/destructor
-
- Revision 1.7 2002/10/29 20:44:30 carl
- * updated with corrects testing (removed cdecl in constructors)
-
- Revision 1.6 2002/10/21 19:21:28 carl
- * only test on version 1.1 +
-
- Revision 1.5 2002/10/21 19:07:08 carl
- + reinstate test
- - remove virtual method calls
-
- Revision 1.4 2002/10/21 08:03:14 pierre
- * added %FAIL because cdecl and virtual are not compatible
-
- Revision 1.3 2002/09/07 15:40:53 peter
- * old logs removed and tabs fixed
-
- Revision 1.2 2002/05/05 19:13:19 carl
- + withsymtable checking
-
- Revision 1.1 2002/05/05 13:58:50 carl
- + finished procedural variable testsuit
- + finished method testsuit
-
-}
+
+ Revision 1.8 2002/12/29 15:30:55 peter
+ * updated for 1.1 compiler that does not allow calling conventions
+ for constructor/destructor
+
+ Revision 1.7 2002/10/29 20:44:30 carl
+ * updated with corrects testing (removed cdecl in constructors)
+
+ Revision 1.6 2002/10/21 19:21:28 carl
+ * only test on version 1.1 +
+
+ Revision 1.5 2002/10/21 19:07:08 carl
+ + reinstate test
+ - remove virtual method calls
+
+ Revision 1.4 2002/10/21 08:03:14 pierre
+ * added %FAIL because cdecl and virtual are not compatible
+
+ Revision 1.3 2002/09/07 15:40:53 peter
+ * old logs removed and tabs fixed
+
+ Revision 1.2 2002/05/05 19:13:19 carl
+ + withsymtable checking
+
+ Revision 1.1 2002/05/05 13:58:50 carl
+ + finished procedural variable testsuit
+ + finished method testsuit
+
+}
diff --git a/tests/test/cg/tcalobj5.pp b/tests/test/cg/tcalobj5.pp
index 51270e5594..68447a2285 100644
--- a/tests/test/cg/tcalobj5.pp
+++ b/tests/test/cg/tcalobj5.pp
@@ -1,3314 +1,3317 @@
-{****************************************************************}
-{ CODE GENERATOR TEST PROGRAM }
-{ Copyright (c) 2002 Carl Eric Codere }
-{****************************************************************}
-{ NODE TESTED : secondcalln() }
-{****************************************************************}
-{ PRE-REQUISITES: secondload() }
-{ secondassign() }
-{ secondtypeconv() }
-{ secondtryexcept() }
-{****************************************************************}
-{ DEFINES: }
-{ FPC = Target is FreePascal compiler }
-{****************************************************************}
-{ REMARKS: This tests secondcalln(), genentrycode() and }
-{ genexitcode() for standard object with the safecall }
-{ calling convention. }
-{ }
-{****************************************************************}
-program tcalobj5;
-{$STATIC ON}
-{$R+}
-
- const
- { should be defined depending on CPU target }
- {$ifdef cpu68k}
- BIG_INDEX = 8000;
- SMALL_INDEX = 13;
- {$else}
- BIG_INDEX = 33000;
- SMALL_INDEX = 13; { value should not be aligned! }
- {$endif}
- RESULT_U8BIT = $55;
- RESULT_U16BIT = 2*RESULT_U8BIT;
- RESULT_S32BIT = $500F0000;
- RESULT_S64BIT = $500F0000;
- RESULT_S32REAL = 1777.12;
- RESULT_S64REAL = 3444.24;
- RESULT_BOOL8BIT = 1;
- RESULT_BOOL16BIT = 1;
- RESULT_BOOL32BIT = 1;
- RESULT_PCHAR = 'Hello world';
- RESULT_BIGSTRING = 'Hello world';
- RESULT_SMALLSTRING = 'H';
- RESULT_CHAR = 'I';
- RESULT_BOOLEAN = TRUE;
-
- type
-
- tprocedure = procedure;
-
- tsmallrecord = packed record
- b: byte;
- w: word;
- end;
-
- tlargerecord = packed record
- b: array[1..BIG_INDEX] of byte;
- end;
-
- tsmallarray = packed array[1..SMALL_INDEX] of byte;
-
- tsmallsetenum =
- (A_A,A_B,A_C,A_D);
-
- tsmallset = set of tsmallsetenum;
- tlargeset = set of char;
-
- tsmallstring = string[2];
-
-
- var
- global_u8bit : byte;
- global_u16bit : word;
- global_s32bit : longint;
- global_s32real : single;
- global_s64real : double;
- global_ptr : pchar;
- global_proc : tprocedure;
- global_bigstring : shortstring;
- global_boolean : boolean;
- global_char : char;
- global_s64bit : int64;
- value_s64bit : int64;
- value_ansistring : ansistring;
- value_u8bit : byte;
- value_u16bit : word;
- value_s32bit : longint;
- value_s32real : single;
- value_s64real : double;
- value_proc : tprocedure;
- value_ptr : pchar;
- value_smallrec : tsmallrecord;
- value_largerec : tlargerecord;
- value_smallset : tsmallset;
- value_smallstring : tsmallstring;
- value_bigstring : shortstring;
- value_largeset : tlargeset;
- value_smallarray : tsmallarray;
- value_boolean : boolean;
- value_char : char;
-
- procedure fail;
- begin
- WriteLn('Failure.');
- halt(1);
- end;
-
-
- procedure clear_globals;
- begin
- global_u8bit := 0;
- global_u16bit := 0;
- global_s32bit := 0;
- global_s32real := 0.0;
- global_s64real := 0.0;
- global_ptr := nil;
- global_proc := nil;
- global_bigstring := '';
- global_boolean := false;
- global_char := #0;
- global_s64bit := 0;
- end;
-
-
- procedure clear_values;
- begin
- value_u8bit := 0;
- value_u16bit := 0;
- value_s32bit := 0;
- value_s32real := 0.0;
- value_s64real := 0.0;
- value_proc := nil;
- value_ptr := nil;
- fillchar(value_smallrec, sizeof(value_smallrec), #0);
- fillchar(value_largerec, sizeof(value_largerec), #0);
- value_smallset := [];
- value_smallstring := '';
- value_bigstring := '';
- value_largeset := [];
- fillchar(value_smallarray, sizeof(value_smallarray), #0);
- value_boolean := false;
- value_char:=#0;
- value_ansistring := '';
- value_s64bit := 0;
- end;
-
-
- function getu8: byte;
- begin
- getu8 := RESULT_U8BIT;
- end;
-
-
-type
-
- { object without vmt }
- pnovmtobject = ^tnovmtobject;
- tnovmtobject = object
- public
- object_bigstring : shortstring;
- object_u16bit : word;
- { no parameter testing }
- procedure method_public_none;safecall;
- procedure method_public_static_none; static;safecall;
- procedure method_call_private_none;safecall;
- procedure method_call_private_static_none; static;safecall;
- { simple value parameter testing }
- procedure method_public_u8(x : byte);safecall;
- procedure method_public_static_u8(x: byte); static;safecall;
- procedure method_call_private_u8(x: byte);safecall;
- procedure method_call_private_static_u8(x: byte); static;safecall;
- function func_array_mixed_nested(b: byte): tsmallarray;safecall;
- private
- procedure method_private_none;safecall;
- procedure method_private_static_none; static;safecall;
- function func_getu16bit : word;safecall;
- { simple value parameter testing }
- procedure method_private_u8(x: byte);safecall;
- procedure method_private_static_u8(x: byte); static;safecall;
- end;
-
-
- { object with vmt }
- pvmtobject = ^tvmtobject;
- tvmtobject = object
- public
- object_u8bit : byte;
- object_u16bit : word;
- object_bigstring : shortstring;
- object_s32bit : longint;
- object_s64bit : int64;
- constructor constructor_params_mixed(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);
- constructor constructor_init;
- destructor destructor_params_done;
- procedure method_normal_params_mixed(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);safecall;
- procedure method_virtual_params_mixed(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);virtual;safecall;
- procedure method_virtual_overriden_params_mixed(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);virtual;safecall;
- procedure method_static_params_mixed(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);static;safecall;
- procedure method_normal_call_inherited_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
-
- { virtual methods which call other methods }
- procedure method_virtual_call_static_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;safecall;
- procedure method_virtual_call_virtual_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;safecall;
- procedure method_virtual_call_overriden_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;safecall;
- procedure method_virtual_call_normal_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;safecall;
- procedure method_virtual_call_constructor_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;safecall;
- procedure method_virtual_call_inherited_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;safecall;
-
- end;
-
- pheritedvmtobject = ^theritedvmtobject;
- theritedvmtobject = object(tvmtobject)
- constructor constructor_params_mixed_call_virtual(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);
- constructor constructor_params_mixed_call_overriden(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);
- constructor constructor_params_mixed_call_static(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);
- constructor constructor_params_mixed_call_normal(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);
- constructor constructor_params_mixed_call_inherited(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);
- procedure method_virtual_overriden_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;safecall;
-
- { normal methods which call other methods }
- procedure method_normal_call_static_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
- procedure method_normal_call_virtual_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
- procedure method_normal_call_overriden_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
- procedure method_normal_call_normal_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
- procedure method_normal_call_constructor_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
- procedure method_normal_call_inherited_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
-
- { virtual methods which call other methods }
- procedure method_virtual_call_inherited_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;safecall;
-
- end;
-
- pfailvmtobject = ^tfailvmtobject;
- tfailvmtobject = object(tvmtobject)
- public
- constructor constructor_public_none;
- end;
-
-
-
-{**************************************************************************}
-{ NO VMT OBJECT }
-{**************************************************************************}
-
- {****************** NO PARAMETERS ******************}
- procedure tnovmtobject.method_public_none;safecall;
- begin
- global_u8bit := RESULT_U8BIT;
- end;
-
-
- procedure tnovmtobject.method_public_static_none;safecall;
- begin
- global_u8bit := RESULT_U8BIT;
- end;
-
-
- procedure tnovmtobject.method_call_private_none;safecall;
- begin
- method_private_none;
- method_private_static_none;
- end;
-
- procedure tnovmtobject.method_call_private_static_none;safecall;
- begin
- method_private_static_none;
- end;
-
-
- procedure tnovmtobject.method_private_none;safecall;
- begin
- Inc(global_u16bit, RESULT_U8BIT);
- end;
-
-
- procedure tnovmtobject.method_private_static_none;safecall;
- begin
- Inc(global_u16bit, RESULT_U8BIT);
- end;
-
- {******************** PARAMETERS ******************}
-
- procedure tnovmtobject.method_public_u8(x : byte);safecall;
- begin
- global_u8bit := x;
- end;
-
- procedure tnovmtobject.method_public_static_u8(x: byte);safecall;
- begin
- global_u8bit := x;
- end;
-
- procedure tnovmtobject.method_call_private_u8(x: byte);safecall;
- begin
- method_private_static_u8(x);
- method_private_u8(x);
- end;
-
- procedure tnovmtobject. method_call_private_static_u8(x: byte);safecall;
- begin
- method_private_static_u8(x);
- end;
-
- procedure tnovmtobject.method_private_u8(x: byte);safecall;
- begin
- Inc(global_u16bit,x);
- end;
-
- procedure tnovmtobject.method_private_static_u8(x: byte);safecall;
- begin
- Inc(global_u16bit,x);
- end;
-
-
- function tnovmtobject.func_getu16bit : word;safecall;
- begin
- func_getu16bit := object_u16bit;
- end;
-
- {
- complex testing, nested field access, with parameters and
- comple return value.
-
- On exit : global_u8bit := x;
- global_u16bit := object_u16bit (from func_getu16bit);
- global_s32bit := RESULT_S32BIT
- global_bigstring := object_bigstring
- global_s64bit := x;
- }
- function tnovmtobject.func_array_mixed_nested(b: byte): tsmallarray;safecall;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := func_getu16bit;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- smallarray: tsmallarray;
- begin
- fillchar(smallarray, sizeof(smallarray), #0);
- smallarray[1] := RESULT_U8BIT;
- smallarray[SMALL_INDEX] := RESULT_U8BIT;
- func_array_mixed_nested := smallarray;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, object_bigstring);
- end;
-
-{**************************************************************************}
-{ FAILED OBJECT }
-{**************************************************************************}
-constructor tfailvmtobject.constructor_public_none;
- begin
- { this calls the constructor fail special keyword }
- fail;
- end;
-
-{**************************************************************************}
-{ VMT OBJECT }
-{**************************************************************************}
-constructor tvmtobject.constructor_params_mixed(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);
- begin
- object_u8bit := u8;
- object_u16bit := u16;
- object_bigstring := bigstring;
- object_s32bit := s32;
- object_s64bit := s64;
- end;
-
-
-constructor tvmtobject.constructor_init;
- begin
- object_u8bit := 0;
- object_u16bit := 0;
- object_bigstring := '';
- object_s32bit := 0;
- object_s64bit := 0;
- end;
-
-destructor tvmtobject.destructor_params_done;
- begin
- object_u8bit := 0;
- object_u16bit := 0;
- object_bigstring := '';
- object_s32bit := 0;
- object_s64bit := 0;
- end;
-
-
-procedure tvmtobject.method_normal_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
- begin
- object_u8bit := u8;
- object_u16bit := u16;
- object_bigstring := bigstring;
- object_s32bit := s32;
- object_s64bit := s64;
- end;
-
-procedure tvmtobject.method_virtual_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
- begin
- object_u8bit := u8;
- object_u16bit := u16;
- object_bigstring := bigstring;
- object_s32bit := s32;
- object_s64bit := s64;
- end;
-
-{ this one should be overriden }
-procedure tvmtobject.method_virtual_overriden_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
- begin
- RunError(211);
- end;
-
-{ can't access field of instances in static methods }
-procedure tvmtobject.method_static_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
- begin
- global_u8bit := u8;
- global_u16bit := u16;
- global_bigstring := bigstring;
- global_s32bit := s32;
- global_s64bit := s64;
- end;
-
-procedure tvmtobject.method_normal_call_inherited_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
- begin
- object_u8bit := u8;
- object_u16bit := u16;
- object_bigstring := bigstring;
- object_s32bit := s32;
- object_s64bit := s64;
- end;
-
-
-procedure tvmtobject.method_virtual_call_static_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
- begin
- method_static_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-procedure tvmtobject.method_virtual_call_virtual_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
- begin
- method_virtual_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-procedure tvmtobject.method_virtual_call_overriden_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
- begin
- method_virtual_overriden_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-
-procedure tvmtobject.method_virtual_call_normal_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
- begin
- method_normal_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-procedure tvmtobject.method_virtual_call_constructor_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
- begin
- constructor_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-procedure tvmtobject.method_virtual_call_inherited_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
- begin
- object_u8bit := u8;
- object_u16bit := u16;
- object_bigstring := bigstring;
- object_s32bit := s32;
- object_s64bit := s64;
- end;
-
-
-{**************************************************************************}
-{ INHERITED VMT OBJECT }
-{**************************************************************************}
-constructor theritedvmtobject.constructor_params_mixed_call_virtual(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
- begin
- object_u8bit := 0;
- object_u16bit := 0;
- object_bigstring := '';
- object_s32bit := 0;
- object_s64bit := 0;
- method_virtual_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-constructor theritedvmtobject.constructor_params_mixed_call_overriden(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
- begin
- object_u8bit := 0;
- object_u16bit := 0;
- object_bigstring := '';
- object_s32bit := 0;
- object_s64bit := 0;
- method_virtual_overriden_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-constructor theritedvmtobject.constructor_params_mixed_call_static(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
- begin
- object_u8bit := 0;
- object_u16bit := 0;
- object_bigstring := '';
- object_s32bit := 0;
- object_s64bit := 0;
- method_static_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-constructor theritedvmtobject.constructor_params_mixed_call_normal(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
- begin
- object_u8bit := 0;
- object_u16bit := 0;
- object_bigstring := '';
- object_s32bit := 0;
- object_s64bit := 0;
- method_normal_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-constructor theritedvmtobject.constructor_params_mixed_call_inherited
- (u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
- begin
- object_u8bit := 0;
- object_u16bit := 0;
- object_bigstring := '';
- object_s32bit := 0;
- object_s64bit := 0;
- inherited constructor_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-{ this one should be overriden }
-procedure theritedvmtobject.method_virtual_overriden_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
- begin
- object_u8bit := u8;
- object_u16bit := u16;
- object_bigstring := bigstring;
- object_s32bit := s32;
- object_s64bit := s64;
- end;
-
-procedure theritedvmtobject.method_normal_call_static_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
- begin
- method_static_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-procedure theritedvmtobject.method_normal_call_virtual_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
- begin
- method_virtual_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-procedure theritedvmtobject.method_normal_call_overriden_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
- begin
- method_virtual_overriden_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-
-procedure theritedvmtobject.method_normal_call_normal_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
- begin
- method_normal_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-procedure theritedvmtobject.method_normal_call_constructor_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
- begin
- constructor_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-procedure theritedvmtobject.method_normal_call_inherited_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
- begin
- Inherited method_normal_call_inherited_params_mixed(u8, u16, bigstring,
- s32, s64);
- end;
-
-procedure theritedvmtobject.method_virtual_call_inherited_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
- begin
- Inherited method_virtual_call_inherited_params_mixed(u8, u16, bigstring,
- s32, s64);
- end;
-
-
-procedure testnovmtobject;
-var
- novmtobject : tnovmtobject;
- failed : boolean;
-begin
- {******************** STATIC / METHOD SIMPLE CALL **********************}
- Write('No parameter / method call testing...');
- failed := false;
-
- clear_globals;
- clear_values;
-
- tnovmtobject.method_public_static_none;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- novmtobject.method_public_static_none;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- tnovmtobject.method_call_private_static_none;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_call_private_static_none;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_public_none;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_call_private_none;
- if global_u16bit <> (RESULT_U16BIT) then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- Write('Simple parameter (LOC_CONSTANT) / method call testing...');
- failed := false;
-
- clear_globals;
- clear_values;
-
- { parameter is LOC_CONSTANT }
- novmtobject.method_public_u8(RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- tnovmtobject.method_public_static_u8(RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_public_static_u8(RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_call_private_u8(RESULT_U8BIT);
- if global_u16bit <> (RESULT_U16BIT) then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_call_private_static_u8(RESULT_U8BIT);
- if global_u16bit <> (RESULT_U8BIT) then
- failed := true;
-
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
-
- Write('Simple parameter (LOC_REFERENCE) / method call testing...');
- failed := false;
-
- clear_globals;
- clear_values;
-
- value_u8bit := RESULT_U8BIT;
- novmtobject.method_public_u8(value_u8bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- value_u8bit := RESULT_U8BIT;
- tnovmtobject.method_public_static_u8(value_u8bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- value_u8bit := RESULT_U8BIT;
- novmtobject.method_public_static_u8(value_u8bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- value_u8bit := RESULT_U8BIT;
- novmtobject.method_call_private_u8(value_u8bit);
- if global_u16bit <> (RESULT_U16BIT) then
- failed := true;
-
- clear_globals;
- clear_values;
-
- value_u8bit := RESULT_U8BIT;
- novmtobject.method_call_private_static_u8(value_u8bit);
- if global_u16bit <> (RESULT_U8BIT) then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- Write('Simple parameter (LOC_REGISTER) / method call testing...');
- failed := false;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_public_u8(getu8);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- tnovmtobject.method_public_static_u8(getu8);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_public_static_u8(getu8);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_call_private_u8(getu8);
- if global_u16bit <> (RESULT_U16BIT) then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_call_private_static_u8(getu8);
- if global_u16bit <> (RESULT_U8BIT) then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- Write('Simple parameter / complex return / nested method access testing...');
-
- clear_globals;
- clear_values;
- failed := false;
- novmtobject.object_bigstring := RESULT_BIGSTRING;
- novmtobject.object_u16bit := RESULT_U16BIT;
-
- value_smallarray := novmtobject.func_array_mixed_nested(RESULT_U8BIT);
- if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-end;
-
-
-procedure testfailedobject;
-var
- failedobject : tfailvmtobject;
- begin
- Write('Testing constructor return value...');
- if failedobject.constructor_public_none then
- fail
- else
- Writeln('Passed!');
- end;
-
-
- procedure testvmtobject;
- var
- vmtobject : tvmtobject;
- failed : boolean;
- begin
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call...');
- vmtobject.constructor_params_mixed(RESULT_U8BIT, RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.constructor_params_mixed(value_u8bit, value_u16bit, value_bigstring,
- value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- end;
-
-
- procedure testheritedvmtobject;
- var
- vmtobject : theritedvmtobject;
- failed : boolean;
- begin
- {********************** CONSTRUCTOR TESTING ************************}
- {********************** DESTRUCTOR TESTING ************************}
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) inherited constructor call...');
- vmtobject.constructor_params_mixed_call_inherited(RESULT_U8BIT, RESULT_U16BIT, RESULT_BIGSTRING,
- RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) inherited constructor call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.constructor_params_mixed_call_inherited(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
- vmtobject.constructor_params_mixed_call_virtual(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.constructor_params_mixed_call_virtual(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
- vmtobject.constructor_params_mixed_call_overriden(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.constructor_params_mixed_call_overriden(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/method call...');
- vmtobject.constructor_params_mixed_call_normal(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.constructor_params_mixed_call_normal(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/static call...');
- vmtobject.constructor_params_mixed_call_static(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/static call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.constructor_params_mixed_call_static(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- {************************* METHOD TESTING **************************}
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
- vmtobject.method_virtual_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_virtual_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
- vmtobject.method_virtual_overriden_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_virtual_overriden_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call...');
- vmtobject.method_normal_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_normal_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) static method call...');
- vmtobject.method_static_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) static method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_static_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { ********************************************************************
- This calls methods which in turn call other methods, or a constructor
- or a destructor.
- *********************************************************************
- }
- clear_globals;
- clear_values;
- failed := false;
- { Calls the ancestor virtual method }
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
- vmtobject.method_normal_call_virtual_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_normal_call_virtual_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { The virtual method has been overriden by the object in this case }
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
- vmtobject.method_normal_call_overriden_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_normal_call_overriden_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/normal call...');
- vmtobject.method_normal_call_normal_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/normal call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_normal_call_normal_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- (* constructor call inside a normal method *)
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/constructor call...');
- vmtobject.method_normal_call_constructor_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/constructor call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_normal_call_constructor_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { static method call }
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/static call...');
- vmtobject.method_normal_call_static_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/static call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_normal_call_static_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- (* calls the inherited method *)
- clear_globals;
- clear_values;
- failed := false;
- { Calls the ancestor virtual method }
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/inherited call...');
- vmtobject.method_normal_call_inherited_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/inherited call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_normal_call_inherited_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { ********************************************************************
- This calls virtual methods which in turn call other methods,
- or a constructor or a destructor.
- *********************************************************************
- }
- clear_globals;
- clear_values;
- failed := false;
- { Calls the ancestor virtual method }
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
- vmtobject.method_virtual_call_virtual_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_virtual_call_virtual_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { The virtual method has been overriden by the object in this case }
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
- vmtobject.method_virtual_call_overriden_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_virtual_call_overriden_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/normal call...');
- vmtobject.method_virtual_call_normal_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/normal call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_virtual_call_normal_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- (* constructor call inside a normal method *)
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/constructor call...');
- vmtobject.method_virtual_call_constructor_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/constructor call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_virtual_call_constructor_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { static virtual call }
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/static call...');
- vmtobject.method_virtual_call_static_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/static call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_virtual_call_static_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- (* calls the inherited method *)
- clear_globals;
- clear_values;
- failed := false;
- { Calls the ancestor virtual method }
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/inherited call...');
- vmtobject.method_virtual_call_inherited_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/inherited call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_virtual_call_inherited_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
-
- end;
-
-
- { same as testvmtherited, except uses with statement }
- procedure testwith;
- var
- vmtobject : theritedvmtobject;
- failed : boolean;
- begin
- with vmtobject do
- begin
- {********************** CONSTRUCTOR TESTING ************************}
- {********************** DESTRUCTOR TESTING ************************}
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) inherited constructor call...');
- constructor_params_mixed_call_inherited(RESULT_U8BIT, RESULT_U16BIT, RESULT_BIGSTRING,
- RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) inherited constructor call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- constructor_params_mixed_call_inherited(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
- constructor_params_mixed_call_virtual(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- constructor_params_mixed_call_virtual(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
- constructor_params_mixed_call_overriden(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- constructor_params_mixed_call_overriden(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/method call...');
- constructor_params_mixed_call_normal(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- constructor_params_mixed_call_normal(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/static call...');
- constructor_params_mixed_call_static(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/static call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- constructor_params_mixed_call_static(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- {************************* METHOD TESTING **************************}
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
- method_virtual_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_virtual_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
- method_virtual_overriden_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_virtual_overriden_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call...');
- method_normal_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_normal_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) static method call...');
- method_static_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) static method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_static_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { ********************************************************************
- This calls methods which in turn call other methods, or a constructor
- or a destructor.
- *********************************************************************
- }
- clear_globals;
- clear_values;
- failed := false;
- { Calls the ancestor virtual method }
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
- method_normal_call_virtual_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_normal_call_virtual_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { The virtual method has been overriden by the object in this case }
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
- method_normal_call_overriden_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_normal_call_overriden_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/normal call...');
- method_normal_call_normal_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/normal call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_normal_call_normal_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- (* constructor call inside a normal method *)
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/constructor call...');
- method_normal_call_constructor_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/constructor call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_normal_call_constructor_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { static method call }
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/static call...');
- method_normal_call_static_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/static call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_normal_call_static_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- (* calls the inherited method *)
- clear_globals;
- clear_values;
- failed := false;
- { Calls the ancestor virtual method }
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/inherited call...');
- method_normal_call_inherited_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/inherited call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_normal_call_inherited_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { ********************************************************************
- This calls virtual methods which in turn call other methods,
- or a constructor or a destructor.
- *********************************************************************
- }
- clear_globals;
- clear_values;
- failed := false;
- { Calls the ancestor virtual method }
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
- method_virtual_call_virtual_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_virtual_call_virtual_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { The virtual method has been overriden by the object in this case }
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
- method_virtual_call_overriden_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_virtual_call_overriden_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/normal call...');
- method_virtual_call_normal_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/normal call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_virtual_call_normal_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- (* constructor call inside a normal method *)
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/constructor call...');
- method_virtual_call_constructor_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/constructor call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_virtual_call_constructor_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { static virtual call }
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/static call...');
- method_virtual_call_static_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/static call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_virtual_call_static_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- (* calls the inherited method *)
- clear_globals;
- clear_values;
- failed := false;
- { Calls the ancestor virtual method }
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/inherited call...');
- method_virtual_call_inherited_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/inherited call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_virtual_call_inherited_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
- end; { end with }
- end;
-
-
-begin
- WriteLN('*********************** NO VMT OBJECT TESTS ********************');
- testnovmtobject;
- WriteLN('************************ VMT OBJECT FAIL **********************');
- testfailedobject;
- WriteLN('************************* VMT OBJECT TESTS *********************');
- testvmtobject;
- testheritedvmtobject;
- WriteLN('**************** VMT OBJECT TESTS USING WITH *******************');
- testwith;
-end.
-
-{
+{****************************************************************}
+{ CODE GENERATOR TEST PROGRAM }
+{ Copyright (c) 2002 Carl Eric Codere }
+{****************************************************************}
+{ NODE TESTED : secondcalln() }
+{****************************************************************}
+{ PRE-REQUISITES: secondload() }
+{ secondassign() }
+{ secondtypeconv() }
+{ secondtryexcept() }
+{****************************************************************}
+{ DEFINES: }
+{ FPC = Target is FreePascal compiler }
+{****************************************************************}
+{ REMARKS: This tests secondcalln(), genentrycode() and }
+{ genexitcode() for standard object with the safecall }
+{ calling convention. }
+{ }
+{****************************************************************}
+program tcalobj5;
+{$STATIC ON}
+{$R+}
+
+ const
+ { should be defined depending on CPU target }
+ {$ifdef cpu68k}
+ BIG_INDEX = 8000;
+ SMALL_INDEX = 13;
+ {$else}
+ BIG_INDEX = 33000;
+ SMALL_INDEX = 13; { value should not be aligned! }
+ {$endif}
+ RESULT_U8BIT = $55;
+ RESULT_U16BIT = 2*RESULT_U8BIT;
+ RESULT_S32BIT = $500F0000;
+ RESULT_S64BIT = $500F0000;
+ RESULT_S32REAL = 1777.12;
+ RESULT_S64REAL = 3444.24;
+ RESULT_BOOL8BIT = 1;
+ RESULT_BOOL16BIT = 1;
+ RESULT_BOOL32BIT = 1;
+ RESULT_PCHAR = 'Hello world';
+ RESULT_BIGSTRING = 'Hello world';
+ RESULT_SMALLSTRING = 'H';
+ RESULT_CHAR = 'I';
+ RESULT_BOOLEAN = TRUE;
+
+ type
+
+ tprocedure = procedure;
+
+ tsmallrecord = packed record
+ b: byte;
+ w: word;
+ end;
+
+ tlargerecord = packed record
+ b: array[1..BIG_INDEX] of byte;
+ end;
+
+ tsmallarray = packed array[1..SMALL_INDEX] of byte;
+
+ tsmallsetenum =
+ (A_A,A_B,A_C,A_D);
+
+ tsmallset = set of tsmallsetenum;
+ tlargeset = set of char;
+
+ tsmallstring = string[2];
+
+
+ var
+ global_u8bit : byte;
+ global_u16bit : word;
+ global_s32bit : longint;
+ global_s32real : single;
+ global_s64real : double;
+ global_ptr : pchar;
+ global_proc : tprocedure;
+ global_bigstring : shortstring;
+ global_boolean : boolean;
+ global_char : char;
+ global_s64bit : int64;
+ value_s64bit : int64;
+ value_ansistring : ansistring;
+ value_u8bit : byte;
+ value_u16bit : word;
+ value_s32bit : longint;
+ value_s32real : single;
+ value_s64real : double;
+ value_proc : tprocedure;
+ value_ptr : pchar;
+ value_smallrec : tsmallrecord;
+ value_largerec : tlargerecord;
+ value_smallset : tsmallset;
+ value_smallstring : tsmallstring;
+ value_bigstring : shortstring;
+ value_largeset : tlargeset;
+ value_smallarray : tsmallarray;
+ value_boolean : boolean;
+ value_char : char;
+
+ procedure fail;
+ begin
+ WriteLn('Failure.');
+ halt(1);
+ end;
+
+
+ procedure clear_globals;
+ begin
+ global_u8bit := 0;
+ global_u16bit := 0;
+ global_s32bit := 0;
+ global_s32real := 0.0;
+ global_s64real := 0.0;
+ global_ptr := nil;
+ global_proc := nil;
+ global_bigstring := '';
+ global_boolean := false;
+ global_char := #0;
+ global_s64bit := 0;
+ end;
+
+
+ procedure clear_values;
+ begin
+ value_u8bit := 0;
+ value_u16bit := 0;
+ value_s32bit := 0;
+ value_s32real := 0.0;
+ value_s64real := 0.0;
+ value_proc := nil;
+ value_ptr := nil;
+ fillchar(value_smallrec, sizeof(value_smallrec), #0);
+ fillchar(value_largerec, sizeof(value_largerec), #0);
+ value_smallset := [];
+ value_smallstring := '';
+ value_bigstring := '';
+ value_largeset := [];
+ fillchar(value_smallarray, sizeof(value_smallarray), #0);
+ value_boolean := false;
+ value_char:=#0;
+ value_ansistring := '';
+ value_s64bit := 0;
+ end;
+
+
+ function getu8: byte;
+ begin
+ getu8 := RESULT_U8BIT;
+ end;
+
+
+type
+
+ { object without vmt }
+ pnovmtobject = ^tnovmtobject;
+ tnovmtobject = object
+ public
+ object_bigstring : shortstring;
+ object_u16bit : word;
+ { no parameter testing }
+ procedure method_public_none;safecall;
+ procedure method_public_static_none; static;safecall;
+ procedure method_call_private_none;safecall;
+ procedure method_call_private_static_none; static;safecall;
+ { simple value parameter testing }
+ procedure method_public_u8(x : byte);safecall;
+ procedure method_public_static_u8(x: byte); static;safecall;
+ procedure method_call_private_u8(x: byte);safecall;
+ procedure method_call_private_static_u8(x: byte); static;safecall;
+ function func_array_mixed_nested(b: byte): tsmallarray;safecall;
+ private
+ procedure method_private_none;safecall;
+ procedure method_private_static_none; static;safecall;
+ function func_getu16bit : word;safecall;
+ { simple value parameter testing }
+ procedure method_private_u8(x: byte);safecall;
+ procedure method_private_static_u8(x: byte); static;safecall;
+ end;
+
+
+ { object with vmt }
+ pvmtobject = ^tvmtobject;
+ tvmtobject = object
+ public
+ object_u8bit : byte;
+ object_u16bit : word;
+ object_bigstring : shortstring;
+ object_s32bit : longint;
+ object_s64bit : int64;
+ constructor constructor_params_mixed(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);
+ constructor constructor_init;
+ destructor destructor_params_done;
+ procedure method_normal_params_mixed(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);safecall;
+ procedure method_virtual_params_mixed(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);virtual;safecall;
+ procedure method_virtual_overriden_params_mixed(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);virtual;safecall;
+ procedure method_static_params_mixed(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);static;safecall;
+ procedure method_normal_call_inherited_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
+
+ { virtual methods which call other methods }
+ procedure method_virtual_call_static_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;safecall;
+ procedure method_virtual_call_virtual_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;safecall;
+ procedure method_virtual_call_overriden_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;safecall;
+ procedure method_virtual_call_normal_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;safecall;
+ procedure method_virtual_call_constructor_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;safecall;
+ procedure method_virtual_call_inherited_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;safecall;
+
+ end;
+
+ pheritedvmtobject = ^theritedvmtobject;
+ theritedvmtobject = object(tvmtobject)
+ constructor constructor_params_mixed_call_virtual(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);
+ constructor constructor_params_mixed_call_overriden(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);
+ constructor constructor_params_mixed_call_static(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);
+ constructor constructor_params_mixed_call_normal(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);
+ constructor constructor_params_mixed_call_inherited(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);
+ procedure method_virtual_overriden_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;safecall;
+
+ { normal methods which call other methods }
+ procedure method_normal_call_static_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
+ procedure method_normal_call_virtual_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
+ procedure method_normal_call_overriden_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
+ procedure method_normal_call_normal_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
+ procedure method_normal_call_constructor_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
+ procedure method_normal_call_inherited_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
+
+ { virtual methods which call other methods }
+ procedure method_virtual_call_inherited_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;safecall;
+
+ end;
+
+ pfailvmtobject = ^tfailvmtobject;
+ tfailvmtobject = object(tvmtobject)
+ public
+ constructor constructor_public_none;
+ end;
+
+
+
+{**************************************************************************}
+{ NO VMT OBJECT }
+{**************************************************************************}
+
+ {****************** NO PARAMETERS ******************}
+ procedure tnovmtobject.method_public_none;safecall;
+ begin
+ global_u8bit := RESULT_U8BIT;
+ end;
+
+
+ procedure tnovmtobject.method_public_static_none;safecall;
+ begin
+ global_u8bit := RESULT_U8BIT;
+ end;
+
+
+ procedure tnovmtobject.method_call_private_none;safecall;
+ begin
+ method_private_none;
+ method_private_static_none;
+ end;
+
+ procedure tnovmtobject.method_call_private_static_none;safecall;
+ begin
+ method_private_static_none;
+ end;
+
+
+ procedure tnovmtobject.method_private_none;safecall;
+ begin
+ Inc(global_u16bit, RESULT_U8BIT);
+ end;
+
+
+ procedure tnovmtobject.method_private_static_none;safecall;
+ begin
+ Inc(global_u16bit, RESULT_U8BIT);
+ end;
+
+ {******************** PARAMETERS ******************}
+
+ procedure tnovmtobject.method_public_u8(x : byte);safecall;
+ begin
+ global_u8bit := x;
+ end;
+
+ procedure tnovmtobject.method_public_static_u8(x: byte);safecall;
+ begin
+ global_u8bit := x;
+ end;
+
+ procedure tnovmtobject.method_call_private_u8(x: byte);safecall;
+ begin
+ method_private_static_u8(x);
+ method_private_u8(x);
+ end;
+
+ procedure tnovmtobject. method_call_private_static_u8(x: byte);safecall;
+ begin
+ method_private_static_u8(x);
+ end;
+
+ procedure tnovmtobject.method_private_u8(x: byte);safecall;
+ begin
+ Inc(global_u16bit,x);
+ end;
+
+ procedure tnovmtobject.method_private_static_u8(x: byte);safecall;
+ begin
+ Inc(global_u16bit,x);
+ end;
+
+
+ function tnovmtobject.func_getu16bit : word;safecall;
+ begin
+ func_getu16bit := object_u16bit;
+ end;
+
+ {
+ complex testing, nested field access, with parameters and
+ comple return value.
+
+ On exit : global_u8bit := x;
+ global_u16bit := object_u16bit (from func_getu16bit);
+ global_s32bit := RESULT_S32BIT
+ global_bigstring := object_bigstring
+ global_s64bit := x;
+ }
+ function tnovmtobject.func_array_mixed_nested(b: byte): tsmallarray;safecall;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := func_getu16bit;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ smallarray: tsmallarray;
+ begin
+ fillchar(smallarray, sizeof(smallarray), #0);
+ smallarray[1] := RESULT_U8BIT;
+ smallarray[SMALL_INDEX] := RESULT_U8BIT;
+ func_array_mixed_nested := smallarray;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, object_bigstring);
+ end;
+
+{**************************************************************************}
+{ FAILED OBJECT }
+{**************************************************************************}
+constructor tfailvmtobject.constructor_public_none;
+ begin
+ { this calls the constructor fail special keyword }
+ fail;
+ end;
+
+{**************************************************************************}
+{ VMT OBJECT }
+{**************************************************************************}
+constructor tvmtobject.constructor_params_mixed(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);
+ begin
+ object_u8bit := u8;
+ object_u16bit := u16;
+ object_bigstring := bigstring;
+ object_s32bit := s32;
+ object_s64bit := s64;
+ end;
+
+
+constructor tvmtobject.constructor_init;
+ begin
+ object_u8bit := 0;
+ object_u16bit := 0;
+ object_bigstring := '';
+ object_s32bit := 0;
+ object_s64bit := 0;
+ end;
+
+destructor tvmtobject.destructor_params_done;
+ begin
+ object_u8bit := 0;
+ object_u16bit := 0;
+ object_bigstring := '';
+ object_s32bit := 0;
+ object_s64bit := 0;
+ end;
+
+
+procedure tvmtobject.method_normal_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
+ begin
+ object_u8bit := u8;
+ object_u16bit := u16;
+ object_bigstring := bigstring;
+ object_s32bit := s32;
+ object_s64bit := s64;
+ end;
+
+procedure tvmtobject.method_virtual_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
+ begin
+ object_u8bit := u8;
+ object_u16bit := u16;
+ object_bigstring := bigstring;
+ object_s32bit := s32;
+ object_s64bit := s64;
+ end;
+
+{ this one should be overriden }
+procedure tvmtobject.method_virtual_overriden_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
+ begin
+ RunError(211);
+ end;
+
+{ can't access field of instances in static methods }
+procedure tvmtobject.method_static_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
+ begin
+ global_u8bit := u8;
+ global_u16bit := u16;
+ global_bigstring := bigstring;
+ global_s32bit := s32;
+ global_s64bit := s64;
+ end;
+
+procedure tvmtobject.method_normal_call_inherited_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
+ begin
+ object_u8bit := u8;
+ object_u16bit := u16;
+ object_bigstring := bigstring;
+ object_s32bit := s32;
+ object_s64bit := s64;
+ end;
+
+
+procedure tvmtobject.method_virtual_call_static_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
+ begin
+ method_static_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+procedure tvmtobject.method_virtual_call_virtual_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
+ begin
+ method_virtual_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+procedure tvmtobject.method_virtual_call_overriden_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
+ begin
+ method_virtual_overriden_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+
+procedure tvmtobject.method_virtual_call_normal_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
+ begin
+ method_normal_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+procedure tvmtobject.method_virtual_call_constructor_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
+ begin
+ constructor_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+procedure tvmtobject.method_virtual_call_inherited_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
+ begin
+ object_u8bit := u8;
+ object_u16bit := u16;
+ object_bigstring := bigstring;
+ object_s32bit := s32;
+ object_s64bit := s64;
+ end;
+
+
+{**************************************************************************}
+{ INHERITED VMT OBJECT }
+{**************************************************************************}
+constructor theritedvmtobject.constructor_params_mixed_call_virtual(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
+ begin
+ object_u8bit := 0;
+ object_u16bit := 0;
+ object_bigstring := '';
+ object_s32bit := 0;
+ object_s64bit := 0;
+ method_virtual_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+constructor theritedvmtobject.constructor_params_mixed_call_overriden(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
+ begin
+ object_u8bit := 0;
+ object_u16bit := 0;
+ object_bigstring := '';
+ object_s32bit := 0;
+ object_s64bit := 0;
+ method_virtual_overriden_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+constructor theritedvmtobject.constructor_params_mixed_call_static(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
+ begin
+ object_u8bit := 0;
+ object_u16bit := 0;
+ object_bigstring := '';
+ object_s32bit := 0;
+ object_s64bit := 0;
+ method_static_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+constructor theritedvmtobject.constructor_params_mixed_call_normal(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
+ begin
+ object_u8bit := 0;
+ object_u16bit := 0;
+ object_bigstring := '';
+ object_s32bit := 0;
+ object_s64bit := 0;
+ method_normal_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+constructor theritedvmtobject.constructor_params_mixed_call_inherited
+ (u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
+ begin
+ object_u8bit := 0;
+ object_u16bit := 0;
+ object_bigstring := '';
+ object_s32bit := 0;
+ object_s64bit := 0;
+ inherited constructor_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+{ this one should be overriden }
+procedure theritedvmtobject.method_virtual_overriden_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
+ begin
+ object_u8bit := u8;
+ object_u16bit := u16;
+ object_bigstring := bigstring;
+ object_s32bit := s32;
+ object_s64bit := s64;
+ end;
+
+procedure theritedvmtobject.method_normal_call_static_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
+ begin
+ method_static_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+procedure theritedvmtobject.method_normal_call_virtual_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
+ begin
+ method_virtual_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+procedure theritedvmtobject.method_normal_call_overriden_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
+ begin
+ method_virtual_overriden_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+
+procedure theritedvmtobject.method_normal_call_normal_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
+ begin
+ method_normal_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+procedure theritedvmtobject.method_normal_call_constructor_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
+ begin
+ constructor_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+procedure theritedvmtobject.method_normal_call_inherited_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
+ begin
+ Inherited method_normal_call_inherited_params_mixed(u8, u16, bigstring,
+ s32, s64);
+ end;
+
+procedure theritedvmtobject.method_virtual_call_inherited_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);safecall;
+ begin
+ Inherited method_virtual_call_inherited_params_mixed(u8, u16, bigstring,
+ s32, s64);
+ end;
+
+
+procedure testnovmtobject;
+var
+ novmtobject : tnovmtobject;
+ failed : boolean;
+begin
+ {******************** STATIC / METHOD SIMPLE CALL **********************}
+ Write('No parameter / method call testing...');
+ failed := false;
+
+ clear_globals;
+ clear_values;
+
+ tnovmtobject.method_public_static_none;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ novmtobject.method_public_static_none;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ tnovmtobject.method_call_private_static_none;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_call_private_static_none;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_public_none;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_call_private_none;
+ if global_u16bit <> (RESULT_U16BIT) then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ Write('Simple parameter (LOC_CONSTANT) / method call testing...');
+ failed := false;
+
+ clear_globals;
+ clear_values;
+
+ { parameter is LOC_CONSTANT }
+ novmtobject.method_public_u8(RESULT_U8BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ tnovmtobject.method_public_static_u8(RESULT_U8BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_public_static_u8(RESULT_U8BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_call_private_u8(RESULT_U8BIT);
+ if global_u16bit <> (RESULT_U16BIT) then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_call_private_static_u8(RESULT_U8BIT);
+ if global_u16bit <> (RESULT_U8BIT) then
+ failed := true;
+
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+
+ Write('Simple parameter (LOC_REFERENCE) / method call testing...');
+ failed := false;
+
+ clear_globals;
+ clear_values;
+
+ value_u8bit := RESULT_U8BIT;
+ novmtobject.method_public_u8(value_u8bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ value_u8bit := RESULT_U8BIT;
+ tnovmtobject.method_public_static_u8(value_u8bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ value_u8bit := RESULT_U8BIT;
+ novmtobject.method_public_static_u8(value_u8bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ value_u8bit := RESULT_U8BIT;
+ novmtobject.method_call_private_u8(value_u8bit);
+ if global_u16bit <> (RESULT_U16BIT) then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ value_u8bit := RESULT_U8BIT;
+ novmtobject.method_call_private_static_u8(value_u8bit);
+ if global_u16bit <> (RESULT_U8BIT) then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ Write('Simple parameter (LOC_REGISTER) / method call testing...');
+ failed := false;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_public_u8(getu8);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ tnovmtobject.method_public_static_u8(getu8);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_public_static_u8(getu8);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_call_private_u8(getu8);
+ if global_u16bit <> (RESULT_U16BIT) then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_call_private_static_u8(getu8);
+ if global_u16bit <> (RESULT_U8BIT) then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ Write('Simple parameter / complex return / nested method access testing...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+ novmtobject.object_bigstring := RESULT_BIGSTRING;
+ novmtobject.object_u16bit := RESULT_U16BIT;
+
+ value_smallarray := novmtobject.func_array_mixed_nested(RESULT_U8BIT);
+ if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+end;
+
+
+procedure testfailedobject;
+var
+ failedobject : tfailvmtobject;
+ begin
+ Write('Testing constructor return value...');
+ if failedobject.constructor_public_none then
+ fail
+ else
+ Writeln('Passed!');
+ end;
+
+
+ procedure testvmtobject;
+ var
+ vmtobject : tvmtobject;
+ failed : boolean;
+ begin
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call...');
+ vmtobject.constructor_params_mixed(RESULT_U8BIT, RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.constructor_params_mixed(value_u8bit, value_u16bit, value_bigstring,
+ value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ end;
+
+
+ procedure testheritedvmtobject;
+ var
+ vmtobject : theritedvmtobject;
+ failed : boolean;
+ begin
+ {********************** CONSTRUCTOR TESTING ************************}
+ {********************** DESTRUCTOR TESTING ************************}
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) inherited constructor call...');
+ vmtobject.constructor_params_mixed_call_inherited(RESULT_U8BIT, RESULT_U16BIT, RESULT_BIGSTRING,
+ RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) inherited constructor call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.constructor_params_mixed_call_inherited(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
+ vmtobject.constructor_params_mixed_call_virtual(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.constructor_params_mixed_call_virtual(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
+ vmtobject.constructor_params_mixed_call_overriden(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.constructor_params_mixed_call_overriden(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/method call...');
+ vmtobject.constructor_params_mixed_call_normal(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.constructor_params_mixed_call_normal(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/static call...');
+ vmtobject.constructor_params_mixed_call_static(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/static call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.constructor_params_mixed_call_static(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ {************************* METHOD TESTING **************************}
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
+ vmtobject.method_virtual_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_virtual_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
+ vmtobject.method_virtual_overriden_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_virtual_overriden_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call...');
+ vmtobject.method_normal_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_normal_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) static method call...');
+ vmtobject.method_static_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) static method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_static_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { ********************************************************************
+ This calls methods which in turn call other methods, or a constructor
+ or a destructor.
+ *********************************************************************
+ }
+ clear_globals;
+ clear_values;
+ failed := false;
+ { Calls the ancestor virtual method }
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
+ vmtobject.method_normal_call_virtual_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_normal_call_virtual_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { The virtual method has been overriden by the object in this case }
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
+ vmtobject.method_normal_call_overriden_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_normal_call_overriden_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/normal call...');
+ vmtobject.method_normal_call_normal_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/normal call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_normal_call_normal_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ (* constructor call inside a normal method *)
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/constructor call...');
+ vmtobject.method_normal_call_constructor_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/constructor call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_normal_call_constructor_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { static method call }
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/static call...');
+ vmtobject.method_normal_call_static_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/static call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_normal_call_static_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ (* calls the inherited method *)
+ clear_globals;
+ clear_values;
+ failed := false;
+ { Calls the ancestor virtual method }
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/inherited call...');
+ vmtobject.method_normal_call_inherited_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/inherited call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_normal_call_inherited_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { ********************************************************************
+ This calls virtual methods which in turn call other methods,
+ or a constructor or a destructor.
+ *********************************************************************
+ }
+ clear_globals;
+ clear_values;
+ failed := false;
+ { Calls the ancestor virtual method }
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
+ vmtobject.method_virtual_call_virtual_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_virtual_call_virtual_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { The virtual method has been overriden by the object in this case }
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
+ vmtobject.method_virtual_call_overriden_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_virtual_call_overriden_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/normal call...');
+ vmtobject.method_virtual_call_normal_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/normal call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_virtual_call_normal_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ (* constructor call inside a normal method *)
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/constructor call...');
+ vmtobject.method_virtual_call_constructor_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/constructor call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_virtual_call_constructor_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { static virtual call }
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/static call...');
+ vmtobject.method_virtual_call_static_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/static call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_virtual_call_static_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ (* calls the inherited method *)
+ clear_globals;
+ clear_values;
+ failed := false;
+ { Calls the ancestor virtual method }
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/inherited call...');
+ vmtobject.method_virtual_call_inherited_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/inherited call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_virtual_call_inherited_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+
+ end;
+
+
+ { same as testvmtherited, except uses with statement }
+ procedure testwith;
+ var
+ vmtobject : theritedvmtobject;
+ failed : boolean;
+ begin
+ with vmtobject do
+ begin
+ {********************** CONSTRUCTOR TESTING ************************}
+ {********************** DESTRUCTOR TESTING ************************}
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) inherited constructor call...');
+ constructor_params_mixed_call_inherited(RESULT_U8BIT, RESULT_U16BIT, RESULT_BIGSTRING,
+ RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) inherited constructor call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ constructor_params_mixed_call_inherited(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
+ constructor_params_mixed_call_virtual(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ constructor_params_mixed_call_virtual(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
+ constructor_params_mixed_call_overriden(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ constructor_params_mixed_call_overriden(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/method call...');
+ constructor_params_mixed_call_normal(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ constructor_params_mixed_call_normal(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/static call...');
+ constructor_params_mixed_call_static(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/static call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ constructor_params_mixed_call_static(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ {************************* METHOD TESTING **************************}
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
+ method_virtual_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_virtual_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
+ method_virtual_overriden_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_virtual_overriden_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call...');
+ method_normal_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_normal_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) static method call...');
+ method_static_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) static method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_static_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { ********************************************************************
+ This calls methods which in turn call other methods, or a constructor
+ or a destructor.
+ *********************************************************************
+ }
+ clear_globals;
+ clear_values;
+ failed := false;
+ { Calls the ancestor virtual method }
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
+ method_normal_call_virtual_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_normal_call_virtual_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { The virtual method has been overriden by the object in this case }
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
+ method_normal_call_overriden_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_normal_call_overriden_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/normal call...');
+ method_normal_call_normal_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/normal call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_normal_call_normal_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ (* constructor call inside a normal method *)
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/constructor call...');
+ method_normal_call_constructor_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/constructor call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_normal_call_constructor_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { static method call }
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/static call...');
+ method_normal_call_static_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/static call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_normal_call_static_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ (* calls the inherited method *)
+ clear_globals;
+ clear_values;
+ failed := false;
+ { Calls the ancestor virtual method }
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/inherited call...');
+ method_normal_call_inherited_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/inherited call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_normal_call_inherited_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { ********************************************************************
+ This calls virtual methods which in turn call other methods,
+ or a constructor or a destructor.
+ *********************************************************************
+ }
+ clear_globals;
+ clear_values;
+ failed := false;
+ { Calls the ancestor virtual method }
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
+ method_virtual_call_virtual_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_virtual_call_virtual_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { The virtual method has been overriden by the object in this case }
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
+ method_virtual_call_overriden_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_virtual_call_overriden_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/normal call...');
+ method_virtual_call_normal_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/normal call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_virtual_call_normal_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ (* constructor call inside a normal method *)
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/constructor call...');
+ method_virtual_call_constructor_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/constructor call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_virtual_call_constructor_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { static virtual call }
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/static call...');
+ method_virtual_call_static_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/static call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_virtual_call_static_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ (* calls the inherited method *)
+ clear_globals;
+ clear_values;
+ failed := false;
+ { Calls the ancestor virtual method }
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/inherited call...');
+ method_virtual_call_inherited_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/inherited call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_virtual_call_inherited_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+ end; { end with }
+ end;
+
+
+begin
+ WriteLN('*********************** NO VMT OBJECT TESTS ********************');
+ testnovmtobject;
+ WriteLN('************************ VMT OBJECT FAIL **********************');
+ testfailedobject;
+ WriteLN('************************* VMT OBJECT TESTS *********************');
+ testvmtobject;
+ testheritedvmtobject;
+ WriteLN('**************** VMT OBJECT TESTS USING WITH *******************');
+ testwith;
+end.
+
+{
$Log$
- Revision 1.5 2003-04-22 10:24:29 florian
+ Revision 1.6 2004-05-02 12:11:44 peter
+ * fixed linefeeds
+
+ Revision 1.5 2003/04/22 10:24:29 florian
* fixed defines for powerpc
-
- Revision 1.4 2002/12/29 15:30:55 peter
- * updated for 1.1 compiler that does not allow calling conventions
- for constructor/destructor
-
- Revision 1.3 2002/09/07 15:40:54 peter
- * old logs removed and tabs fixed
-
- Revision 1.2 2002/05/05 19:13:19 carl
- + withsymtable checking
-
- Revision 1.1 2002/05/05 13:58:50 carl
- + finished procedural variable testsuit
- + finished method testsuit
-
-}
+
+ Revision 1.4 2002/12/29 15:30:55 peter
+ * updated for 1.1 compiler that does not allow calling conventions
+ for constructor/destructor
+
+ Revision 1.3 2002/09/07 15:40:54 peter
+ * old logs removed and tabs fixed
+
+ Revision 1.2 2002/05/05 19:13:19 carl
+ + withsymtable checking
+
+ Revision 1.1 2002/05/05 13:58:50 carl
+ + finished procedural variable testsuit
+ + finished method testsuit
+
+}
diff --git a/tests/test/cg/tcalobj6.pp b/tests/test/cg/tcalobj6.pp
index f37d95c1a3..896a576477 100644
--- a/tests/test/cg/tcalobj6.pp
+++ b/tests/test/cg/tcalobj6.pp
@@ -1,3313 +1,3316 @@
-{****************************************************************}
-{ CODE GENERATOR TEST PROGRAM }
-{ Copyright (c) 2002 Carl Eric Codere }
-{****************************************************************}
-{ NODE TESTED : secondcalln() }
-{****************************************************************}
-{ PRE-REQUISITES: secondload() }
-{ secondassign() }
-{ secondtypeconv() }
-{ secondtryexcept() }
-{****************************************************************}
-{ DEFINES: }
-{ FPC = Target is FreePascal compiler }
-{****************************************************************}
-{ REMARKS: This tests secondcalln(), genentrycode() and }
-{ genexitcode() for standard object with the register }
-{ calling convention. }
-{ }
-{****************************************************************}
-program tcalobj6;
-{$STATIC ON}
-{$R+}
-
- const
- { should be defined depending on CPU target }
- {$ifdef cpu68k}
- BIG_INDEX = 8000;
- SMALL_INDEX = 13;
- {$else}
- BIG_INDEX = 33000;
- SMALL_INDEX = 13; { value should not be aligned! }
- {$endif}
- RESULT_U8BIT = $55;
- RESULT_U16BIT = 2*RESULT_U8BIT;
- RESULT_S32BIT = $500F0000;
- RESULT_S64BIT = $500F0000;
- RESULT_S32REAL = 1777.12;
- RESULT_S64REAL = 3444.24;
- RESULT_BOOL8BIT = 1;
- RESULT_BOOL16BIT = 1;
- RESULT_BOOL32BIT = 1;
- RESULT_PCHAR = 'Hello world';
- RESULT_BIGSTRING = 'Hello world';
- RESULT_SMALLSTRING = 'H';
- RESULT_CHAR = 'I';
- RESULT_BOOLEAN = TRUE;
-
- type
-
- tprocedure = procedure;
-
- tsmallrecord = packed record
- b: byte;
- w: word;
- end;
-
- tlargerecord = packed record
- b: array[1..BIG_INDEX] of byte;
- end;
-
- tsmallarray = packed array[1..SMALL_INDEX] of byte;
-
- tsmallsetenum =
- (A_A,A_B,A_C,A_D);
-
- tsmallset = set of tsmallsetenum;
- tlargeset = set of char;
-
- tsmallstring = string[2];
-
-
- var
- global_u8bit : byte;
- global_u16bit : word;
- global_s32bit : longint;
- global_s32real : single;
- global_s64real : double;
- global_ptr : pchar;
- global_proc : tprocedure;
- global_bigstring : shortstring;
- global_boolean : boolean;
- global_char : char;
- global_s64bit : int64;
- value_s64bit : int64;
- value_ansistring : ansistring;
- value_u8bit : byte;
- value_u16bit : word;
- value_s32bit : longint;
- value_s32real : single;
- value_s64real : double;
- value_proc : tprocedure;
- value_ptr : pchar;
- value_smallrec : tsmallrecord;
- value_largerec : tlargerecord;
- value_smallset : tsmallset;
- value_smallstring : tsmallstring;
- value_bigstring : shortstring;
- value_largeset : tlargeset;
- value_smallarray : tsmallarray;
- value_boolean : boolean;
- value_char : char;
-
- procedure fail;
- begin
- WriteLn('Failure.');
- halt(1);
- end;
-
-
- procedure clear_globals;
- begin
- global_u8bit := 0;
- global_u16bit := 0;
- global_s32bit := 0;
- global_s32real := 0.0;
- global_s64real := 0.0;
- global_ptr := nil;
- global_proc := nil;
- global_bigstring := '';
- global_boolean := false;
- global_char := #0;
- global_s64bit := 0;
- end;
-
-
- procedure clear_values;
- begin
- value_u8bit := 0;
- value_u16bit := 0;
- value_s32bit := 0;
- value_s32real := 0.0;
- value_s64real := 0.0;
- value_proc := nil;
- value_ptr := nil;
- fillchar(value_smallrec, sizeof(value_smallrec), #0);
- fillchar(value_largerec, sizeof(value_largerec), #0);
- value_smallset := [];
- value_smallstring := '';
- value_bigstring := '';
- value_largeset := [];
- fillchar(value_smallarray, sizeof(value_smallarray), #0);
- value_boolean := false;
- value_char:=#0;
- value_ansistring := '';
- value_s64bit := 0;
- end;
-
-
- function getu8: byte;
- begin
- getu8 := RESULT_U8BIT;
- end;
-
-
-type
-
- { object without vmt }
- pnovmtobject = ^tnovmtobject;
- tnovmtobject = object
- public
- object_bigstring : shortstring;
- object_u16bit : word;
- { no parameter testing }
- procedure method_public_none;register;
- procedure method_public_static_none; static;register;
- procedure method_call_private_none;register;
- procedure method_call_private_static_none; static;register;
- { simple value parameter testing }
- procedure method_public_u8(x : byte);register;
- procedure method_public_static_u8(x: byte); static;register;
- procedure method_call_private_u8(x: byte);register;
- procedure method_call_private_static_u8(x: byte); static;register;
- function func_array_mixed_nested(b: byte): tsmallarray;register;
- private
- procedure method_private_none;register;
- procedure method_private_static_none; static;register;
- function func_getu16bit : word;register;
- { simple value parameter testing }
- procedure method_private_u8(x: byte);register;
- procedure method_private_static_u8(x: byte); static;register;
- end;
-
-
- { object with vmt }
- pvmtobject = ^tvmtobject;
- tvmtobject = object
- public
- object_u8bit : byte;
- object_u16bit : word;
- object_bigstring : shortstring;
- object_s32bit : longint;
- object_s64bit : int64;
- constructor constructor_params_mixed(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);
- constructor constructor_init;
- destructor destructor_params_done;
- procedure method_normal_params_mixed(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);register;
- procedure method_virtual_params_mixed(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);virtual;register;
- procedure method_virtual_overriden_params_mixed(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);virtual;register;
- procedure method_static_params_mixed(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);static;register;
- procedure method_normal_call_inherited_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
-
- { virtual methods which call other methods }
- procedure method_virtual_call_static_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;register;
- procedure method_virtual_call_virtual_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;register;
- procedure method_virtual_call_overriden_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;register;
- procedure method_virtual_call_normal_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;register;
- procedure method_virtual_call_constructor_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;register;
- procedure method_virtual_call_inherited_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;register;
-
- end;
-
- pheritedvmtobject = ^theritedvmtobject;
- theritedvmtobject = object(tvmtobject)
- constructor constructor_params_mixed_call_virtual(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);
- constructor constructor_params_mixed_call_overriden(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);
- constructor constructor_params_mixed_call_static(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);
- constructor constructor_params_mixed_call_normal(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);
- constructor constructor_params_mixed_call_inherited(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);
- procedure method_virtual_overriden_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;register;
-
- { normal methods which call other methods }
- procedure method_normal_call_static_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
- procedure method_normal_call_virtual_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
- procedure method_normal_call_overriden_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
- procedure method_normal_call_normal_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
- procedure method_normal_call_constructor_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
- procedure method_normal_call_inherited_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
-
- { virtual methods which call other methods }
- procedure method_virtual_call_inherited_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;register;
-
- end;
-
- pfailvmtobject = ^tfailvmtobject;
- tfailvmtobject = object(tvmtobject)
- public
- constructor constructor_public_none;
- end;
-
-
-
-{**************************************************************************}
-{ NO VMT OBJECT }
-{**************************************************************************}
-
- {****************** NO PARAMETERS ******************}
- procedure tnovmtobject.method_public_none;register;
- begin
- global_u8bit := RESULT_U8BIT;
- end;
-
-
- procedure tnovmtobject.method_public_static_none;register;
- begin
- global_u8bit := RESULT_U8BIT;
- end;
-
-
- procedure tnovmtobject.method_call_private_none;register;
- begin
- method_private_none;
- method_private_static_none;
- end;
-
- procedure tnovmtobject.method_call_private_static_none;register;
- begin
- method_private_static_none;
- end;
-
-
- procedure tnovmtobject.method_private_none;register;
- begin
- Inc(global_u16bit, RESULT_U8BIT);
- end;
-
-
- procedure tnovmtobject.method_private_static_none;register;
- begin
- Inc(global_u16bit, RESULT_U8BIT);
- end;
-
- {******************** PARAMETERS ******************}
-
- procedure tnovmtobject.method_public_u8(x : byte);register;
- begin
- global_u8bit := x;
- end;
-
- procedure tnovmtobject.method_public_static_u8(x: byte);register;
- begin
- global_u8bit := x;
- end;
-
- procedure tnovmtobject.method_call_private_u8(x: byte);register;
- begin
- method_private_static_u8(x);
- method_private_u8(x);
- end;
-
- procedure tnovmtobject. method_call_private_static_u8(x: byte);register;
- begin
- method_private_static_u8(x);
- end;
-
- procedure tnovmtobject.method_private_u8(x: byte);register;
- begin
- Inc(global_u16bit,x);
- end;
-
- procedure tnovmtobject.method_private_static_u8(x: byte);register;
- begin
- Inc(global_u16bit,x);
- end;
-
-
- function tnovmtobject.func_getu16bit : word;register;
- begin
- func_getu16bit := object_u16bit;
- end;
-
- {
- complex testing, nested field access, with parameters and
- comple return value.
-
- On exit : global_u8bit := x;
- global_u16bit := object_u16bit (from func_getu16bit);
- global_s32bit := RESULT_S32BIT
- global_bigstring := object_bigstring
- global_s64bit := x;
- }
- function tnovmtobject.func_array_mixed_nested(b: byte): tsmallarray;register;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := func_getu16bit;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- smallarray: tsmallarray;
- begin
- fillchar(smallarray, sizeof(smallarray), #0);
- smallarray[1] := RESULT_U8BIT;
- smallarray[SMALL_INDEX] := RESULT_U8BIT;
- func_array_mixed_nested := smallarray;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, object_bigstring);
- end;
-
-{**************************************************************************}
-{ FAILED OBJECT }
-{**************************************************************************}
-constructor tfailvmtobject.constructor_public_none;
- begin
- { this calls the constructor fail special keyword }
- fail;
- end;
-
-{**************************************************************************}
-{ VMT OBJECT }
-{**************************************************************************}
-constructor tvmtobject.constructor_params_mixed(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);
- begin
- object_u8bit := u8;
- object_u16bit := u16;
- object_bigstring := bigstring;
- object_s32bit := s32;
- object_s64bit := s64;
- end;
-
-
-constructor tvmtobject.constructor_init;
- begin
- object_u8bit := 0;
- object_u16bit := 0;
- object_bigstring := '';
- object_s32bit := 0;
- object_s64bit := 0;
- end;
-
-destructor tvmtobject.destructor_params_done;
- begin
- object_u8bit := 0;
- object_u16bit := 0;
- object_bigstring := '';
- object_s32bit := 0;
- object_s64bit := 0;
- end;
-
-
-procedure tvmtobject.method_normal_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
- begin
- object_u8bit := u8;
- object_u16bit := u16;
- object_bigstring := bigstring;
- object_s32bit := s32;
- object_s64bit := s64;
- end;
-
-procedure tvmtobject.method_virtual_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
- begin
- object_u8bit := u8;
- object_u16bit := u16;
- object_bigstring := bigstring;
- object_s32bit := s32;
- object_s64bit := s64;
- end;
-
-{ this one should be overriden }
-procedure tvmtobject.method_virtual_overriden_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
- begin
- RunError(211);
- end;
-
-{ can't access field of instances in static methods }
-procedure tvmtobject.method_static_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
- begin
- global_u8bit := u8;
- global_u16bit := u16;
- global_bigstring := bigstring;
- global_s32bit := s32;
- global_s64bit := s64;
- end;
-
-procedure tvmtobject.method_normal_call_inherited_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
- begin
- object_u8bit := u8;
- object_u16bit := u16;
- object_bigstring := bigstring;
- object_s32bit := s32;
- object_s64bit := s64;
- end;
-
-
-procedure tvmtobject.method_virtual_call_static_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
- begin
- method_static_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-procedure tvmtobject.method_virtual_call_virtual_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
- begin
- method_virtual_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-procedure tvmtobject.method_virtual_call_overriden_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
- begin
- method_virtual_overriden_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-
-procedure tvmtobject.method_virtual_call_normal_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
- begin
- method_normal_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-procedure tvmtobject.method_virtual_call_constructor_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
- begin
- constructor_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-procedure tvmtobject.method_virtual_call_inherited_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
- begin
- object_u8bit := u8;
- object_u16bit := u16;
- object_bigstring := bigstring;
- object_s32bit := s32;
- object_s64bit := s64;
- end;
-
-
-{**************************************************************************}
-{ INHERITED VMT OBJECT }
-{**************************************************************************}
-constructor theritedvmtobject.constructor_params_mixed_call_virtual(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
- begin
- object_u8bit := 0;
- object_u16bit := 0;
- object_bigstring := '';
- object_s32bit := 0;
- object_s64bit := 0;
- method_virtual_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-constructor theritedvmtobject.constructor_params_mixed_call_overriden(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
- begin
- object_u8bit := 0;
- object_u16bit := 0;
- object_bigstring := '';
- object_s32bit := 0;
- object_s64bit := 0;
- method_virtual_overriden_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-constructor theritedvmtobject.constructor_params_mixed_call_static(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
- begin
- object_u8bit := 0;
- object_u16bit := 0;
- object_bigstring := '';
- object_s32bit := 0;
- object_s64bit := 0;
- method_static_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-constructor theritedvmtobject.constructor_params_mixed_call_normal(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
- begin
- object_u8bit := 0;
- object_u16bit := 0;
- object_bigstring := '';
- object_s32bit := 0;
- object_s64bit := 0;
- method_normal_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-constructor theritedvmtobject.constructor_params_mixed_call_inherited
- (u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
- begin
- object_u8bit := 0;
- object_u16bit := 0;
- object_bigstring := '';
- object_s32bit := 0;
- object_s64bit := 0;
- inherited constructor_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-{ this one should be overriden }
-procedure theritedvmtobject.method_virtual_overriden_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
- begin
- object_u8bit := u8;
- object_u16bit := u16;
- object_bigstring := bigstring;
- object_s32bit := s32;
- object_s64bit := s64;
- end;
-
-procedure theritedvmtobject.method_normal_call_static_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
- begin
- method_static_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-procedure theritedvmtobject.method_normal_call_virtual_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
- begin
- method_virtual_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-procedure theritedvmtobject.method_normal_call_overriden_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
- begin
- method_virtual_overriden_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-
-procedure theritedvmtobject.method_normal_call_normal_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
- begin
- method_normal_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-procedure theritedvmtobject.method_normal_call_constructor_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
- begin
- constructor_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-procedure theritedvmtobject.method_normal_call_inherited_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
- begin
- Inherited method_normal_call_inherited_params_mixed(u8, u16, bigstring,
- s32, s64);
- end;
-
-procedure theritedvmtobject.method_virtual_call_inherited_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
- begin
- Inherited method_virtual_call_inherited_params_mixed(u8, u16, bigstring,
- s32, s64);
- end;
-
-
-procedure testnovmtobject;
-var
- novmtobject : tnovmtobject;
- failed : boolean;
-begin
- {******************** STATIC / METHOD SIMPLE CALL **********************}
- Write('No parameter / method call testing...');
- failed := false;
-
- clear_globals;
- clear_values;
-
- tnovmtobject.method_public_static_none;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- novmtobject.method_public_static_none;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- tnovmtobject.method_call_private_static_none;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_call_private_static_none;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_public_none;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_call_private_none;
- if global_u16bit <> (RESULT_U16BIT) then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- Write('Simple parameter (LOC_CONSTANT) / method call testing...');
- failed := false;
-
- clear_globals;
- clear_values;
-
- { parameter is LOC_CONSTANT }
- novmtobject.method_public_u8(RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- tnovmtobject.method_public_static_u8(RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_public_static_u8(RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_call_private_u8(RESULT_U8BIT);
- if global_u16bit <> (RESULT_U16BIT) then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_call_private_static_u8(RESULT_U8BIT);
- if global_u16bit <> (RESULT_U8BIT) then
- failed := true;
-
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
-
- Write('Simple parameter (LOC_REFERENCE) / method call testing...');
- failed := false;
-
- clear_globals;
- clear_values;
-
- value_u8bit := RESULT_U8BIT;
- novmtobject.method_public_u8(value_u8bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- value_u8bit := RESULT_U8BIT;
- tnovmtobject.method_public_static_u8(value_u8bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- value_u8bit := RESULT_U8BIT;
- novmtobject.method_public_static_u8(value_u8bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- value_u8bit := RESULT_U8BIT;
- novmtobject.method_call_private_u8(value_u8bit);
- if global_u16bit <> (RESULT_U16BIT) then
- failed := true;
-
- clear_globals;
- clear_values;
-
- value_u8bit := RESULT_U8BIT;
- novmtobject.method_call_private_static_u8(value_u8bit);
- if global_u16bit <> (RESULT_U8BIT) then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- Write('Simple parameter (LOC_REGISTER) / method call testing...');
- failed := false;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_public_u8(getu8);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- tnovmtobject.method_public_static_u8(getu8);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_public_static_u8(getu8);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_call_private_u8(getu8);
- if global_u16bit <> (RESULT_U16BIT) then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_call_private_static_u8(getu8);
- if global_u16bit <> (RESULT_U8BIT) then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- Write('Simple parameter / complex return / nested method access testing...');
-
- clear_globals;
- clear_values;
- failed := false;
- novmtobject.object_bigstring := RESULT_BIGSTRING;
- novmtobject.object_u16bit := RESULT_U16BIT;
-
- value_smallarray := novmtobject.func_array_mixed_nested(RESULT_U8BIT);
- if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-end;
-
-
-procedure testfailedobject;
-var
- failedobject : tfailvmtobject;
- begin
- Write('Testing constructor return value...');
- if failedobject.constructor_public_none then
- fail
- else
- Writeln('Passed!');
- end;
-
-
- procedure testvmtobject;
- var
- vmtobject : tvmtobject;
- failed : boolean;
- begin
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call...');
- vmtobject.constructor_params_mixed(RESULT_U8BIT, RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.constructor_params_mixed(value_u8bit, value_u16bit, value_bigstring,
- value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- end;
-
-
- procedure testheritedvmtobject;
- var
- vmtobject : theritedvmtobject;
- failed : boolean;
- begin
- {********************** CONSTRUCTOR TESTING ************************}
- {********************** DESTRUCTOR TESTING ************************}
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) inherited constructor call...');
- vmtobject.constructor_params_mixed_call_inherited(RESULT_U8BIT, RESULT_U16BIT, RESULT_BIGSTRING,
- RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) inherited constructor call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.constructor_params_mixed_call_inherited(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
- vmtobject.constructor_params_mixed_call_virtual(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.constructor_params_mixed_call_virtual(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
- vmtobject.constructor_params_mixed_call_overriden(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.constructor_params_mixed_call_overriden(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/method call...');
- vmtobject.constructor_params_mixed_call_normal(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.constructor_params_mixed_call_normal(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/static call...');
- vmtobject.constructor_params_mixed_call_static(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/static call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.constructor_params_mixed_call_static(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- {************************* METHOD TESTING **************************}
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
- vmtobject.method_virtual_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_virtual_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
- vmtobject.method_virtual_overriden_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_virtual_overriden_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call...');
- vmtobject.method_normal_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_normal_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) static method call...');
- vmtobject.method_static_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) static method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_static_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { ********************************************************************
- This calls methods which in turn call other methods, or a constructor
- or a destructor.
- *********************************************************************
- }
- clear_globals;
- clear_values;
- failed := false;
- { Calls the ancestor virtual method }
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
- vmtobject.method_normal_call_virtual_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_normal_call_virtual_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { The virtual method has been overriden by the object in this case }
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
- vmtobject.method_normal_call_overriden_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_normal_call_overriden_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/normal call...');
- vmtobject.method_normal_call_normal_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/normal call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_normal_call_normal_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- (* constructor call inside a normal method *)
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/constructor call...');
- vmtobject.method_normal_call_constructor_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/constructor call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_normal_call_constructor_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { static method call }
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/static call...');
- vmtobject.method_normal_call_static_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/static call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_normal_call_static_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- (* calls the inherited method *)
- clear_globals;
- clear_values;
- failed := false;
- { Calls the ancestor virtual method }
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/inherited call...');
- vmtobject.method_normal_call_inherited_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/inherited call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_normal_call_inherited_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { ********************************************************************
- This calls virtual methods which in turn call other methods,
- or a constructor or a destructor.
- *********************************************************************
- }
- clear_globals;
- clear_values;
- failed := false;
- { Calls the ancestor virtual method }
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
- vmtobject.method_virtual_call_virtual_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_virtual_call_virtual_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { The virtual method has been overriden by the object in this case }
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
- vmtobject.method_virtual_call_overriden_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_virtual_call_overriden_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/normal call...');
- vmtobject.method_virtual_call_normal_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/normal call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_virtual_call_normal_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- (* constructor call inside a normal method *)
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/constructor call...');
- vmtobject.method_virtual_call_constructor_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/constructor call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_virtual_call_constructor_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { static virtual call }
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/static call...');
- vmtobject.method_virtual_call_static_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/static call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_virtual_call_static_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- (* calls the inherited method *)
- clear_globals;
- clear_values;
- failed := false;
- { Calls the ancestor virtual method }
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/inherited call...');
- vmtobject.method_virtual_call_inherited_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/inherited call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_virtual_call_inherited_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
-
- end;
-
-
- { same as testvmtherited, except uses with statement }
- procedure testwith;
- var
- vmtobject : theritedvmtobject;
- failed : boolean;
- begin
- with vmtobject do
- begin
- {********************** CONSTRUCTOR TESTING ************************}
- {********************** DESTRUCTOR TESTING ************************}
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) inherited constructor call...');
- constructor_params_mixed_call_inherited(RESULT_U8BIT, RESULT_U16BIT, RESULT_BIGSTRING,
- RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) inherited constructor call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- constructor_params_mixed_call_inherited(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
- constructor_params_mixed_call_virtual(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- constructor_params_mixed_call_virtual(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
- constructor_params_mixed_call_overriden(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- constructor_params_mixed_call_overriden(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/method call...');
- constructor_params_mixed_call_normal(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- constructor_params_mixed_call_normal(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/static call...');
- constructor_params_mixed_call_static(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/static call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- constructor_params_mixed_call_static(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- {************************* METHOD TESTING **************************}
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
- method_virtual_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_virtual_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
- method_virtual_overriden_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_virtual_overriden_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call...');
- method_normal_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_normal_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) static method call...');
- method_static_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) static method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_static_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { ********************************************************************
- This calls methods which in turn call other methods, or a constructor
- or a destructor.
- *********************************************************************
- }
- clear_globals;
- clear_values;
- failed := false;
- { Calls the ancestor virtual method }
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
- method_normal_call_virtual_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_normal_call_virtual_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { The virtual method has been overriden by the object in this case }
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
- method_normal_call_overriden_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_normal_call_overriden_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/normal call...');
- method_normal_call_normal_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/normal call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_normal_call_normal_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- (* constructor call inside a normal method *)
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/constructor call...');
- method_normal_call_constructor_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/constructor call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_normal_call_constructor_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { static method call }
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/static call...');
- method_normal_call_static_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/static call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_normal_call_static_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- (* calls the inherited method *)
- clear_globals;
- clear_values;
- failed := false;
- { Calls the ancestor virtual method }
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/inherited call...');
- method_normal_call_inherited_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/inherited call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_normal_call_inherited_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { ********************************************************************
- This calls virtual methods which in turn call other methods,
- or a constructor or a destructor.
- *********************************************************************
- }
- clear_globals;
- clear_values;
- failed := false;
- { Calls the ancestor virtual method }
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
- method_virtual_call_virtual_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_virtual_call_virtual_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { The virtual method has been overriden by the object in this case }
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
- method_virtual_call_overriden_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_virtual_call_overriden_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/normal call...');
- method_virtual_call_normal_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/normal call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_virtual_call_normal_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- (* constructor call inside a normal method *)
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/constructor call...');
- method_virtual_call_constructor_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/constructor call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_virtual_call_constructor_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { static virtual call }
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/static call...');
- method_virtual_call_static_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/static call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_virtual_call_static_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- (* calls the inherited method *)
- clear_globals;
- clear_values;
- failed := false;
- { Calls the ancestor virtual method }
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/inherited call...');
- method_virtual_call_inherited_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/inherited call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_virtual_call_inherited_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
- end; { end with }
- end;
-
-
-begin
- WriteLN('*********************** NO VMT OBJECT TESTS ********************');
- testnovmtobject;
- WriteLN('************************ VMT OBJECT FAIL **********************');
- testfailedobject;
- WriteLN('************************* VMT OBJECT TESTS *********************');
- testvmtobject;
- testheritedvmtobject;
- WriteLN('**************** VMT OBJECT TESTS USING WITH *******************');
- testwith;
-end.
-
-{
+{****************************************************************}
+{ CODE GENERATOR TEST PROGRAM }
+{ Copyright (c) 2002 Carl Eric Codere }
+{****************************************************************}
+{ NODE TESTED : secondcalln() }
+{****************************************************************}
+{ PRE-REQUISITES: secondload() }
+{ secondassign() }
+{ secondtypeconv() }
+{ secondtryexcept() }
+{****************************************************************}
+{ DEFINES: }
+{ FPC = Target is FreePascal compiler }
+{****************************************************************}
+{ REMARKS: This tests secondcalln(), genentrycode() and }
+{ genexitcode() for standard object with the register }
+{ calling convention. }
+{ }
+{****************************************************************}
+program tcalobj6;
+{$STATIC ON}
+{$R+}
+
+ const
+ { should be defined depending on CPU target }
+ {$ifdef cpu68k}
+ BIG_INDEX = 8000;
+ SMALL_INDEX = 13;
+ {$else}
+ BIG_INDEX = 33000;
+ SMALL_INDEX = 13; { value should not be aligned! }
+ {$endif}
+ RESULT_U8BIT = $55;
+ RESULT_U16BIT = 2*RESULT_U8BIT;
+ RESULT_S32BIT = $500F0000;
+ RESULT_S64BIT = $500F0000;
+ RESULT_S32REAL = 1777.12;
+ RESULT_S64REAL = 3444.24;
+ RESULT_BOOL8BIT = 1;
+ RESULT_BOOL16BIT = 1;
+ RESULT_BOOL32BIT = 1;
+ RESULT_PCHAR = 'Hello world';
+ RESULT_BIGSTRING = 'Hello world';
+ RESULT_SMALLSTRING = 'H';
+ RESULT_CHAR = 'I';
+ RESULT_BOOLEAN = TRUE;
+
+ type
+
+ tprocedure = procedure;
+
+ tsmallrecord = packed record
+ b: byte;
+ w: word;
+ end;
+
+ tlargerecord = packed record
+ b: array[1..BIG_INDEX] of byte;
+ end;
+
+ tsmallarray = packed array[1..SMALL_INDEX] of byte;
+
+ tsmallsetenum =
+ (A_A,A_B,A_C,A_D);
+
+ tsmallset = set of tsmallsetenum;
+ tlargeset = set of char;
+
+ tsmallstring = string[2];
+
+
+ var
+ global_u8bit : byte;
+ global_u16bit : word;
+ global_s32bit : longint;
+ global_s32real : single;
+ global_s64real : double;
+ global_ptr : pchar;
+ global_proc : tprocedure;
+ global_bigstring : shortstring;
+ global_boolean : boolean;
+ global_char : char;
+ global_s64bit : int64;
+ value_s64bit : int64;
+ value_ansistring : ansistring;
+ value_u8bit : byte;
+ value_u16bit : word;
+ value_s32bit : longint;
+ value_s32real : single;
+ value_s64real : double;
+ value_proc : tprocedure;
+ value_ptr : pchar;
+ value_smallrec : tsmallrecord;
+ value_largerec : tlargerecord;
+ value_smallset : tsmallset;
+ value_smallstring : tsmallstring;
+ value_bigstring : shortstring;
+ value_largeset : tlargeset;
+ value_smallarray : tsmallarray;
+ value_boolean : boolean;
+ value_char : char;
+
+ procedure fail;
+ begin
+ WriteLn('Failure.');
+ halt(1);
+ end;
+
+
+ procedure clear_globals;
+ begin
+ global_u8bit := 0;
+ global_u16bit := 0;
+ global_s32bit := 0;
+ global_s32real := 0.0;
+ global_s64real := 0.0;
+ global_ptr := nil;
+ global_proc := nil;
+ global_bigstring := '';
+ global_boolean := false;
+ global_char := #0;
+ global_s64bit := 0;
+ end;
+
+
+ procedure clear_values;
+ begin
+ value_u8bit := 0;
+ value_u16bit := 0;
+ value_s32bit := 0;
+ value_s32real := 0.0;
+ value_s64real := 0.0;
+ value_proc := nil;
+ value_ptr := nil;
+ fillchar(value_smallrec, sizeof(value_smallrec), #0);
+ fillchar(value_largerec, sizeof(value_largerec), #0);
+ value_smallset := [];
+ value_smallstring := '';
+ value_bigstring := '';
+ value_largeset := [];
+ fillchar(value_smallarray, sizeof(value_smallarray), #0);
+ value_boolean := false;
+ value_char:=#0;
+ value_ansistring := '';
+ value_s64bit := 0;
+ end;
+
+
+ function getu8: byte;
+ begin
+ getu8 := RESULT_U8BIT;
+ end;
+
+
+type
+
+ { object without vmt }
+ pnovmtobject = ^tnovmtobject;
+ tnovmtobject = object
+ public
+ object_bigstring : shortstring;
+ object_u16bit : word;
+ { no parameter testing }
+ procedure method_public_none;register;
+ procedure method_public_static_none; static;register;
+ procedure method_call_private_none;register;
+ procedure method_call_private_static_none; static;register;
+ { simple value parameter testing }
+ procedure method_public_u8(x : byte);register;
+ procedure method_public_static_u8(x: byte); static;register;
+ procedure method_call_private_u8(x: byte);register;
+ procedure method_call_private_static_u8(x: byte); static;register;
+ function func_array_mixed_nested(b: byte): tsmallarray;register;
+ private
+ procedure method_private_none;register;
+ procedure method_private_static_none; static;register;
+ function func_getu16bit : word;register;
+ { simple value parameter testing }
+ procedure method_private_u8(x: byte);register;
+ procedure method_private_static_u8(x: byte); static;register;
+ end;
+
+
+ { object with vmt }
+ pvmtobject = ^tvmtobject;
+ tvmtobject = object
+ public
+ object_u8bit : byte;
+ object_u16bit : word;
+ object_bigstring : shortstring;
+ object_s32bit : longint;
+ object_s64bit : int64;
+ constructor constructor_params_mixed(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);
+ constructor constructor_init;
+ destructor destructor_params_done;
+ procedure method_normal_params_mixed(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);register;
+ procedure method_virtual_params_mixed(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);virtual;register;
+ procedure method_virtual_overriden_params_mixed(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);virtual;register;
+ procedure method_static_params_mixed(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);static;register;
+ procedure method_normal_call_inherited_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
+
+ { virtual methods which call other methods }
+ procedure method_virtual_call_static_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;register;
+ procedure method_virtual_call_virtual_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;register;
+ procedure method_virtual_call_overriden_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;register;
+ procedure method_virtual_call_normal_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;register;
+ procedure method_virtual_call_constructor_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;register;
+ procedure method_virtual_call_inherited_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;register;
+
+ end;
+
+ pheritedvmtobject = ^theritedvmtobject;
+ theritedvmtobject = object(tvmtobject)
+ constructor constructor_params_mixed_call_virtual(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);
+ constructor constructor_params_mixed_call_overriden(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);
+ constructor constructor_params_mixed_call_static(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);
+ constructor constructor_params_mixed_call_normal(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);
+ constructor constructor_params_mixed_call_inherited(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);
+ procedure method_virtual_overriden_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;register;
+
+ { normal methods which call other methods }
+ procedure method_normal_call_static_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
+ procedure method_normal_call_virtual_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
+ procedure method_normal_call_overriden_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
+ procedure method_normal_call_normal_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
+ procedure method_normal_call_constructor_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
+ procedure method_normal_call_inherited_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
+
+ { virtual methods which call other methods }
+ procedure method_virtual_call_inherited_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;register;
+
+ end;
+
+ pfailvmtobject = ^tfailvmtobject;
+ tfailvmtobject = object(tvmtobject)
+ public
+ constructor constructor_public_none;
+ end;
+
+
+
+{**************************************************************************}
+{ NO VMT OBJECT }
+{**************************************************************************}
+
+ {****************** NO PARAMETERS ******************}
+ procedure tnovmtobject.method_public_none;register;
+ begin
+ global_u8bit := RESULT_U8BIT;
+ end;
+
+
+ procedure tnovmtobject.method_public_static_none;register;
+ begin
+ global_u8bit := RESULT_U8BIT;
+ end;
+
+
+ procedure tnovmtobject.method_call_private_none;register;
+ begin
+ method_private_none;
+ method_private_static_none;
+ end;
+
+ procedure tnovmtobject.method_call_private_static_none;register;
+ begin
+ method_private_static_none;
+ end;
+
+
+ procedure tnovmtobject.method_private_none;register;
+ begin
+ Inc(global_u16bit, RESULT_U8BIT);
+ end;
+
+
+ procedure tnovmtobject.method_private_static_none;register;
+ begin
+ Inc(global_u16bit, RESULT_U8BIT);
+ end;
+
+ {******************** PARAMETERS ******************}
+
+ procedure tnovmtobject.method_public_u8(x : byte);register;
+ begin
+ global_u8bit := x;
+ end;
+
+ procedure tnovmtobject.method_public_static_u8(x: byte);register;
+ begin
+ global_u8bit := x;
+ end;
+
+ procedure tnovmtobject.method_call_private_u8(x: byte);register;
+ begin
+ method_private_static_u8(x);
+ method_private_u8(x);
+ end;
+
+ procedure tnovmtobject. method_call_private_static_u8(x: byte);register;
+ begin
+ method_private_static_u8(x);
+ end;
+
+ procedure tnovmtobject.method_private_u8(x: byte);register;
+ begin
+ Inc(global_u16bit,x);
+ end;
+
+ procedure tnovmtobject.method_private_static_u8(x: byte);register;
+ begin
+ Inc(global_u16bit,x);
+ end;
+
+
+ function tnovmtobject.func_getu16bit : word;register;
+ begin
+ func_getu16bit := object_u16bit;
+ end;
+
+ {
+ complex testing, nested field access, with parameters and
+ comple return value.
+
+ On exit : global_u8bit := x;
+ global_u16bit := object_u16bit (from func_getu16bit);
+ global_s32bit := RESULT_S32BIT
+ global_bigstring := object_bigstring
+ global_s64bit := x;
+ }
+ function tnovmtobject.func_array_mixed_nested(b: byte): tsmallarray;register;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := func_getu16bit;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ smallarray: tsmallarray;
+ begin
+ fillchar(smallarray, sizeof(smallarray), #0);
+ smallarray[1] := RESULT_U8BIT;
+ smallarray[SMALL_INDEX] := RESULT_U8BIT;
+ func_array_mixed_nested := smallarray;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, object_bigstring);
+ end;
+
+{**************************************************************************}
+{ FAILED OBJECT }
+{**************************************************************************}
+constructor tfailvmtobject.constructor_public_none;
+ begin
+ { this calls the constructor fail special keyword }
+ fail;
+ end;
+
+{**************************************************************************}
+{ VMT OBJECT }
+{**************************************************************************}
+constructor tvmtobject.constructor_params_mixed(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);
+ begin
+ object_u8bit := u8;
+ object_u16bit := u16;
+ object_bigstring := bigstring;
+ object_s32bit := s32;
+ object_s64bit := s64;
+ end;
+
+
+constructor tvmtobject.constructor_init;
+ begin
+ object_u8bit := 0;
+ object_u16bit := 0;
+ object_bigstring := '';
+ object_s32bit := 0;
+ object_s64bit := 0;
+ end;
+
+destructor tvmtobject.destructor_params_done;
+ begin
+ object_u8bit := 0;
+ object_u16bit := 0;
+ object_bigstring := '';
+ object_s32bit := 0;
+ object_s64bit := 0;
+ end;
+
+
+procedure tvmtobject.method_normal_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
+ begin
+ object_u8bit := u8;
+ object_u16bit := u16;
+ object_bigstring := bigstring;
+ object_s32bit := s32;
+ object_s64bit := s64;
+ end;
+
+procedure tvmtobject.method_virtual_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
+ begin
+ object_u8bit := u8;
+ object_u16bit := u16;
+ object_bigstring := bigstring;
+ object_s32bit := s32;
+ object_s64bit := s64;
+ end;
+
+{ this one should be overriden }
+procedure tvmtobject.method_virtual_overriden_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
+ begin
+ RunError(211);
+ end;
+
+{ can't access field of instances in static methods }
+procedure tvmtobject.method_static_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
+ begin
+ global_u8bit := u8;
+ global_u16bit := u16;
+ global_bigstring := bigstring;
+ global_s32bit := s32;
+ global_s64bit := s64;
+ end;
+
+procedure tvmtobject.method_normal_call_inherited_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
+ begin
+ object_u8bit := u8;
+ object_u16bit := u16;
+ object_bigstring := bigstring;
+ object_s32bit := s32;
+ object_s64bit := s64;
+ end;
+
+
+procedure tvmtobject.method_virtual_call_static_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
+ begin
+ method_static_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+procedure tvmtobject.method_virtual_call_virtual_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
+ begin
+ method_virtual_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+procedure tvmtobject.method_virtual_call_overriden_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
+ begin
+ method_virtual_overriden_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+
+procedure tvmtobject.method_virtual_call_normal_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
+ begin
+ method_normal_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+procedure tvmtobject.method_virtual_call_constructor_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
+ begin
+ constructor_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+procedure tvmtobject.method_virtual_call_inherited_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
+ begin
+ object_u8bit := u8;
+ object_u16bit := u16;
+ object_bigstring := bigstring;
+ object_s32bit := s32;
+ object_s64bit := s64;
+ end;
+
+
+{**************************************************************************}
+{ INHERITED VMT OBJECT }
+{**************************************************************************}
+constructor theritedvmtobject.constructor_params_mixed_call_virtual(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
+ begin
+ object_u8bit := 0;
+ object_u16bit := 0;
+ object_bigstring := '';
+ object_s32bit := 0;
+ object_s64bit := 0;
+ method_virtual_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+constructor theritedvmtobject.constructor_params_mixed_call_overriden(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
+ begin
+ object_u8bit := 0;
+ object_u16bit := 0;
+ object_bigstring := '';
+ object_s32bit := 0;
+ object_s64bit := 0;
+ method_virtual_overriden_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+constructor theritedvmtobject.constructor_params_mixed_call_static(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
+ begin
+ object_u8bit := 0;
+ object_u16bit := 0;
+ object_bigstring := '';
+ object_s32bit := 0;
+ object_s64bit := 0;
+ method_static_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+constructor theritedvmtobject.constructor_params_mixed_call_normal(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
+ begin
+ object_u8bit := 0;
+ object_u16bit := 0;
+ object_bigstring := '';
+ object_s32bit := 0;
+ object_s64bit := 0;
+ method_normal_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+constructor theritedvmtobject.constructor_params_mixed_call_inherited
+ (u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
+ begin
+ object_u8bit := 0;
+ object_u16bit := 0;
+ object_bigstring := '';
+ object_s32bit := 0;
+ object_s64bit := 0;
+ inherited constructor_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+{ this one should be overriden }
+procedure theritedvmtobject.method_virtual_overriden_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
+ begin
+ object_u8bit := u8;
+ object_u16bit := u16;
+ object_bigstring := bigstring;
+ object_s32bit := s32;
+ object_s64bit := s64;
+ end;
+
+procedure theritedvmtobject.method_normal_call_static_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
+ begin
+ method_static_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+procedure theritedvmtobject.method_normal_call_virtual_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
+ begin
+ method_virtual_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+procedure theritedvmtobject.method_normal_call_overriden_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
+ begin
+ method_virtual_overriden_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+
+procedure theritedvmtobject.method_normal_call_normal_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
+ begin
+ method_normal_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+procedure theritedvmtobject.method_normal_call_constructor_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
+ begin
+ constructor_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+procedure theritedvmtobject.method_normal_call_inherited_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
+ begin
+ Inherited method_normal_call_inherited_params_mixed(u8, u16, bigstring,
+ s32, s64);
+ end;
+
+procedure theritedvmtobject.method_virtual_call_inherited_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);register;
+ begin
+ Inherited method_virtual_call_inherited_params_mixed(u8, u16, bigstring,
+ s32, s64);
+ end;
+
+
+procedure testnovmtobject;
+var
+ novmtobject : tnovmtobject;
+ failed : boolean;
+begin
+ {******************** STATIC / METHOD SIMPLE CALL **********************}
+ Write('No parameter / method call testing...');
+ failed := false;
+
+ clear_globals;
+ clear_values;
+
+ tnovmtobject.method_public_static_none;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ novmtobject.method_public_static_none;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ tnovmtobject.method_call_private_static_none;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_call_private_static_none;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_public_none;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_call_private_none;
+ if global_u16bit <> (RESULT_U16BIT) then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ Write('Simple parameter (LOC_CONSTANT) / method call testing...');
+ failed := false;
+
+ clear_globals;
+ clear_values;
+
+ { parameter is LOC_CONSTANT }
+ novmtobject.method_public_u8(RESULT_U8BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ tnovmtobject.method_public_static_u8(RESULT_U8BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_public_static_u8(RESULT_U8BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_call_private_u8(RESULT_U8BIT);
+ if global_u16bit <> (RESULT_U16BIT) then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_call_private_static_u8(RESULT_U8BIT);
+ if global_u16bit <> (RESULT_U8BIT) then
+ failed := true;
+
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+
+ Write('Simple parameter (LOC_REFERENCE) / method call testing...');
+ failed := false;
+
+ clear_globals;
+ clear_values;
+
+ value_u8bit := RESULT_U8BIT;
+ novmtobject.method_public_u8(value_u8bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ value_u8bit := RESULT_U8BIT;
+ tnovmtobject.method_public_static_u8(value_u8bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ value_u8bit := RESULT_U8BIT;
+ novmtobject.method_public_static_u8(value_u8bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ value_u8bit := RESULT_U8BIT;
+ novmtobject.method_call_private_u8(value_u8bit);
+ if global_u16bit <> (RESULT_U16BIT) then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ value_u8bit := RESULT_U8BIT;
+ novmtobject.method_call_private_static_u8(value_u8bit);
+ if global_u16bit <> (RESULT_U8BIT) then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ Write('Simple parameter (LOC_REGISTER) / method call testing...');
+ failed := false;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_public_u8(getu8);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ tnovmtobject.method_public_static_u8(getu8);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_public_static_u8(getu8);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_call_private_u8(getu8);
+ if global_u16bit <> (RESULT_U16BIT) then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_call_private_static_u8(getu8);
+ if global_u16bit <> (RESULT_U8BIT) then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ Write('Simple parameter / complex return / nested method access testing...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+ novmtobject.object_bigstring := RESULT_BIGSTRING;
+ novmtobject.object_u16bit := RESULT_U16BIT;
+
+ value_smallarray := novmtobject.func_array_mixed_nested(RESULT_U8BIT);
+ if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+end;
+
+
+procedure testfailedobject;
+var
+ failedobject : tfailvmtobject;
+ begin
+ Write('Testing constructor return value...');
+ if failedobject.constructor_public_none then
+ fail
+ else
+ Writeln('Passed!');
+ end;
+
+
+ procedure testvmtobject;
+ var
+ vmtobject : tvmtobject;
+ failed : boolean;
+ begin
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call...');
+ vmtobject.constructor_params_mixed(RESULT_U8BIT, RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.constructor_params_mixed(value_u8bit, value_u16bit, value_bigstring,
+ value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ end;
+
+
+ procedure testheritedvmtobject;
+ var
+ vmtobject : theritedvmtobject;
+ failed : boolean;
+ begin
+ {********************** CONSTRUCTOR TESTING ************************}
+ {********************** DESTRUCTOR TESTING ************************}
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) inherited constructor call...');
+ vmtobject.constructor_params_mixed_call_inherited(RESULT_U8BIT, RESULT_U16BIT, RESULT_BIGSTRING,
+ RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) inherited constructor call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.constructor_params_mixed_call_inherited(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
+ vmtobject.constructor_params_mixed_call_virtual(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.constructor_params_mixed_call_virtual(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
+ vmtobject.constructor_params_mixed_call_overriden(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.constructor_params_mixed_call_overriden(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/method call...');
+ vmtobject.constructor_params_mixed_call_normal(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.constructor_params_mixed_call_normal(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/static call...');
+ vmtobject.constructor_params_mixed_call_static(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/static call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.constructor_params_mixed_call_static(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ {************************* METHOD TESTING **************************}
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
+ vmtobject.method_virtual_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_virtual_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
+ vmtobject.method_virtual_overriden_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_virtual_overriden_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call...');
+ vmtobject.method_normal_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_normal_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) static method call...');
+ vmtobject.method_static_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) static method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_static_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { ********************************************************************
+ This calls methods which in turn call other methods, or a constructor
+ or a destructor.
+ *********************************************************************
+ }
+ clear_globals;
+ clear_values;
+ failed := false;
+ { Calls the ancestor virtual method }
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
+ vmtobject.method_normal_call_virtual_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_normal_call_virtual_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { The virtual method has been overriden by the object in this case }
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
+ vmtobject.method_normal_call_overriden_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_normal_call_overriden_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/normal call...');
+ vmtobject.method_normal_call_normal_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/normal call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_normal_call_normal_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ (* constructor call inside a normal method *)
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/constructor call...');
+ vmtobject.method_normal_call_constructor_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/constructor call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_normal_call_constructor_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { static method call }
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/static call...');
+ vmtobject.method_normal_call_static_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/static call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_normal_call_static_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ (* calls the inherited method *)
+ clear_globals;
+ clear_values;
+ failed := false;
+ { Calls the ancestor virtual method }
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/inherited call...');
+ vmtobject.method_normal_call_inherited_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/inherited call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_normal_call_inherited_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { ********************************************************************
+ This calls virtual methods which in turn call other methods,
+ or a constructor or a destructor.
+ *********************************************************************
+ }
+ clear_globals;
+ clear_values;
+ failed := false;
+ { Calls the ancestor virtual method }
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
+ vmtobject.method_virtual_call_virtual_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_virtual_call_virtual_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { The virtual method has been overriden by the object in this case }
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
+ vmtobject.method_virtual_call_overriden_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_virtual_call_overriden_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/normal call...');
+ vmtobject.method_virtual_call_normal_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/normal call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_virtual_call_normal_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ (* constructor call inside a normal method *)
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/constructor call...');
+ vmtobject.method_virtual_call_constructor_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/constructor call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_virtual_call_constructor_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { static virtual call }
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/static call...');
+ vmtobject.method_virtual_call_static_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/static call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_virtual_call_static_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ (* calls the inherited method *)
+ clear_globals;
+ clear_values;
+ failed := false;
+ { Calls the ancestor virtual method }
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/inherited call...');
+ vmtobject.method_virtual_call_inherited_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/inherited call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_virtual_call_inherited_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+
+ end;
+
+
+ { same as testvmtherited, except uses with statement }
+ procedure testwith;
+ var
+ vmtobject : theritedvmtobject;
+ failed : boolean;
+ begin
+ with vmtobject do
+ begin
+ {********************** CONSTRUCTOR TESTING ************************}
+ {********************** DESTRUCTOR TESTING ************************}
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) inherited constructor call...');
+ constructor_params_mixed_call_inherited(RESULT_U8BIT, RESULT_U16BIT, RESULT_BIGSTRING,
+ RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) inherited constructor call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ constructor_params_mixed_call_inherited(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
+ constructor_params_mixed_call_virtual(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ constructor_params_mixed_call_virtual(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
+ constructor_params_mixed_call_overriden(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ constructor_params_mixed_call_overriden(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/method call...');
+ constructor_params_mixed_call_normal(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ constructor_params_mixed_call_normal(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/static call...');
+ constructor_params_mixed_call_static(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/static call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ constructor_params_mixed_call_static(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ {************************* METHOD TESTING **************************}
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
+ method_virtual_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_virtual_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
+ method_virtual_overriden_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_virtual_overriden_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call...');
+ method_normal_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_normal_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) static method call...');
+ method_static_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) static method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_static_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { ********************************************************************
+ This calls methods which in turn call other methods, or a constructor
+ or a destructor.
+ *********************************************************************
+ }
+ clear_globals;
+ clear_values;
+ failed := false;
+ { Calls the ancestor virtual method }
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
+ method_normal_call_virtual_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_normal_call_virtual_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { The virtual method has been overriden by the object in this case }
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
+ method_normal_call_overriden_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_normal_call_overriden_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/normal call...');
+ method_normal_call_normal_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/normal call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_normal_call_normal_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ (* constructor call inside a normal method *)
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/constructor call...');
+ method_normal_call_constructor_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/constructor call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_normal_call_constructor_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { static method call }
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/static call...');
+ method_normal_call_static_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/static call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_normal_call_static_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ (* calls the inherited method *)
+ clear_globals;
+ clear_values;
+ failed := false;
+ { Calls the ancestor virtual method }
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/inherited call...');
+ method_normal_call_inherited_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/inherited call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_normal_call_inherited_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { ********************************************************************
+ This calls virtual methods which in turn call other methods,
+ or a constructor or a destructor.
+ *********************************************************************
+ }
+ clear_globals;
+ clear_values;
+ failed := false;
+ { Calls the ancestor virtual method }
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
+ method_virtual_call_virtual_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_virtual_call_virtual_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { The virtual method has been overriden by the object in this case }
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
+ method_virtual_call_overriden_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_virtual_call_overriden_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/normal call...');
+ method_virtual_call_normal_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/normal call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_virtual_call_normal_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ (* constructor call inside a normal method *)
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/constructor call...');
+ method_virtual_call_constructor_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/constructor call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_virtual_call_constructor_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { static virtual call }
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/static call...');
+ method_virtual_call_static_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/static call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_virtual_call_static_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ (* calls the inherited method *)
+ clear_globals;
+ clear_values;
+ failed := false;
+ { Calls the ancestor virtual method }
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/inherited call...');
+ method_virtual_call_inherited_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/inherited call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_virtual_call_inherited_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+ end; { end with }
+ end;
+
+
+begin
+ WriteLN('*********************** NO VMT OBJECT TESTS ********************');
+ testnovmtobject;
+ WriteLN('************************ VMT OBJECT FAIL **********************');
+ testfailedobject;
+ WriteLN('************************* VMT OBJECT TESTS *********************');
+ testvmtobject;
+ testheritedvmtobject;
+ WriteLN('**************** VMT OBJECT TESTS USING WITH *******************');
+ testwith;
+end.
+
+{
$Log$
- Revision 1.5 2003-04-22 10:24:29 florian
+ Revision 1.6 2004-05-02 12:11:44 peter
+ * fixed linefeeds
+
+ Revision 1.5 2003/04/22 10:24:29 florian
* fixed defines for powerpc
-
- Revision 1.4 2003/01/05 18:21:30 peter
- * removed more conflicting calling directives
-
- Revision 1.3 2002/09/07 15:40:54 peter
- * old logs removed and tabs fixed
-
- Revision 1.2 2002/05/05 19:13:19 carl
- + withsymtable checking
-
- Revision 1.1 2002/05/05 13:58:50 carl
- + finished procedural variable testsuit
- + finished method testsuit
-
-}
+
+ Revision 1.4 2003/01/05 18:21:30 peter
+ * removed more conflicting calling directives
+
+ Revision 1.3 2002/09/07 15:40:54 peter
+ * old logs removed and tabs fixed
+
+ Revision 1.2 2002/05/05 19:13:19 carl
+ + withsymtable checking
+
+ Revision 1.1 2002/05/05 13:58:50 carl
+ + finished procedural variable testsuit
+ + finished method testsuit
+
+}
diff --git a/tests/test/cg/tcalobj7.pp b/tests/test/cg/tcalobj7.pp
index a60a6166c1..5658c4a664 100644
--- a/tests/test/cg/tcalobj7.pp
+++ b/tests/test/cg/tcalobj7.pp
@@ -1,3314 +1,3317 @@
-{****************************************************************}
-{ CODE GENERATOR TEST PROGRAM }
-{ Copyright (c) 2002 Carl Eric Codere }
-{****************************************************************}
-{ NODE TESTED : secondcalln() }
-{****************************************************************}
-{ PRE-REQUISITES: secondload() }
-{ secondassign() }
-{ secondtypeconv() }
-{ secondtryexcept() }
-{****************************************************************}
-{ DEFINES: }
-{ FPC = Target is FreePascal compiler }
-{****************************************************************}
-{ REMARKS: This tests secondcalln(), genentrycode() and }
-{ genexitcode() for standard object with the stdcall }
-{ calling convention. }
-{ }
-{****************************************************************}
-program tcalobj7;
-{$STATIC ON}
-{$R+}
-
- const
- { should be defined depending on CPU target }
- {$ifdef cpu68k}
- BIG_INDEX = 8000;
- SMALL_INDEX = 13;
- {$else}
- BIG_INDEX = 33000;
- SMALL_INDEX = 13; { value should not be aligned! }
- {$endif}
- RESULT_U8BIT = $55;
- RESULT_U16BIT = 2*RESULT_U8BIT;
- RESULT_S32BIT = $500F0000;
- RESULT_S64BIT = $500F0000;
- RESULT_S32REAL = 1777.12;
- RESULT_S64REAL = 3444.24;
- RESULT_BOOL8BIT = 1;
- RESULT_BOOL16BIT = 1;
- RESULT_BOOL32BIT = 1;
- RESULT_PCHAR = 'Hello world';
- RESULT_BIGSTRING = 'Hello world';
- RESULT_SMALLSTRING = 'H';
- RESULT_CHAR = 'I';
- RESULT_BOOLEAN = TRUE;
-
- type
-
- tprocedure = procedure;
-
- tsmallrecord = packed record
- b: byte;
- w: word;
- end;
-
- tlargerecord = packed record
- b: array[1..BIG_INDEX] of byte;
- end;
-
- tsmallarray = packed array[1..SMALL_INDEX] of byte;
-
- tsmallsetenum =
- (A_A,A_B,A_C,A_D);
-
- tsmallset = set of tsmallsetenum;
- tlargeset = set of char;
-
- tsmallstring = string[2];
-
-
- var
- global_u8bit : byte;
- global_u16bit : word;
- global_s32bit : longint;
- global_s32real : single;
- global_s64real : double;
- global_ptr : pchar;
- global_proc : tprocedure;
- global_bigstring : shortstring;
- global_boolean : boolean;
- global_char : char;
- global_s64bit : int64;
- value_s64bit : int64;
- value_ansistring : ansistring;
- value_u8bit : byte;
- value_u16bit : word;
- value_s32bit : longint;
- value_s32real : single;
- value_s64real : double;
- value_proc : tprocedure;
- value_ptr : pchar;
- value_smallrec : tsmallrecord;
- value_largerec : tlargerecord;
- value_smallset : tsmallset;
- value_smallstring : tsmallstring;
- value_bigstring : shortstring;
- value_largeset : tlargeset;
- value_smallarray : tsmallarray;
- value_boolean : boolean;
- value_char : char;
-
- procedure fail;
- begin
- WriteLn('Failure.');
- halt(1);
- end;
-
-
- procedure clear_globals;
- begin
- global_u8bit := 0;
- global_u16bit := 0;
- global_s32bit := 0;
- global_s32real := 0.0;
- global_s64real := 0.0;
- global_ptr := nil;
- global_proc := nil;
- global_bigstring := '';
- global_boolean := false;
- global_char := #0;
- global_s64bit := 0;
- end;
-
-
- procedure clear_values;
- begin
- value_u8bit := 0;
- value_u16bit := 0;
- value_s32bit := 0;
- value_s32real := 0.0;
- value_s64real := 0.0;
- value_proc := nil;
- value_ptr := nil;
- fillchar(value_smallrec, sizeof(value_smallrec), #0);
- fillchar(value_largerec, sizeof(value_largerec), #0);
- value_smallset := [];
- value_smallstring := '';
- value_bigstring := '';
- value_largeset := [];
- fillchar(value_smallarray, sizeof(value_smallarray), #0);
- value_boolean := false;
- value_char:=#0;
- value_ansistring := '';
- value_s64bit := 0;
- end;
-
-
- function getu8: byte;
- begin
- getu8 := RESULT_U8BIT;
- end;
-
-
-type
-
- { object without vmt }
- pnovmtobject = ^tnovmtobject;
- tnovmtobject = object
- public
- object_bigstring : shortstring;
- object_u16bit : word;
- { no parameter testing }
- procedure method_public_none;stdcall;
- procedure method_public_static_none; static;stdcall;
- procedure method_call_private_none;stdcall;
- procedure method_call_private_static_none; static;stdcall;
- { simple value parameter testing }
- procedure method_public_u8(x : byte);stdcall;
- procedure method_public_static_u8(x: byte); static;stdcall;
- procedure method_call_private_u8(x: byte);stdcall;
- procedure method_call_private_static_u8(x: byte); static;stdcall;
- function func_array_mixed_nested(b: byte): tsmallarray;stdcall;
- private
- procedure method_private_none;stdcall;
- procedure method_private_static_none; static;stdcall;
- function func_getu16bit : word;stdcall;
- { simple value parameter testing }
- procedure method_private_u8(x: byte);stdcall;
- procedure method_private_static_u8(x: byte); static;stdcall;
- end;
-
-
- { object with vmt }
- pvmtobject = ^tvmtobject;
- tvmtobject = object
- public
- object_u8bit : byte;
- object_u16bit : word;
- object_bigstring : shortstring;
- object_s32bit : longint;
- object_s64bit : int64;
- constructor constructor_params_mixed(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);
- constructor constructor_init;
- destructor destructor_params_done;
- procedure method_normal_params_mixed(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);stdcall;
- procedure method_virtual_params_mixed(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);virtual;stdcall;
- procedure method_virtual_overriden_params_mixed(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);virtual;stdcall;
- procedure method_static_params_mixed(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);static;stdcall;
- procedure method_normal_call_inherited_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
-
- { virtual methods which call other methods }
- procedure method_virtual_call_static_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;stdcall;
- procedure method_virtual_call_virtual_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;stdcall;
- procedure method_virtual_call_overriden_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;stdcall;
- procedure method_virtual_call_normal_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;stdcall;
- procedure method_virtual_call_constructor_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;stdcall;
- procedure method_virtual_call_inherited_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;stdcall;
-
- end;
-
- pheritedvmtobject = ^theritedvmtobject;
- theritedvmtobject = object(tvmtobject)
- constructor constructor_params_mixed_call_virtual(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);
- constructor constructor_params_mixed_call_overriden(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);
- constructor constructor_params_mixed_call_static(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);
- constructor constructor_params_mixed_call_normal(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);
- constructor constructor_params_mixed_call_inherited(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);
- procedure method_virtual_overriden_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;stdcall;
-
- { normal methods which call other methods }
- procedure method_normal_call_static_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
- procedure method_normal_call_virtual_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
- procedure method_normal_call_overriden_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
- procedure method_normal_call_normal_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
- procedure method_normal_call_constructor_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
- procedure method_normal_call_inherited_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
-
- { virtual methods which call other methods }
- procedure method_virtual_call_inherited_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;stdcall;
-
- end;
-
- pfailvmtobject = ^tfailvmtobject;
- tfailvmtobject = object(tvmtobject)
- public
- constructor constructor_public_none;
- end;
-
-
-
-{**************************************************************************}
-{ NO VMT OBJECT }
-{**************************************************************************}
-
- {****************** NO PARAMETERS ******************}
- procedure tnovmtobject.method_public_none;stdcall;
- begin
- global_u8bit := RESULT_U8BIT;
- end;
-
-
- procedure tnovmtobject.method_public_static_none;stdcall;
- begin
- global_u8bit := RESULT_U8BIT;
- end;
-
-
- procedure tnovmtobject.method_call_private_none;stdcall;
- begin
- method_private_none;
- method_private_static_none;
- end;
-
- procedure tnovmtobject.method_call_private_static_none;stdcall;
- begin
- method_private_static_none;
- end;
-
-
- procedure tnovmtobject.method_private_none;stdcall;
- begin
- Inc(global_u16bit, RESULT_U8BIT);
- end;
-
-
- procedure tnovmtobject.method_private_static_none;stdcall;
- begin
- Inc(global_u16bit, RESULT_U8BIT);
- end;
-
- {******************** PARAMETERS ******************}
-
- procedure tnovmtobject.method_public_u8(x : byte);stdcall;
- begin
- global_u8bit := x;
- end;
-
- procedure tnovmtobject.method_public_static_u8(x: byte);stdcall;
- begin
- global_u8bit := x;
- end;
-
- procedure tnovmtobject.method_call_private_u8(x: byte);stdcall;
- begin
- method_private_static_u8(x);
- method_private_u8(x);
- end;
-
- procedure tnovmtobject. method_call_private_static_u8(x: byte);stdcall;
- begin
- method_private_static_u8(x);
- end;
-
- procedure tnovmtobject.method_private_u8(x: byte);stdcall;
- begin
- Inc(global_u16bit,x);
- end;
-
- procedure tnovmtobject.method_private_static_u8(x: byte);stdcall;
- begin
- Inc(global_u16bit,x);
- end;
-
-
- function tnovmtobject.func_getu16bit : word;stdcall;
- begin
- func_getu16bit := object_u16bit;
- end;
-
- {
- complex testing, nested field access, with parameters and
- comple return value.
-
- On exit : global_u8bit := x;
- global_u16bit := object_u16bit (from func_getu16bit);
- global_s32bit := RESULT_S32BIT
- global_bigstring := object_bigstring
- global_s64bit := x;
- }
- function tnovmtobject.func_array_mixed_nested(b: byte): tsmallarray;stdcall;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := func_getu16bit;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- smallarray: tsmallarray;
- begin
- fillchar(smallarray, sizeof(smallarray), #0);
- smallarray[1] := RESULT_U8BIT;
- smallarray[SMALL_INDEX] := RESULT_U8BIT;
- func_array_mixed_nested := smallarray;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, object_bigstring);
- end;
-
-{**************************************************************************}
-{ FAILED OBJECT }
-{**************************************************************************}
-constructor tfailvmtobject.constructor_public_none;
- begin
- { this calls the constructor fail special keyword }
- fail;
- end;
-
-{**************************************************************************}
-{ VMT OBJECT }
-{**************************************************************************}
-constructor tvmtobject.constructor_params_mixed(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);
- begin
- object_u8bit := u8;
- object_u16bit := u16;
- object_bigstring := bigstring;
- object_s32bit := s32;
- object_s64bit := s64;
- end;
-
-
-constructor tvmtobject.constructor_init;
- begin
- object_u8bit := 0;
- object_u16bit := 0;
- object_bigstring := '';
- object_s32bit := 0;
- object_s64bit := 0;
- end;
-
-destructor tvmtobject.destructor_params_done;
- begin
- object_u8bit := 0;
- object_u16bit := 0;
- object_bigstring := '';
- object_s32bit := 0;
- object_s64bit := 0;
- end;
-
-
-procedure tvmtobject.method_normal_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
- begin
- object_u8bit := u8;
- object_u16bit := u16;
- object_bigstring := bigstring;
- object_s32bit := s32;
- object_s64bit := s64;
- end;
-
-procedure tvmtobject.method_virtual_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
- begin
- object_u8bit := u8;
- object_u16bit := u16;
- object_bigstring := bigstring;
- object_s32bit := s32;
- object_s64bit := s64;
- end;
-
-{ this one should be overriden }
-procedure tvmtobject.method_virtual_overriden_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
- begin
- RunError(211);
- end;
-
-{ can't access field of instances in static methods }
-procedure tvmtobject.method_static_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
- begin
- global_u8bit := u8;
- global_u16bit := u16;
- global_bigstring := bigstring;
- global_s32bit := s32;
- global_s64bit := s64;
- end;
-
-procedure tvmtobject.method_normal_call_inherited_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
- begin
- object_u8bit := u8;
- object_u16bit := u16;
- object_bigstring := bigstring;
- object_s32bit := s32;
- object_s64bit := s64;
- end;
-
-
-procedure tvmtobject.method_virtual_call_static_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
- begin
- method_static_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-procedure tvmtobject.method_virtual_call_virtual_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
- begin
- method_virtual_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-procedure tvmtobject.method_virtual_call_overriden_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
- begin
- method_virtual_overriden_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-
-procedure tvmtobject.method_virtual_call_normal_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
- begin
- method_normal_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-procedure tvmtobject.method_virtual_call_constructor_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
- begin
- constructor_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-procedure tvmtobject.method_virtual_call_inherited_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
- begin
- object_u8bit := u8;
- object_u16bit := u16;
- object_bigstring := bigstring;
- object_s32bit := s32;
- object_s64bit := s64;
- end;
-
-
-{**************************************************************************}
-{ INHERITED VMT OBJECT }
-{**************************************************************************}
-constructor theritedvmtobject.constructor_params_mixed_call_virtual(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
- begin
- object_u8bit := 0;
- object_u16bit := 0;
- object_bigstring := '';
- object_s32bit := 0;
- object_s64bit := 0;
- method_virtual_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-constructor theritedvmtobject.constructor_params_mixed_call_overriden(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
- begin
- object_u8bit := 0;
- object_u16bit := 0;
- object_bigstring := '';
- object_s32bit := 0;
- object_s64bit := 0;
- method_virtual_overriden_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-constructor theritedvmtobject.constructor_params_mixed_call_static(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
- begin
- object_u8bit := 0;
- object_u16bit := 0;
- object_bigstring := '';
- object_s32bit := 0;
- object_s64bit := 0;
- method_static_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-constructor theritedvmtobject.constructor_params_mixed_call_normal(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
- begin
- object_u8bit := 0;
- object_u16bit := 0;
- object_bigstring := '';
- object_s32bit := 0;
- object_s64bit := 0;
- method_normal_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-constructor theritedvmtobject.constructor_params_mixed_call_inherited
- (u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
- begin
- object_u8bit := 0;
- object_u16bit := 0;
- object_bigstring := '';
- object_s32bit := 0;
- object_s64bit := 0;
- inherited constructor_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-{ this one should be overriden }
-procedure theritedvmtobject.method_virtual_overriden_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
- begin
- object_u8bit := u8;
- object_u16bit := u16;
- object_bigstring := bigstring;
- object_s32bit := s32;
- object_s64bit := s64;
- end;
-
-procedure theritedvmtobject.method_normal_call_static_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
- begin
- method_static_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-procedure theritedvmtobject.method_normal_call_virtual_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
- begin
- method_virtual_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-procedure theritedvmtobject.method_normal_call_overriden_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
- begin
- method_virtual_overriden_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-
-procedure theritedvmtobject.method_normal_call_normal_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
- begin
- method_normal_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-procedure theritedvmtobject.method_normal_call_constructor_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
- begin
- constructor_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-procedure theritedvmtobject.method_normal_call_inherited_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
- begin
- Inherited method_normal_call_inherited_params_mixed(u8, u16, bigstring,
- s32, s64);
- end;
-
-procedure theritedvmtobject.method_virtual_call_inherited_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
- begin
- Inherited method_virtual_call_inherited_params_mixed(u8, u16, bigstring,
- s32, s64);
- end;
-
-
-procedure testnovmtobject;
-var
- novmtobject : tnovmtobject;
- failed : boolean;
-begin
- {******************** STATIC / METHOD SIMPLE CALL **********************}
- Write('No parameter / method call testing...');
- failed := false;
-
- clear_globals;
- clear_values;
-
- tnovmtobject.method_public_static_none;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- novmtobject.method_public_static_none;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- tnovmtobject.method_call_private_static_none;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_call_private_static_none;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_public_none;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_call_private_none;
- if global_u16bit <> (RESULT_U16BIT) then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- Write('Simple parameter (LOC_CONSTANT) / method call testing...');
- failed := false;
-
- clear_globals;
- clear_values;
-
- { parameter is LOC_CONSTANT }
- novmtobject.method_public_u8(RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- tnovmtobject.method_public_static_u8(RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_public_static_u8(RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_call_private_u8(RESULT_U8BIT);
- if global_u16bit <> (RESULT_U16BIT) then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_call_private_static_u8(RESULT_U8BIT);
- if global_u16bit <> (RESULT_U8BIT) then
- failed := true;
-
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
-
- Write('Simple parameter (LOC_REFERENCE) / method call testing...');
- failed := false;
-
- clear_globals;
- clear_values;
-
- value_u8bit := RESULT_U8BIT;
- novmtobject.method_public_u8(value_u8bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- value_u8bit := RESULT_U8BIT;
- tnovmtobject.method_public_static_u8(value_u8bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- value_u8bit := RESULT_U8BIT;
- novmtobject.method_public_static_u8(value_u8bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- value_u8bit := RESULT_U8BIT;
- novmtobject.method_call_private_u8(value_u8bit);
- if global_u16bit <> (RESULT_U16BIT) then
- failed := true;
-
- clear_globals;
- clear_values;
-
- value_u8bit := RESULT_U8BIT;
- novmtobject.method_call_private_static_u8(value_u8bit);
- if global_u16bit <> (RESULT_U8BIT) then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- Write('Simple parameter (LOC_REGISTER) / method call testing...');
- failed := false;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_public_u8(getu8);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- tnovmtobject.method_public_static_u8(getu8);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_public_static_u8(getu8);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_call_private_u8(getu8);
- if global_u16bit <> (RESULT_U16BIT) then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_call_private_static_u8(getu8);
- if global_u16bit <> (RESULT_U8BIT) then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- Write('Simple parameter / complex return / nested method access testing...');
-
- clear_globals;
- clear_values;
- failed := false;
- novmtobject.object_bigstring := RESULT_BIGSTRING;
- novmtobject.object_u16bit := RESULT_U16BIT;
-
- value_smallarray := novmtobject.func_array_mixed_nested(RESULT_U8BIT);
- if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-end;
-
-
-procedure testfailedobject;
-var
- failedobject : tfailvmtobject;
- begin
- Write('Testing constructor return value...');
- if failedobject.constructor_public_none then
- fail
- else
- Writeln('Passed!');
- end;
-
-
- procedure testvmtobject;
- var
- vmtobject : tvmtobject;
- failed : boolean;
- begin
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call...');
- vmtobject.constructor_params_mixed(RESULT_U8BIT, RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.constructor_params_mixed(value_u8bit, value_u16bit, value_bigstring,
- value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- end;
-
-
- procedure testheritedvmtobject;
- var
- vmtobject : theritedvmtobject;
- failed : boolean;
- begin
- {********************** CONSTRUCTOR TESTING ************************}
- {********************** DESTRUCTOR TESTING ************************}
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) inherited constructor call...');
- vmtobject.constructor_params_mixed_call_inherited(RESULT_U8BIT, RESULT_U16BIT, RESULT_BIGSTRING,
- RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) inherited constructor call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.constructor_params_mixed_call_inherited(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
- vmtobject.constructor_params_mixed_call_virtual(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.constructor_params_mixed_call_virtual(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
- vmtobject.constructor_params_mixed_call_overriden(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.constructor_params_mixed_call_overriden(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/method call...');
- vmtobject.constructor_params_mixed_call_normal(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.constructor_params_mixed_call_normal(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/static call...');
- vmtobject.constructor_params_mixed_call_static(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/static call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.constructor_params_mixed_call_static(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- {************************* METHOD TESTING **************************}
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
- vmtobject.method_virtual_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_virtual_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
- vmtobject.method_virtual_overriden_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_virtual_overriden_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call...');
- vmtobject.method_normal_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_normal_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) static method call...');
- vmtobject.method_static_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) static method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_static_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { ********************************************************************
- This calls methods which in turn call other methods, or a constructor
- or a destructor.
- *********************************************************************
- }
- clear_globals;
- clear_values;
- failed := false;
- { Calls the ancestor virtual method }
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
- vmtobject.method_normal_call_virtual_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_normal_call_virtual_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { The virtual method has been overriden by the object in this case }
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
- vmtobject.method_normal_call_overriden_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_normal_call_overriden_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/normal call...');
- vmtobject.method_normal_call_normal_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/normal call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_normal_call_normal_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- (* constructor call inside a normal method *)
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/constructor call...');
- vmtobject.method_normal_call_constructor_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/constructor call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_normal_call_constructor_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { static method call }
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/static call...');
- vmtobject.method_normal_call_static_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/static call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_normal_call_static_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- (* calls the inherited method *)
- clear_globals;
- clear_values;
- failed := false;
- { Calls the ancestor virtual method }
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/inherited call...');
- vmtobject.method_normal_call_inherited_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/inherited call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_normal_call_inherited_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { ********************************************************************
- This calls virtual methods which in turn call other methods,
- or a constructor or a destructor.
- *********************************************************************
- }
- clear_globals;
- clear_values;
- failed := false;
- { Calls the ancestor virtual method }
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
- vmtobject.method_virtual_call_virtual_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_virtual_call_virtual_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { The virtual method has been overriden by the object in this case }
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
- vmtobject.method_virtual_call_overriden_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_virtual_call_overriden_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/normal call...');
- vmtobject.method_virtual_call_normal_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/normal call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_virtual_call_normal_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- (* constructor call inside a normal method *)
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/constructor call...');
- vmtobject.method_virtual_call_constructor_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/constructor call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_virtual_call_constructor_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { static virtual call }
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/static call...');
- vmtobject.method_virtual_call_static_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/static call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_virtual_call_static_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- (* calls the inherited method *)
- clear_globals;
- clear_values;
- failed := false;
- { Calls the ancestor virtual method }
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/inherited call...');
- vmtobject.method_virtual_call_inherited_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/inherited call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_virtual_call_inherited_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
-
- end;
-
-
- { same as testvmtherited, except uses with statement }
- procedure testwith;
- var
- vmtobject : theritedvmtobject;
- failed : boolean;
- begin
- with vmtobject do
- begin
- {********************** CONSTRUCTOR TESTING ************************}
- {********************** DESTRUCTOR TESTING ************************}
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) inherited constructor call...');
- constructor_params_mixed_call_inherited(RESULT_U8BIT, RESULT_U16BIT, RESULT_BIGSTRING,
- RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) inherited constructor call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- constructor_params_mixed_call_inherited(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
- constructor_params_mixed_call_virtual(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- constructor_params_mixed_call_virtual(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
- constructor_params_mixed_call_overriden(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- constructor_params_mixed_call_overriden(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/method call...');
- constructor_params_mixed_call_normal(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- constructor_params_mixed_call_normal(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/static call...');
- constructor_params_mixed_call_static(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/static call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- constructor_params_mixed_call_static(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- {************************* METHOD TESTING **************************}
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
- method_virtual_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_virtual_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
- method_virtual_overriden_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_virtual_overriden_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call...');
- method_normal_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_normal_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) static method call...');
- method_static_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) static method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_static_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { ********************************************************************
- This calls methods which in turn call other methods, or a constructor
- or a destructor.
- *********************************************************************
- }
- clear_globals;
- clear_values;
- failed := false;
- { Calls the ancestor virtual method }
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
- method_normal_call_virtual_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_normal_call_virtual_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { The virtual method has been overriden by the object in this case }
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
- method_normal_call_overriden_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_normal_call_overriden_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/normal call...');
- method_normal_call_normal_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/normal call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_normal_call_normal_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- (* constructor call inside a normal method *)
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/constructor call...');
- method_normal_call_constructor_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/constructor call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_normal_call_constructor_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { static method call }
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/static call...');
- method_normal_call_static_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/static call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_normal_call_static_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- (* calls the inherited method *)
- clear_globals;
- clear_values;
- failed := false;
- { Calls the ancestor virtual method }
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/inherited call...');
- method_normal_call_inherited_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/inherited call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_normal_call_inherited_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { ********************************************************************
- This calls virtual methods which in turn call other methods,
- or a constructor or a destructor.
- *********************************************************************
- }
- clear_globals;
- clear_values;
- failed := false;
- { Calls the ancestor virtual method }
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
- method_virtual_call_virtual_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_virtual_call_virtual_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { The virtual method has been overriden by the object in this case }
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
- method_virtual_call_overriden_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_virtual_call_overriden_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/normal call...');
- method_virtual_call_normal_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/normal call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_virtual_call_normal_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- (* constructor call inside a normal method *)
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/constructor call...');
- method_virtual_call_constructor_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/constructor call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_virtual_call_constructor_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { static virtual call }
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/static call...');
- method_virtual_call_static_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/static call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_virtual_call_static_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- (* calls the inherited method *)
- clear_globals;
- clear_values;
- failed := false;
- { Calls the ancestor virtual method }
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/inherited call...');
- method_virtual_call_inherited_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/inherited call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_virtual_call_inherited_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
- end; { end with }
- end;
-
-
-begin
- WriteLN('*********************** NO VMT OBJECT TESTS ********************');
- testnovmtobject;
- WriteLN('************************ VMT OBJECT FAIL **********************');
- testfailedobject;
- WriteLN('************************* VMT OBJECT TESTS *********************');
- testvmtobject;
- testheritedvmtobject;
- WriteLN('**************** VMT OBJECT TESTS USING WITH *******************');
- testwith;
-end.
-
-{
+{****************************************************************}
+{ CODE GENERATOR TEST PROGRAM }
+{ Copyright (c) 2002 Carl Eric Codere }
+{****************************************************************}
+{ NODE TESTED : secondcalln() }
+{****************************************************************}
+{ PRE-REQUISITES: secondload() }
+{ secondassign() }
+{ secondtypeconv() }
+{ secondtryexcept() }
+{****************************************************************}
+{ DEFINES: }
+{ FPC = Target is FreePascal compiler }
+{****************************************************************}
+{ REMARKS: This tests secondcalln(), genentrycode() and }
+{ genexitcode() for standard object with the stdcall }
+{ calling convention. }
+{ }
+{****************************************************************}
+program tcalobj7;
+{$STATIC ON}
+{$R+}
+
+ const
+ { should be defined depending on CPU target }
+ {$ifdef cpu68k}
+ BIG_INDEX = 8000;
+ SMALL_INDEX = 13;
+ {$else}
+ BIG_INDEX = 33000;
+ SMALL_INDEX = 13; { value should not be aligned! }
+ {$endif}
+ RESULT_U8BIT = $55;
+ RESULT_U16BIT = 2*RESULT_U8BIT;
+ RESULT_S32BIT = $500F0000;
+ RESULT_S64BIT = $500F0000;
+ RESULT_S32REAL = 1777.12;
+ RESULT_S64REAL = 3444.24;
+ RESULT_BOOL8BIT = 1;
+ RESULT_BOOL16BIT = 1;
+ RESULT_BOOL32BIT = 1;
+ RESULT_PCHAR = 'Hello world';
+ RESULT_BIGSTRING = 'Hello world';
+ RESULT_SMALLSTRING = 'H';
+ RESULT_CHAR = 'I';
+ RESULT_BOOLEAN = TRUE;
+
+ type
+
+ tprocedure = procedure;
+
+ tsmallrecord = packed record
+ b: byte;
+ w: word;
+ end;
+
+ tlargerecord = packed record
+ b: array[1..BIG_INDEX] of byte;
+ end;
+
+ tsmallarray = packed array[1..SMALL_INDEX] of byte;
+
+ tsmallsetenum =
+ (A_A,A_B,A_C,A_D);
+
+ tsmallset = set of tsmallsetenum;
+ tlargeset = set of char;
+
+ tsmallstring = string[2];
+
+
+ var
+ global_u8bit : byte;
+ global_u16bit : word;
+ global_s32bit : longint;
+ global_s32real : single;
+ global_s64real : double;
+ global_ptr : pchar;
+ global_proc : tprocedure;
+ global_bigstring : shortstring;
+ global_boolean : boolean;
+ global_char : char;
+ global_s64bit : int64;
+ value_s64bit : int64;
+ value_ansistring : ansistring;
+ value_u8bit : byte;
+ value_u16bit : word;
+ value_s32bit : longint;
+ value_s32real : single;
+ value_s64real : double;
+ value_proc : tprocedure;
+ value_ptr : pchar;
+ value_smallrec : tsmallrecord;
+ value_largerec : tlargerecord;
+ value_smallset : tsmallset;
+ value_smallstring : tsmallstring;
+ value_bigstring : shortstring;
+ value_largeset : tlargeset;
+ value_smallarray : tsmallarray;
+ value_boolean : boolean;
+ value_char : char;
+
+ procedure fail;
+ begin
+ WriteLn('Failure.');
+ halt(1);
+ end;
+
+
+ procedure clear_globals;
+ begin
+ global_u8bit := 0;
+ global_u16bit := 0;
+ global_s32bit := 0;
+ global_s32real := 0.0;
+ global_s64real := 0.0;
+ global_ptr := nil;
+ global_proc := nil;
+ global_bigstring := '';
+ global_boolean := false;
+ global_char := #0;
+ global_s64bit := 0;
+ end;
+
+
+ procedure clear_values;
+ begin
+ value_u8bit := 0;
+ value_u16bit := 0;
+ value_s32bit := 0;
+ value_s32real := 0.0;
+ value_s64real := 0.0;
+ value_proc := nil;
+ value_ptr := nil;
+ fillchar(value_smallrec, sizeof(value_smallrec), #0);
+ fillchar(value_largerec, sizeof(value_largerec), #0);
+ value_smallset := [];
+ value_smallstring := '';
+ value_bigstring := '';
+ value_largeset := [];
+ fillchar(value_smallarray, sizeof(value_smallarray), #0);
+ value_boolean := false;
+ value_char:=#0;
+ value_ansistring := '';
+ value_s64bit := 0;
+ end;
+
+
+ function getu8: byte;
+ begin
+ getu8 := RESULT_U8BIT;
+ end;
+
+
+type
+
+ { object without vmt }
+ pnovmtobject = ^tnovmtobject;
+ tnovmtobject = object
+ public
+ object_bigstring : shortstring;
+ object_u16bit : word;
+ { no parameter testing }
+ procedure method_public_none;stdcall;
+ procedure method_public_static_none; static;stdcall;
+ procedure method_call_private_none;stdcall;
+ procedure method_call_private_static_none; static;stdcall;
+ { simple value parameter testing }
+ procedure method_public_u8(x : byte);stdcall;
+ procedure method_public_static_u8(x: byte); static;stdcall;
+ procedure method_call_private_u8(x: byte);stdcall;
+ procedure method_call_private_static_u8(x: byte); static;stdcall;
+ function func_array_mixed_nested(b: byte): tsmallarray;stdcall;
+ private
+ procedure method_private_none;stdcall;
+ procedure method_private_static_none; static;stdcall;
+ function func_getu16bit : word;stdcall;
+ { simple value parameter testing }
+ procedure method_private_u8(x: byte);stdcall;
+ procedure method_private_static_u8(x: byte); static;stdcall;
+ end;
+
+
+ { object with vmt }
+ pvmtobject = ^tvmtobject;
+ tvmtobject = object
+ public
+ object_u8bit : byte;
+ object_u16bit : word;
+ object_bigstring : shortstring;
+ object_s32bit : longint;
+ object_s64bit : int64;
+ constructor constructor_params_mixed(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);
+ constructor constructor_init;
+ destructor destructor_params_done;
+ procedure method_normal_params_mixed(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);stdcall;
+ procedure method_virtual_params_mixed(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);virtual;stdcall;
+ procedure method_virtual_overriden_params_mixed(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);virtual;stdcall;
+ procedure method_static_params_mixed(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);static;stdcall;
+ procedure method_normal_call_inherited_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
+
+ { virtual methods which call other methods }
+ procedure method_virtual_call_static_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;stdcall;
+ procedure method_virtual_call_virtual_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;stdcall;
+ procedure method_virtual_call_overriden_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;stdcall;
+ procedure method_virtual_call_normal_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;stdcall;
+ procedure method_virtual_call_constructor_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;stdcall;
+ procedure method_virtual_call_inherited_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;stdcall;
+
+ end;
+
+ pheritedvmtobject = ^theritedvmtobject;
+ theritedvmtobject = object(tvmtobject)
+ constructor constructor_params_mixed_call_virtual(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);
+ constructor constructor_params_mixed_call_overriden(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);
+ constructor constructor_params_mixed_call_static(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);
+ constructor constructor_params_mixed_call_normal(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);
+ constructor constructor_params_mixed_call_inherited(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);
+ procedure method_virtual_overriden_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;stdcall;
+
+ { normal methods which call other methods }
+ procedure method_normal_call_static_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
+ procedure method_normal_call_virtual_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
+ procedure method_normal_call_overriden_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
+ procedure method_normal_call_normal_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
+ procedure method_normal_call_constructor_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
+ procedure method_normal_call_inherited_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
+
+ { virtual methods which call other methods }
+ procedure method_virtual_call_inherited_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;stdcall;
+
+ end;
+
+ pfailvmtobject = ^tfailvmtobject;
+ tfailvmtobject = object(tvmtobject)
+ public
+ constructor constructor_public_none;
+ end;
+
+
+
+{**************************************************************************}
+{ NO VMT OBJECT }
+{**************************************************************************}
+
+ {****************** NO PARAMETERS ******************}
+ procedure tnovmtobject.method_public_none;stdcall;
+ begin
+ global_u8bit := RESULT_U8BIT;
+ end;
+
+
+ procedure tnovmtobject.method_public_static_none;stdcall;
+ begin
+ global_u8bit := RESULT_U8BIT;
+ end;
+
+
+ procedure tnovmtobject.method_call_private_none;stdcall;
+ begin
+ method_private_none;
+ method_private_static_none;
+ end;
+
+ procedure tnovmtobject.method_call_private_static_none;stdcall;
+ begin
+ method_private_static_none;
+ end;
+
+
+ procedure tnovmtobject.method_private_none;stdcall;
+ begin
+ Inc(global_u16bit, RESULT_U8BIT);
+ end;
+
+
+ procedure tnovmtobject.method_private_static_none;stdcall;
+ begin
+ Inc(global_u16bit, RESULT_U8BIT);
+ end;
+
+ {******************** PARAMETERS ******************}
+
+ procedure tnovmtobject.method_public_u8(x : byte);stdcall;
+ begin
+ global_u8bit := x;
+ end;
+
+ procedure tnovmtobject.method_public_static_u8(x: byte);stdcall;
+ begin
+ global_u8bit := x;
+ end;
+
+ procedure tnovmtobject.method_call_private_u8(x: byte);stdcall;
+ begin
+ method_private_static_u8(x);
+ method_private_u8(x);
+ end;
+
+ procedure tnovmtobject. method_call_private_static_u8(x: byte);stdcall;
+ begin
+ method_private_static_u8(x);
+ end;
+
+ procedure tnovmtobject.method_private_u8(x: byte);stdcall;
+ begin
+ Inc(global_u16bit,x);
+ end;
+
+ procedure tnovmtobject.method_private_static_u8(x: byte);stdcall;
+ begin
+ Inc(global_u16bit,x);
+ end;
+
+
+ function tnovmtobject.func_getu16bit : word;stdcall;
+ begin
+ func_getu16bit := object_u16bit;
+ end;
+
+ {
+ complex testing, nested field access, with parameters and
+ comple return value.
+
+ On exit : global_u8bit := x;
+ global_u16bit := object_u16bit (from func_getu16bit);
+ global_s32bit := RESULT_S32BIT
+ global_bigstring := object_bigstring
+ global_s64bit := x;
+ }
+ function tnovmtobject.func_array_mixed_nested(b: byte): tsmallarray;stdcall;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := func_getu16bit;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ smallarray: tsmallarray;
+ begin
+ fillchar(smallarray, sizeof(smallarray), #0);
+ smallarray[1] := RESULT_U8BIT;
+ smallarray[SMALL_INDEX] := RESULT_U8BIT;
+ func_array_mixed_nested := smallarray;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, object_bigstring);
+ end;
+
+{**************************************************************************}
+{ FAILED OBJECT }
+{**************************************************************************}
+constructor tfailvmtobject.constructor_public_none;
+ begin
+ { this calls the constructor fail special keyword }
+ fail;
+ end;
+
+{**************************************************************************}
+{ VMT OBJECT }
+{**************************************************************************}
+constructor tvmtobject.constructor_params_mixed(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);
+ begin
+ object_u8bit := u8;
+ object_u16bit := u16;
+ object_bigstring := bigstring;
+ object_s32bit := s32;
+ object_s64bit := s64;
+ end;
+
+
+constructor tvmtobject.constructor_init;
+ begin
+ object_u8bit := 0;
+ object_u16bit := 0;
+ object_bigstring := '';
+ object_s32bit := 0;
+ object_s64bit := 0;
+ end;
+
+destructor tvmtobject.destructor_params_done;
+ begin
+ object_u8bit := 0;
+ object_u16bit := 0;
+ object_bigstring := '';
+ object_s32bit := 0;
+ object_s64bit := 0;
+ end;
+
+
+procedure tvmtobject.method_normal_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
+ begin
+ object_u8bit := u8;
+ object_u16bit := u16;
+ object_bigstring := bigstring;
+ object_s32bit := s32;
+ object_s64bit := s64;
+ end;
+
+procedure tvmtobject.method_virtual_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
+ begin
+ object_u8bit := u8;
+ object_u16bit := u16;
+ object_bigstring := bigstring;
+ object_s32bit := s32;
+ object_s64bit := s64;
+ end;
+
+{ this one should be overriden }
+procedure tvmtobject.method_virtual_overriden_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
+ begin
+ RunError(211);
+ end;
+
+{ can't access field of instances in static methods }
+procedure tvmtobject.method_static_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
+ begin
+ global_u8bit := u8;
+ global_u16bit := u16;
+ global_bigstring := bigstring;
+ global_s32bit := s32;
+ global_s64bit := s64;
+ end;
+
+procedure tvmtobject.method_normal_call_inherited_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
+ begin
+ object_u8bit := u8;
+ object_u16bit := u16;
+ object_bigstring := bigstring;
+ object_s32bit := s32;
+ object_s64bit := s64;
+ end;
+
+
+procedure tvmtobject.method_virtual_call_static_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
+ begin
+ method_static_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+procedure tvmtobject.method_virtual_call_virtual_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
+ begin
+ method_virtual_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+procedure tvmtobject.method_virtual_call_overriden_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
+ begin
+ method_virtual_overriden_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+
+procedure tvmtobject.method_virtual_call_normal_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
+ begin
+ method_normal_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+procedure tvmtobject.method_virtual_call_constructor_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
+ begin
+ constructor_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+procedure tvmtobject.method_virtual_call_inherited_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
+ begin
+ object_u8bit := u8;
+ object_u16bit := u16;
+ object_bigstring := bigstring;
+ object_s32bit := s32;
+ object_s64bit := s64;
+ end;
+
+
+{**************************************************************************}
+{ INHERITED VMT OBJECT }
+{**************************************************************************}
+constructor theritedvmtobject.constructor_params_mixed_call_virtual(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
+ begin
+ object_u8bit := 0;
+ object_u16bit := 0;
+ object_bigstring := '';
+ object_s32bit := 0;
+ object_s64bit := 0;
+ method_virtual_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+constructor theritedvmtobject.constructor_params_mixed_call_overriden(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
+ begin
+ object_u8bit := 0;
+ object_u16bit := 0;
+ object_bigstring := '';
+ object_s32bit := 0;
+ object_s64bit := 0;
+ method_virtual_overriden_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+constructor theritedvmtobject.constructor_params_mixed_call_static(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
+ begin
+ object_u8bit := 0;
+ object_u16bit := 0;
+ object_bigstring := '';
+ object_s32bit := 0;
+ object_s64bit := 0;
+ method_static_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+constructor theritedvmtobject.constructor_params_mixed_call_normal(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
+ begin
+ object_u8bit := 0;
+ object_u16bit := 0;
+ object_bigstring := '';
+ object_s32bit := 0;
+ object_s64bit := 0;
+ method_normal_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+constructor theritedvmtobject.constructor_params_mixed_call_inherited
+ (u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
+ begin
+ object_u8bit := 0;
+ object_u16bit := 0;
+ object_bigstring := '';
+ object_s32bit := 0;
+ object_s64bit := 0;
+ inherited constructor_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+{ this one should be overriden }
+procedure theritedvmtobject.method_virtual_overriden_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
+ begin
+ object_u8bit := u8;
+ object_u16bit := u16;
+ object_bigstring := bigstring;
+ object_s32bit := s32;
+ object_s64bit := s64;
+ end;
+
+procedure theritedvmtobject.method_normal_call_static_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
+ begin
+ method_static_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+procedure theritedvmtobject.method_normal_call_virtual_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
+ begin
+ method_virtual_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+procedure theritedvmtobject.method_normal_call_overriden_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
+ begin
+ method_virtual_overriden_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+
+procedure theritedvmtobject.method_normal_call_normal_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
+ begin
+ method_normal_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+procedure theritedvmtobject.method_normal_call_constructor_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
+ begin
+ constructor_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+procedure theritedvmtobject.method_normal_call_inherited_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
+ begin
+ Inherited method_normal_call_inherited_params_mixed(u8, u16, bigstring,
+ s32, s64);
+ end;
+
+procedure theritedvmtobject.method_virtual_call_inherited_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);stdcall;
+ begin
+ Inherited method_virtual_call_inherited_params_mixed(u8, u16, bigstring,
+ s32, s64);
+ end;
+
+
+procedure testnovmtobject;
+var
+ novmtobject : tnovmtobject;
+ failed : boolean;
+begin
+ {******************** STATIC / METHOD SIMPLE CALL **********************}
+ Write('No parameter / method call testing...');
+ failed := false;
+
+ clear_globals;
+ clear_values;
+
+ tnovmtobject.method_public_static_none;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ novmtobject.method_public_static_none;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ tnovmtobject.method_call_private_static_none;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_call_private_static_none;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_public_none;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_call_private_none;
+ if global_u16bit <> (RESULT_U16BIT) then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ Write('Simple parameter (LOC_CONSTANT) / method call testing...');
+ failed := false;
+
+ clear_globals;
+ clear_values;
+
+ { parameter is LOC_CONSTANT }
+ novmtobject.method_public_u8(RESULT_U8BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ tnovmtobject.method_public_static_u8(RESULT_U8BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_public_static_u8(RESULT_U8BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_call_private_u8(RESULT_U8BIT);
+ if global_u16bit <> (RESULT_U16BIT) then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_call_private_static_u8(RESULT_U8BIT);
+ if global_u16bit <> (RESULT_U8BIT) then
+ failed := true;
+
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+
+ Write('Simple parameter (LOC_REFERENCE) / method call testing...');
+ failed := false;
+
+ clear_globals;
+ clear_values;
+
+ value_u8bit := RESULT_U8BIT;
+ novmtobject.method_public_u8(value_u8bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ value_u8bit := RESULT_U8BIT;
+ tnovmtobject.method_public_static_u8(value_u8bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ value_u8bit := RESULT_U8BIT;
+ novmtobject.method_public_static_u8(value_u8bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ value_u8bit := RESULT_U8BIT;
+ novmtobject.method_call_private_u8(value_u8bit);
+ if global_u16bit <> (RESULT_U16BIT) then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ value_u8bit := RESULT_U8BIT;
+ novmtobject.method_call_private_static_u8(value_u8bit);
+ if global_u16bit <> (RESULT_U8BIT) then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ Write('Simple parameter (LOC_REGISTER) / method call testing...');
+ failed := false;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_public_u8(getu8);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ tnovmtobject.method_public_static_u8(getu8);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_public_static_u8(getu8);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_call_private_u8(getu8);
+ if global_u16bit <> (RESULT_U16BIT) then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_call_private_static_u8(getu8);
+ if global_u16bit <> (RESULT_U8BIT) then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ Write('Simple parameter / complex return / nested method access testing...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+ novmtobject.object_bigstring := RESULT_BIGSTRING;
+ novmtobject.object_u16bit := RESULT_U16BIT;
+
+ value_smallarray := novmtobject.func_array_mixed_nested(RESULT_U8BIT);
+ if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+end;
+
+
+procedure testfailedobject;
+var
+ failedobject : tfailvmtobject;
+ begin
+ Write('Testing constructor return value...');
+ if failedobject.constructor_public_none then
+ fail
+ else
+ Writeln('Passed!');
+ end;
+
+
+ procedure testvmtobject;
+ var
+ vmtobject : tvmtobject;
+ failed : boolean;
+ begin
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call...');
+ vmtobject.constructor_params_mixed(RESULT_U8BIT, RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.constructor_params_mixed(value_u8bit, value_u16bit, value_bigstring,
+ value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ end;
+
+
+ procedure testheritedvmtobject;
+ var
+ vmtobject : theritedvmtobject;
+ failed : boolean;
+ begin
+ {********************** CONSTRUCTOR TESTING ************************}
+ {********************** DESTRUCTOR TESTING ************************}
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) inherited constructor call...');
+ vmtobject.constructor_params_mixed_call_inherited(RESULT_U8BIT, RESULT_U16BIT, RESULT_BIGSTRING,
+ RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) inherited constructor call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.constructor_params_mixed_call_inherited(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
+ vmtobject.constructor_params_mixed_call_virtual(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.constructor_params_mixed_call_virtual(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
+ vmtobject.constructor_params_mixed_call_overriden(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.constructor_params_mixed_call_overriden(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/method call...');
+ vmtobject.constructor_params_mixed_call_normal(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.constructor_params_mixed_call_normal(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/static call...');
+ vmtobject.constructor_params_mixed_call_static(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/static call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.constructor_params_mixed_call_static(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ {************************* METHOD TESTING **************************}
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
+ vmtobject.method_virtual_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_virtual_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
+ vmtobject.method_virtual_overriden_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_virtual_overriden_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call...');
+ vmtobject.method_normal_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_normal_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) static method call...');
+ vmtobject.method_static_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) static method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_static_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { ********************************************************************
+ This calls methods which in turn call other methods, or a constructor
+ or a destructor.
+ *********************************************************************
+ }
+ clear_globals;
+ clear_values;
+ failed := false;
+ { Calls the ancestor virtual method }
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
+ vmtobject.method_normal_call_virtual_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_normal_call_virtual_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { The virtual method has been overriden by the object in this case }
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
+ vmtobject.method_normal_call_overriden_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_normal_call_overriden_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/normal call...');
+ vmtobject.method_normal_call_normal_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/normal call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_normal_call_normal_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ (* constructor call inside a normal method *)
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/constructor call...');
+ vmtobject.method_normal_call_constructor_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/constructor call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_normal_call_constructor_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { static method call }
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/static call...');
+ vmtobject.method_normal_call_static_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/static call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_normal_call_static_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ (* calls the inherited method *)
+ clear_globals;
+ clear_values;
+ failed := false;
+ { Calls the ancestor virtual method }
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/inherited call...');
+ vmtobject.method_normal_call_inherited_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/inherited call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_normal_call_inherited_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { ********************************************************************
+ This calls virtual methods which in turn call other methods,
+ or a constructor or a destructor.
+ *********************************************************************
+ }
+ clear_globals;
+ clear_values;
+ failed := false;
+ { Calls the ancestor virtual method }
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
+ vmtobject.method_virtual_call_virtual_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_virtual_call_virtual_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { The virtual method has been overriden by the object in this case }
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
+ vmtobject.method_virtual_call_overriden_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_virtual_call_overriden_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/normal call...');
+ vmtobject.method_virtual_call_normal_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/normal call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_virtual_call_normal_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ (* constructor call inside a normal method *)
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/constructor call...');
+ vmtobject.method_virtual_call_constructor_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/constructor call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_virtual_call_constructor_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { static virtual call }
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/static call...');
+ vmtobject.method_virtual_call_static_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/static call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_virtual_call_static_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ (* calls the inherited method *)
+ clear_globals;
+ clear_values;
+ failed := false;
+ { Calls the ancestor virtual method }
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/inherited call...');
+ vmtobject.method_virtual_call_inherited_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/inherited call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_virtual_call_inherited_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+
+ end;
+
+
+ { same as testvmtherited, except uses with statement }
+ procedure testwith;
+ var
+ vmtobject : theritedvmtobject;
+ failed : boolean;
+ begin
+ with vmtobject do
+ begin
+ {********************** CONSTRUCTOR TESTING ************************}
+ {********************** DESTRUCTOR TESTING ************************}
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) inherited constructor call...');
+ constructor_params_mixed_call_inherited(RESULT_U8BIT, RESULT_U16BIT, RESULT_BIGSTRING,
+ RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) inherited constructor call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ constructor_params_mixed_call_inherited(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
+ constructor_params_mixed_call_virtual(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ constructor_params_mixed_call_virtual(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
+ constructor_params_mixed_call_overriden(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ constructor_params_mixed_call_overriden(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/method call...');
+ constructor_params_mixed_call_normal(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ constructor_params_mixed_call_normal(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/static call...');
+ constructor_params_mixed_call_static(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/static call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ constructor_params_mixed_call_static(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ {************************* METHOD TESTING **************************}
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
+ method_virtual_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_virtual_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
+ method_virtual_overriden_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_virtual_overriden_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call...');
+ method_normal_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_normal_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) static method call...');
+ method_static_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) static method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_static_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { ********************************************************************
+ This calls methods which in turn call other methods, or a constructor
+ or a destructor.
+ *********************************************************************
+ }
+ clear_globals;
+ clear_values;
+ failed := false;
+ { Calls the ancestor virtual method }
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
+ method_normal_call_virtual_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_normal_call_virtual_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { The virtual method has been overriden by the object in this case }
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
+ method_normal_call_overriden_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_normal_call_overriden_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/normal call...');
+ method_normal_call_normal_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/normal call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_normal_call_normal_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ (* constructor call inside a normal method *)
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/constructor call...');
+ method_normal_call_constructor_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/constructor call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_normal_call_constructor_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { static method call }
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/static call...');
+ method_normal_call_static_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/static call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_normal_call_static_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ (* calls the inherited method *)
+ clear_globals;
+ clear_values;
+ failed := false;
+ { Calls the ancestor virtual method }
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/inherited call...');
+ method_normal_call_inherited_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/inherited call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_normal_call_inherited_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { ********************************************************************
+ This calls virtual methods which in turn call other methods,
+ or a constructor or a destructor.
+ *********************************************************************
+ }
+ clear_globals;
+ clear_values;
+ failed := false;
+ { Calls the ancestor virtual method }
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
+ method_virtual_call_virtual_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_virtual_call_virtual_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { The virtual method has been overriden by the object in this case }
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
+ method_virtual_call_overriden_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_virtual_call_overriden_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/normal call...');
+ method_virtual_call_normal_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/normal call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_virtual_call_normal_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ (* constructor call inside a normal method *)
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/constructor call...');
+ method_virtual_call_constructor_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/constructor call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_virtual_call_constructor_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { static virtual call }
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/static call...');
+ method_virtual_call_static_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/static call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_virtual_call_static_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ (* calls the inherited method *)
+ clear_globals;
+ clear_values;
+ failed := false;
+ { Calls the ancestor virtual method }
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/inherited call...');
+ method_virtual_call_inherited_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/inherited call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_virtual_call_inherited_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+ end; { end with }
+ end;
+
+
+begin
+ WriteLN('*********************** NO VMT OBJECT TESTS ********************');
+ testnovmtobject;
+ WriteLN('************************ VMT OBJECT FAIL **********************');
+ testfailedobject;
+ WriteLN('************************* VMT OBJECT TESTS *********************');
+ testvmtobject;
+ testheritedvmtobject;
+ WriteLN('**************** VMT OBJECT TESTS USING WITH *******************');
+ testwith;
+end.
+
+{
$Log$
- Revision 1.5 2003-04-22 10:24:29 florian
+ Revision 1.6 2004-05-02 12:11:44 peter
+ * fixed linefeeds
+
+ Revision 1.5 2003/04/22 10:24:29 florian
* fixed defines for powerpc
-
- Revision 1.4 2002/12/29 15:30:55 peter
- * updated for 1.1 compiler that does not allow calling conventions
- for constructor/destructor
-
- Revision 1.3 2002/09/07 15:40:54 peter
- * old logs removed and tabs fixed
-
- Revision 1.2 2002/05/05 19:13:19 carl
- + withsymtable checking
-
- Revision 1.1 2002/05/05 13:58:50 carl
- + finished procedural variable testsuit
- + finished method testsuit
-
-}
+
+ Revision 1.4 2002/12/29 15:30:55 peter
+ * updated for 1.1 compiler that does not allow calling conventions
+ for constructor/destructor
+
+ Revision 1.3 2002/09/07 15:40:54 peter
+ * old logs removed and tabs fixed
+
+ Revision 1.2 2002/05/05 19:13:19 carl
+ + withsymtable checking
+
+ Revision 1.1 2002/05/05 13:58:50 carl
+ + finished procedural variable testsuit
+ + finished method testsuit
+
+}
diff --git a/tests/test/cg/tcalobj8.pp b/tests/test/cg/tcalobj8.pp
index e186163514..62a4959c0c 100644
--- a/tests/test/cg/tcalobj8.pp
+++ b/tests/test/cg/tcalobj8.pp
@@ -1,3314 +1,3317 @@
-{****************************************************************}
-{ CODE GENERATOR TEST PROGRAM }
-{ Copyright (c) 2002 Carl Eric Codere }
-{****************************************************************}
-{ NODE TESTED : secondcalln() }
-{****************************************************************}
-{ PRE-REQUISITES: secondload() }
-{ secondassign() }
-{ secondtypeconv() }
-{ secondtryexcept() }
-{****************************************************************}
-{ DEFINES: }
-{ FPC = Target is FreePascal compiler }
-{****************************************************************}
-{ REMARKS: This tests secondcalln(), genentrycode() and }
-{ genexitcode() for standard object with the saveregisters }
-{ calling convention. }
-{ }
-{****************************************************************}
-program tcalobj8;
-{$STATIC ON}
-{$R+}
-
- const
- { should be defined depending on CPU target }
- {$ifdef cpu68k}
- BIG_INDEX = 8000;
- SMALL_INDEX = 13;
- {$else}
- BIG_INDEX = 33000;
- SMALL_INDEX = 13; { value should not be aligned! }
- {$endif}
- RESULT_U8BIT = $55;
- RESULT_U16BIT = 2*RESULT_U8BIT;
- RESULT_S32BIT = $500F0000;
- RESULT_S64BIT = $500F0000;
- RESULT_S32REAL = 1777.12;
- RESULT_S64REAL = 3444.24;
- RESULT_BOOL8BIT = 1;
- RESULT_BOOL16BIT = 1;
- RESULT_BOOL32BIT = 1;
- RESULT_PCHAR = 'Hello world';
- RESULT_BIGSTRING = 'Hello world';
- RESULT_SMALLSTRING = 'H';
- RESULT_CHAR = 'I';
- RESULT_BOOLEAN = TRUE;
-
- type
-
- tprocedure = procedure;
-
- tsmallrecord = packed record
- b: byte;
- w: word;
- end;
-
- tlargerecord = packed record
- b: array[1..BIG_INDEX] of byte;
- end;
-
- tsmallarray = packed array[1..SMALL_INDEX] of byte;
-
- tsmallsetenum =
- (A_A,A_B,A_C,A_D);
-
- tsmallset = set of tsmallsetenum;
- tlargeset = set of char;
-
- tsmallstring = string[2];
-
-
- var
- global_u8bit : byte;
- global_u16bit : word;
- global_s32bit : longint;
- global_s32real : single;
- global_s64real : double;
- global_ptr : pchar;
- global_proc : tprocedure;
- global_bigstring : shortstring;
- global_boolean : boolean;
- global_char : char;
- global_s64bit : int64;
- value_s64bit : int64;
- value_ansistring : ansistring;
- value_u8bit : byte;
- value_u16bit : word;
- value_s32bit : longint;
- value_s32real : single;
- value_s64real : double;
- value_proc : tprocedure;
- value_ptr : pchar;
- value_smallrec : tsmallrecord;
- value_largerec : tlargerecord;
- value_smallset : tsmallset;
- value_smallstring : tsmallstring;
- value_bigstring : shortstring;
- value_largeset : tlargeset;
- value_smallarray : tsmallarray;
- value_boolean : boolean;
- value_char : char;
-
- procedure fail;
- begin
- WriteLn('Failure.');
- halt(1);
- end;
-
-
- procedure clear_globals;
- begin
- global_u8bit := 0;
- global_u16bit := 0;
- global_s32bit := 0;
- global_s32real := 0.0;
- global_s64real := 0.0;
- global_ptr := nil;
- global_proc := nil;
- global_bigstring := '';
- global_boolean := false;
- global_char := #0;
- global_s64bit := 0;
- end;
-
-
- procedure clear_values;
- begin
- value_u8bit := 0;
- value_u16bit := 0;
- value_s32bit := 0;
- value_s32real := 0.0;
- value_s64real := 0.0;
- value_proc := nil;
- value_ptr := nil;
- fillchar(value_smallrec, sizeof(value_smallrec), #0);
- fillchar(value_largerec, sizeof(value_largerec), #0);
- value_smallset := [];
- value_smallstring := '';
- value_bigstring := '';
- value_largeset := [];
- fillchar(value_smallarray, sizeof(value_smallarray), #0);
- value_boolean := false;
- value_char:=#0;
- value_ansistring := '';
- value_s64bit := 0;
- end;
-
-
- function getu8: byte;
- begin
- getu8 := RESULT_U8BIT;
- end;
-
-
-type
-
- { object without vmt }
- pnovmtobject = ^tnovmtobject;
- tnovmtobject = object
- public
- object_bigstring : shortstring;
- object_u16bit : word;
- { no parameter testing }
- procedure method_public_none;saveregisters;
- procedure method_public_static_none; static;saveregisters;
- procedure method_call_private_none;saveregisters;
- procedure method_call_private_static_none; static;saveregisters;
- { simple value parameter testing }
- procedure method_public_u8(x : byte);saveregisters;
- procedure method_public_static_u8(x: byte); static;saveregisters;
- procedure method_call_private_u8(x: byte);saveregisters;
- procedure method_call_private_static_u8(x: byte); static;saveregisters;
- function func_array_mixed_nested(b: byte): tsmallarray;saveregisters;
- private
- procedure method_private_none;saveregisters;
- procedure method_private_static_none; static;saveregisters;
- function func_getu16bit : word;saveregisters;
- { simple value parameter testing }
- procedure method_private_u8(x: byte);saveregisters;
- procedure method_private_static_u8(x: byte); static;saveregisters;
- end;
-
-
- { object with vmt }
- pvmtobject = ^tvmtobject;
- tvmtobject = object
- public
- object_u8bit : byte;
- object_u16bit : word;
- object_bigstring : shortstring;
- object_s32bit : longint;
- object_s64bit : int64;
- constructor constructor_params_mixed(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);
- constructor constructor_init;
- destructor destructor_params_done;
- procedure method_normal_params_mixed(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);saveregisters;
- procedure method_virtual_params_mixed(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);virtual;saveregisters;
- procedure method_virtual_overriden_params_mixed(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);virtual;saveregisters;
- procedure method_static_params_mixed(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);static;saveregisters;
- procedure method_normal_call_inherited_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
-
- { virtual methods which call other methods }
- procedure method_virtual_call_static_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;saveregisters;
- procedure method_virtual_call_virtual_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;saveregisters;
- procedure method_virtual_call_overriden_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;saveregisters;
- procedure method_virtual_call_normal_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;saveregisters;
- procedure method_virtual_call_constructor_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;saveregisters;
- procedure method_virtual_call_inherited_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;saveregisters;
-
- end;
-
- pheritedvmtobject = ^theritedvmtobject;
- theritedvmtobject = object(tvmtobject)
- constructor constructor_params_mixed_call_virtual(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);
- constructor constructor_params_mixed_call_overriden(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);
- constructor constructor_params_mixed_call_static(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);
- constructor constructor_params_mixed_call_normal(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);
- constructor constructor_params_mixed_call_inherited(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);
- procedure method_virtual_overriden_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;saveregisters;
-
- { normal methods which call other methods }
- procedure method_normal_call_static_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
- procedure method_normal_call_virtual_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
- procedure method_normal_call_overriden_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
- procedure method_normal_call_normal_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
- procedure method_normal_call_constructor_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
- procedure method_normal_call_inherited_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
-
- { virtual methods which call other methods }
- procedure method_virtual_call_inherited_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;saveregisters;
-
- end;
-
- pfailvmtobject = ^tfailvmtobject;
- tfailvmtobject = object(tvmtobject)
- public
- constructor constructor_public_none;
- end;
-
-
-
-{**************************************************************************}
-{ NO VMT OBJECT }
-{**************************************************************************}
-
- {****************** NO PARAMETERS ******************}
- procedure tnovmtobject.method_public_none;saveregisters;
- begin
- global_u8bit := RESULT_U8BIT;
- end;
-
-
- procedure tnovmtobject.method_public_static_none;saveregisters;
- begin
- global_u8bit := RESULT_U8BIT;
- end;
-
-
- procedure tnovmtobject.method_call_private_none;saveregisters;
- begin
- method_private_none;
- method_private_static_none;
- end;
-
- procedure tnovmtobject.method_call_private_static_none;saveregisters;
- begin
- method_private_static_none;
- end;
-
-
- procedure tnovmtobject.method_private_none;saveregisters;
- begin
- Inc(global_u16bit, RESULT_U8BIT);
- end;
-
-
- procedure tnovmtobject.method_private_static_none;saveregisters;
- begin
- Inc(global_u16bit, RESULT_U8BIT);
- end;
-
- {******************** PARAMETERS ******************}
-
- procedure tnovmtobject.method_public_u8(x : byte);saveregisters;
- begin
- global_u8bit := x;
- end;
-
- procedure tnovmtobject.method_public_static_u8(x: byte);saveregisters;
- begin
- global_u8bit := x;
- end;
-
- procedure tnovmtobject.method_call_private_u8(x: byte);saveregisters;
- begin
- method_private_static_u8(x);
- method_private_u8(x);
- end;
-
- procedure tnovmtobject. method_call_private_static_u8(x: byte);saveregisters;
- begin
- method_private_static_u8(x);
- end;
-
- procedure tnovmtobject.method_private_u8(x: byte);saveregisters;
- begin
- Inc(global_u16bit,x);
- end;
-
- procedure tnovmtobject.method_private_static_u8(x: byte);saveregisters;
- begin
- Inc(global_u16bit,x);
- end;
-
-
- function tnovmtobject.func_getu16bit : word;saveregisters;
- begin
- func_getu16bit := object_u16bit;
- end;
-
- {
- complex testing, nested field access, with parameters and
- comple return value.
-
- On exit : global_u8bit := x;
- global_u16bit := object_u16bit (from func_getu16bit);
- global_s32bit := RESULT_S32BIT
- global_bigstring := object_bigstring
- global_s64bit := x;
- }
- function tnovmtobject.func_array_mixed_nested(b: byte): tsmallarray;saveregisters;
-
- procedure nested_one_proc(l: longint);
- begin
- global_u16bit := func_getu16bit;
- global_s32bit := l;
- end;
-
- procedure nested_two_proc(l : longint);
- begin
- global_s64bit := l;
- end;
-
-
-
- function nested_one_func(level1_b : byte; s: shortstring): byte;
- var
- s1 : shortstring;
-
- function nested_two_func(level2_b : byte; s :shortstring): byte;
- begin
- nested_two_func:=level2_b;
- global_bigstring := s;
- nested_one_proc(RESULT_S32BIT);
- end;
-
- begin
- s1:=s;
- nested_one_func := nested_two_func(level1_b,s1);
- nested_two_proc(level1_b);
- end;
-
-
- var
- local_b: byte;
- smallarray: tsmallarray;
- begin
- fillchar(smallarray, sizeof(smallarray), #0);
- smallarray[1] := RESULT_U8BIT;
- smallarray[SMALL_INDEX] := RESULT_U8BIT;
- func_array_mixed_nested := smallarray;
- local_b:=b;
- global_u8bit := nested_one_func(local_b, object_bigstring);
- end;
-
-{**************************************************************************}
-{ FAILED OBJECT }
-{**************************************************************************}
-constructor tfailvmtobject.constructor_public_none;
- begin
- { this calls the constructor fail special keyword }
- fail;
- end;
-
-{**************************************************************************}
-{ VMT OBJECT }
-{**************************************************************************}
-constructor tvmtobject.constructor_params_mixed(u8 :byte; u16: word;
- bigstring: shortstring; s32: longint; s64: int64);
- begin
- object_u8bit := u8;
- object_u16bit := u16;
- object_bigstring := bigstring;
- object_s32bit := s32;
- object_s64bit := s64;
- end;
-
-
-constructor tvmtobject.constructor_init;
- begin
- object_u8bit := 0;
- object_u16bit := 0;
- object_bigstring := '';
- object_s32bit := 0;
- object_s64bit := 0;
- end;
-
-destructor tvmtobject.destructor_params_done;
- begin
- object_u8bit := 0;
- object_u16bit := 0;
- object_bigstring := '';
- object_s32bit := 0;
- object_s64bit := 0;
- end;
-
-
-procedure tvmtobject.method_normal_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
- begin
- object_u8bit := u8;
- object_u16bit := u16;
- object_bigstring := bigstring;
- object_s32bit := s32;
- object_s64bit := s64;
- end;
-
-procedure tvmtobject.method_virtual_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
- begin
- object_u8bit := u8;
- object_u16bit := u16;
- object_bigstring := bigstring;
- object_s32bit := s32;
- object_s64bit := s64;
- end;
-
-{ this one should be overriden }
-procedure tvmtobject.method_virtual_overriden_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
- begin
- RunError(211);
- end;
-
-{ can't access field of instances in static methods }
-procedure tvmtobject.method_static_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
- begin
- global_u8bit := u8;
- global_u16bit := u16;
- global_bigstring := bigstring;
- global_s32bit := s32;
- global_s64bit := s64;
- end;
-
-procedure tvmtobject.method_normal_call_inherited_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
- begin
- object_u8bit := u8;
- object_u16bit := u16;
- object_bigstring := bigstring;
- object_s32bit := s32;
- object_s64bit := s64;
- end;
-
-
-procedure tvmtobject.method_virtual_call_static_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
- begin
- method_static_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-procedure tvmtobject.method_virtual_call_virtual_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
- begin
- method_virtual_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-procedure tvmtobject.method_virtual_call_overriden_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
- begin
- method_virtual_overriden_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-
-procedure tvmtobject.method_virtual_call_normal_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
- begin
- method_normal_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-procedure tvmtobject.method_virtual_call_constructor_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
- begin
- constructor_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-procedure tvmtobject.method_virtual_call_inherited_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
- begin
- object_u8bit := u8;
- object_u16bit := u16;
- object_bigstring := bigstring;
- object_s32bit := s32;
- object_s64bit := s64;
- end;
-
-
-{**************************************************************************}
-{ INHERITED VMT OBJECT }
-{**************************************************************************}
-constructor theritedvmtobject.constructor_params_mixed_call_virtual(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
- begin
- object_u8bit := 0;
- object_u16bit := 0;
- object_bigstring := '';
- object_s32bit := 0;
- object_s64bit := 0;
- method_virtual_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-constructor theritedvmtobject.constructor_params_mixed_call_overriden(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
- begin
- object_u8bit := 0;
- object_u16bit := 0;
- object_bigstring := '';
- object_s32bit := 0;
- object_s64bit := 0;
- method_virtual_overriden_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-constructor theritedvmtobject.constructor_params_mixed_call_static(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
- begin
- object_u8bit := 0;
- object_u16bit := 0;
- object_bigstring := '';
- object_s32bit := 0;
- object_s64bit := 0;
- method_static_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-constructor theritedvmtobject.constructor_params_mixed_call_normal(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
- begin
- object_u8bit := 0;
- object_u16bit := 0;
- object_bigstring := '';
- object_s32bit := 0;
- object_s64bit := 0;
- method_normal_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-constructor theritedvmtobject.constructor_params_mixed_call_inherited
- (u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
- begin
- object_u8bit := 0;
- object_u16bit := 0;
- object_bigstring := '';
- object_s32bit := 0;
- object_s64bit := 0;
- inherited constructor_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-{ this one should be overriden }
-procedure theritedvmtobject.method_virtual_overriden_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
- begin
- object_u8bit := u8;
- object_u16bit := u16;
- object_bigstring := bigstring;
- object_s32bit := s32;
- object_s64bit := s64;
- end;
-
-procedure theritedvmtobject.method_normal_call_static_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
- begin
- method_static_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-procedure theritedvmtobject.method_normal_call_virtual_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
- begin
- method_virtual_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-procedure theritedvmtobject.method_normal_call_overriden_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
- begin
- method_virtual_overriden_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-
-procedure theritedvmtobject.method_normal_call_normal_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
- begin
- method_normal_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-procedure theritedvmtobject.method_normal_call_constructor_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
- begin
- constructor_params_mixed(u8, u16, bigstring, s32, s64);
- end;
-
-procedure theritedvmtobject.method_normal_call_inherited_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
- begin
- Inherited method_normal_call_inherited_params_mixed(u8, u16, bigstring,
- s32, s64);
- end;
-
-procedure theritedvmtobject.method_virtual_call_inherited_params_mixed(
- u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
- begin
- Inherited method_virtual_call_inherited_params_mixed(u8, u16, bigstring,
- s32, s64);
- end;
-
-
-procedure testnovmtobject;
-var
- novmtobject : tnovmtobject;
- failed : boolean;
-begin
- {******************** STATIC / METHOD SIMPLE CALL **********************}
- Write('No parameter / method call testing...');
- failed := false;
-
- clear_globals;
- clear_values;
-
- tnovmtobject.method_public_static_none;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
- novmtobject.method_public_static_none;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- tnovmtobject.method_call_private_static_none;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_call_private_static_none;
- if global_u16bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_public_none;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_call_private_none;
- if global_u16bit <> (RESULT_U16BIT) then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- Write('Simple parameter (LOC_CONSTANT) / method call testing...');
- failed := false;
-
- clear_globals;
- clear_values;
-
- { parameter is LOC_CONSTANT }
- novmtobject.method_public_u8(RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- tnovmtobject.method_public_static_u8(RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_public_static_u8(RESULT_U8BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_call_private_u8(RESULT_U8BIT);
- if global_u16bit <> (RESULT_U16BIT) then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_call_private_static_u8(RESULT_U8BIT);
- if global_u16bit <> (RESULT_U8BIT) then
- failed := true;
-
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
-
- Write('Simple parameter (LOC_REFERENCE) / method call testing...');
- failed := false;
-
- clear_globals;
- clear_values;
-
- value_u8bit := RESULT_U8BIT;
- novmtobject.method_public_u8(value_u8bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- value_u8bit := RESULT_U8BIT;
- tnovmtobject.method_public_static_u8(value_u8bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- value_u8bit := RESULT_U8BIT;
- novmtobject.method_public_static_u8(value_u8bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- value_u8bit := RESULT_U8BIT;
- novmtobject.method_call_private_u8(value_u8bit);
- if global_u16bit <> (RESULT_U16BIT) then
- failed := true;
-
- clear_globals;
- clear_values;
-
- value_u8bit := RESULT_U8BIT;
- novmtobject.method_call_private_static_u8(value_u8bit);
- if global_u16bit <> (RESULT_U8BIT) then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- Write('Simple parameter (LOC_REGISTER) / method call testing...');
- failed := false;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_public_u8(getu8);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- tnovmtobject.method_public_static_u8(getu8);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_public_static_u8(getu8);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_call_private_u8(getu8);
- if global_u16bit <> (RESULT_U16BIT) then
- failed := true;
-
- clear_globals;
- clear_values;
-
- novmtobject.method_call_private_static_u8(getu8);
- if global_u16bit <> (RESULT_U8BIT) then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-
- Write('Simple parameter / complex return / nested method access testing...');
-
- clear_globals;
- clear_values;
- failed := false;
- novmtobject.object_bigstring := RESULT_BIGSTRING;
- novmtobject.object_u16bit := RESULT_U16BIT;
-
- value_smallarray := novmtobject.func_array_mixed_nested(RESULT_U8BIT);
- if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
- failed := true;
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_U8BIT then
- failed := true;
-
- if failed then
- fail
- else
- WriteLn('Passed!');
-end;
-
-
-procedure testfailedobject;
-var
- failedobject : tfailvmtobject;
- begin
- Write('Testing constructor return value...');
- if failedobject.constructor_public_none then
- fail
- else
- Writeln('Passed!');
- end;
-
-
- procedure testvmtobject;
- var
- vmtobject : tvmtobject;
- failed : boolean;
- begin
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call...');
- vmtobject.constructor_params_mixed(RESULT_U8BIT, RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.constructor_params_mixed(value_u8bit, value_u16bit, value_bigstring,
- value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- end;
-
-
- procedure testheritedvmtobject;
- var
- vmtobject : theritedvmtobject;
- failed : boolean;
- begin
- {********************** CONSTRUCTOR TESTING ************************}
- {********************** DESTRUCTOR TESTING ************************}
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) inherited constructor call...');
- vmtobject.constructor_params_mixed_call_inherited(RESULT_U8BIT, RESULT_U16BIT, RESULT_BIGSTRING,
- RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) inherited constructor call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.constructor_params_mixed_call_inherited(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
- vmtobject.constructor_params_mixed_call_virtual(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.constructor_params_mixed_call_virtual(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
- vmtobject.constructor_params_mixed_call_overriden(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.constructor_params_mixed_call_overriden(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/method call...');
- vmtobject.constructor_params_mixed_call_normal(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.constructor_params_mixed_call_normal(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/static call...');
- vmtobject.constructor_params_mixed_call_static(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/static call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.constructor_params_mixed_call_static(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- {************************* METHOD TESTING **************************}
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
- vmtobject.method_virtual_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_virtual_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
- vmtobject.method_virtual_overriden_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_virtual_overriden_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call...');
- vmtobject.method_normal_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_normal_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) static method call...');
- vmtobject.method_static_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) static method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_static_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { ********************************************************************
- This calls methods which in turn call other methods, or a constructor
- or a destructor.
- *********************************************************************
- }
- clear_globals;
- clear_values;
- failed := false;
- { Calls the ancestor virtual method }
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
- vmtobject.method_normal_call_virtual_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_normal_call_virtual_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { The virtual method has been overriden by the object in this case }
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
- vmtobject.method_normal_call_overriden_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_normal_call_overriden_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/normal call...');
- vmtobject.method_normal_call_normal_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/normal call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_normal_call_normal_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- (* constructor call inside a normal method *)
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/constructor call...');
- vmtobject.method_normal_call_constructor_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/constructor call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_normal_call_constructor_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { static method call }
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/static call...');
- vmtobject.method_normal_call_static_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/static call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_normal_call_static_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- (* calls the inherited method *)
- clear_globals;
- clear_values;
- failed := false;
- { Calls the ancestor virtual method }
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/inherited call...');
- vmtobject.method_normal_call_inherited_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/inherited call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_normal_call_inherited_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { ********************************************************************
- This calls virtual methods which in turn call other methods,
- or a constructor or a destructor.
- *********************************************************************
- }
- clear_globals;
- clear_values;
- failed := false;
- { Calls the ancestor virtual method }
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
- vmtobject.method_virtual_call_virtual_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_virtual_call_virtual_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { The virtual method has been overriden by the object in this case }
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
- vmtobject.method_virtual_call_overriden_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_virtual_call_overriden_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/normal call...');
- vmtobject.method_virtual_call_normal_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/normal call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_virtual_call_normal_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- (* constructor call inside a normal method *)
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/constructor call...');
- vmtobject.method_virtual_call_constructor_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/constructor call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_virtual_call_constructor_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { static virtual call }
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/static call...');
- vmtobject.method_virtual_call_static_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/static call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_virtual_call_static_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- (* calls the inherited method *)
- clear_globals;
- clear_values;
- failed := false;
- { Calls the ancestor virtual method }
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/inherited call...');
- vmtobject.method_virtual_call_inherited_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- vmtobject.constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/inherited call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- vmtobject.method_virtual_call_inherited_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if vmtobject.object_u8bit <> RESULT_U8BIT then
- failed := true;
- if vmtobject.object_u16bit <> RESULT_U16BIT then
- failed := true;
- if vmtobject.object_s32bit <> RESULT_S32BIT then
- failed := true;
- if vmtobject.object_s64bit <> RESULT_S64BIT then
- failed := true;
- if vmtobject.object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- vmtobject.destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
-
- end;
-
-
- { same as testvmtherited, except uses with statement }
- procedure testwith;
- var
- vmtobject : theritedvmtobject;
- failed : boolean;
- begin
- with vmtobject do
- begin
- {********************** CONSTRUCTOR TESTING ************************}
- {********************** DESTRUCTOR TESTING ************************}
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) inherited constructor call...');
- constructor_params_mixed_call_inherited(RESULT_U8BIT, RESULT_U16BIT, RESULT_BIGSTRING,
- RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) inherited constructor call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- constructor_params_mixed_call_inherited(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
- constructor_params_mixed_call_virtual(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- constructor_params_mixed_call_virtual(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
- constructor_params_mixed_call_overriden(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- constructor_params_mixed_call_overriden(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/method call...');
- constructor_params_mixed_call_normal(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- constructor_params_mixed_call_normal(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/static call...');
- constructor_params_mixed_call_static(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/static call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- constructor_params_mixed_call_static(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- {************************* METHOD TESTING **************************}
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
- method_virtual_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_virtual_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
- method_virtual_overriden_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_virtual_overriden_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call...');
- method_normal_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_normal_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) static method call...');
- method_static_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) static method call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_static_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { ********************************************************************
- This calls methods which in turn call other methods, or a constructor
- or a destructor.
- *********************************************************************
- }
- clear_globals;
- clear_values;
- failed := false;
- { Calls the ancestor virtual method }
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
- method_normal_call_virtual_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_normal_call_virtual_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { The virtual method has been overriden by the object in this case }
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
- method_normal_call_overriden_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_normal_call_overriden_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/normal call...');
- method_normal_call_normal_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/normal call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_normal_call_normal_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- (* constructor call inside a normal method *)
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/constructor call...');
- method_normal_call_constructor_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/constructor call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_normal_call_constructor_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { static method call }
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/static call...');
- method_normal_call_static_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/static call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_normal_call_static_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- (* calls the inherited method *)
- clear_globals;
- clear_values;
- failed := false;
- { Calls the ancestor virtual method }
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) method call w/inherited call...');
- method_normal_call_inherited_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) method call w/inherited call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_normal_call_inherited_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { ********************************************************************
- This calls virtual methods which in turn call other methods,
- or a constructor or a destructor.
- *********************************************************************
- }
- clear_globals;
- clear_values;
- failed := false;
- { Calls the ancestor virtual method }
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
- method_virtual_call_virtual_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_virtual_call_virtual_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { The virtual method has been overriden by the object in this case }
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
- method_virtual_call_overriden_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_virtual_call_overriden_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/normal call...');
- method_virtual_call_normal_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/normal call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_virtual_call_normal_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- (* constructor call inside a normal method *)
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/constructor call...');
- method_virtual_call_constructor_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/constructor call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_virtual_call_constructor_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- { static virtual call }
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/static call...');
- method_virtual_call_static_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/static call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_virtual_call_static_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if global_u8bit <> RESULT_U8BIT then
- failed := true;
- if global_u16bit <> RESULT_U16BIT then
- failed := true;
- if global_s32bit <> RESULT_S32BIT then
- failed := true;
- if global_s64bit <> RESULT_S64BIT then
- failed := true;
- if global_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- (* calls the inherited method *)
- clear_globals;
- clear_values;
- failed := false;
- { Calls the ancestor virtual method }
- constructor_init;
- Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/inherited call...');
- method_virtual_call_inherited_params_mixed(RESULT_U8BIT,
- RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
-
- clear_globals;
- clear_values;
- failed := false;
-
- constructor_init;
- Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/inherited call...');
- value_u8bit := RESULT_U8BIT;
- value_u16bit := RESULT_U16BIT;
- value_bigstring := RESULT_BIGSTRING;
- value_s32bit := RESULT_S32BIT;
- value_s64bit := RESULT_S64BIT;
- method_virtual_call_inherited_params_mixed(value_u8bit,
- value_u16bit, value_bigstring, value_s32bit, value_s64bit);
- if object_u8bit <> RESULT_U8BIT then
- failed := true;
- if object_u16bit <> RESULT_U16BIT then
- failed := true;
- if object_s32bit <> RESULT_S32BIT then
- failed := true;
- if object_s64bit <> RESULT_S64BIT then
- failed := true;
- if object_bigstring <> RESULT_BIGSTRING then
- failed := true;
- destructor_params_done;
-
- if failed then
- fail
- else
- Writeln('Passed!');
- end; { end with }
- end;
-
-
-begin
- WriteLN('*********************** NO VMT OBJECT TESTS ********************');
- testnovmtobject;
- WriteLN('************************ VMT OBJECT FAIL **********************');
- testfailedobject;
- WriteLN('************************* VMT OBJECT TESTS *********************');
- testvmtobject;
- testheritedvmtobject;
- WriteLN('**************** VMT OBJECT TESTS USING WITH *******************');
- testwith;
-end.
-
-{
+{****************************************************************}
+{ CODE GENERATOR TEST PROGRAM }
+{ Copyright (c) 2002 Carl Eric Codere }
+{****************************************************************}
+{ NODE TESTED : secondcalln() }
+{****************************************************************}
+{ PRE-REQUISITES: secondload() }
+{ secondassign() }
+{ secondtypeconv() }
+{ secondtryexcept() }
+{****************************************************************}
+{ DEFINES: }
+{ FPC = Target is FreePascal compiler }
+{****************************************************************}
+{ REMARKS: This tests secondcalln(), genentrycode() and }
+{ genexitcode() for standard object with the saveregisters }
+{ calling convention. }
+{ }
+{****************************************************************}
+program tcalobj8;
+{$STATIC ON}
+{$R+}
+
+ const
+ { should be defined depending on CPU target }
+ {$ifdef cpu68k}
+ BIG_INDEX = 8000;
+ SMALL_INDEX = 13;
+ {$else}
+ BIG_INDEX = 33000;
+ SMALL_INDEX = 13; { value should not be aligned! }
+ {$endif}
+ RESULT_U8BIT = $55;
+ RESULT_U16BIT = 2*RESULT_U8BIT;
+ RESULT_S32BIT = $500F0000;
+ RESULT_S64BIT = $500F0000;
+ RESULT_S32REAL = 1777.12;
+ RESULT_S64REAL = 3444.24;
+ RESULT_BOOL8BIT = 1;
+ RESULT_BOOL16BIT = 1;
+ RESULT_BOOL32BIT = 1;
+ RESULT_PCHAR = 'Hello world';
+ RESULT_BIGSTRING = 'Hello world';
+ RESULT_SMALLSTRING = 'H';
+ RESULT_CHAR = 'I';
+ RESULT_BOOLEAN = TRUE;
+
+ type
+
+ tprocedure = procedure;
+
+ tsmallrecord = packed record
+ b: byte;
+ w: word;
+ end;
+
+ tlargerecord = packed record
+ b: array[1..BIG_INDEX] of byte;
+ end;
+
+ tsmallarray = packed array[1..SMALL_INDEX] of byte;
+
+ tsmallsetenum =
+ (A_A,A_B,A_C,A_D);
+
+ tsmallset = set of tsmallsetenum;
+ tlargeset = set of char;
+
+ tsmallstring = string[2];
+
+
+ var
+ global_u8bit : byte;
+ global_u16bit : word;
+ global_s32bit : longint;
+ global_s32real : single;
+ global_s64real : double;
+ global_ptr : pchar;
+ global_proc : tprocedure;
+ global_bigstring : shortstring;
+ global_boolean : boolean;
+ global_char : char;
+ global_s64bit : int64;
+ value_s64bit : int64;
+ value_ansistring : ansistring;
+ value_u8bit : byte;
+ value_u16bit : word;
+ value_s32bit : longint;
+ value_s32real : single;
+ value_s64real : double;
+ value_proc : tprocedure;
+ value_ptr : pchar;
+ value_smallrec : tsmallrecord;
+ value_largerec : tlargerecord;
+ value_smallset : tsmallset;
+ value_smallstring : tsmallstring;
+ value_bigstring : shortstring;
+ value_largeset : tlargeset;
+ value_smallarray : tsmallarray;
+ value_boolean : boolean;
+ value_char : char;
+
+ procedure fail;
+ begin
+ WriteLn('Failure.');
+ halt(1);
+ end;
+
+
+ procedure clear_globals;
+ begin
+ global_u8bit := 0;
+ global_u16bit := 0;
+ global_s32bit := 0;
+ global_s32real := 0.0;
+ global_s64real := 0.0;
+ global_ptr := nil;
+ global_proc := nil;
+ global_bigstring := '';
+ global_boolean := false;
+ global_char := #0;
+ global_s64bit := 0;
+ end;
+
+
+ procedure clear_values;
+ begin
+ value_u8bit := 0;
+ value_u16bit := 0;
+ value_s32bit := 0;
+ value_s32real := 0.0;
+ value_s64real := 0.0;
+ value_proc := nil;
+ value_ptr := nil;
+ fillchar(value_smallrec, sizeof(value_smallrec), #0);
+ fillchar(value_largerec, sizeof(value_largerec), #0);
+ value_smallset := [];
+ value_smallstring := '';
+ value_bigstring := '';
+ value_largeset := [];
+ fillchar(value_smallarray, sizeof(value_smallarray), #0);
+ value_boolean := false;
+ value_char:=#0;
+ value_ansistring := '';
+ value_s64bit := 0;
+ end;
+
+
+ function getu8: byte;
+ begin
+ getu8 := RESULT_U8BIT;
+ end;
+
+
+type
+
+ { object without vmt }
+ pnovmtobject = ^tnovmtobject;
+ tnovmtobject = object
+ public
+ object_bigstring : shortstring;
+ object_u16bit : word;
+ { no parameter testing }
+ procedure method_public_none;saveregisters;
+ procedure method_public_static_none; static;saveregisters;
+ procedure method_call_private_none;saveregisters;
+ procedure method_call_private_static_none; static;saveregisters;
+ { simple value parameter testing }
+ procedure method_public_u8(x : byte);saveregisters;
+ procedure method_public_static_u8(x: byte); static;saveregisters;
+ procedure method_call_private_u8(x: byte);saveregisters;
+ procedure method_call_private_static_u8(x: byte); static;saveregisters;
+ function func_array_mixed_nested(b: byte): tsmallarray;saveregisters;
+ private
+ procedure method_private_none;saveregisters;
+ procedure method_private_static_none; static;saveregisters;
+ function func_getu16bit : word;saveregisters;
+ { simple value parameter testing }
+ procedure method_private_u8(x: byte);saveregisters;
+ procedure method_private_static_u8(x: byte); static;saveregisters;
+ end;
+
+
+ { object with vmt }
+ pvmtobject = ^tvmtobject;
+ tvmtobject = object
+ public
+ object_u8bit : byte;
+ object_u16bit : word;
+ object_bigstring : shortstring;
+ object_s32bit : longint;
+ object_s64bit : int64;
+ constructor constructor_params_mixed(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);
+ constructor constructor_init;
+ destructor destructor_params_done;
+ procedure method_normal_params_mixed(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);saveregisters;
+ procedure method_virtual_params_mixed(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);virtual;saveregisters;
+ procedure method_virtual_overriden_params_mixed(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);virtual;saveregisters;
+ procedure method_static_params_mixed(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);static;saveregisters;
+ procedure method_normal_call_inherited_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
+
+ { virtual methods which call other methods }
+ procedure method_virtual_call_static_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;saveregisters;
+ procedure method_virtual_call_virtual_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;saveregisters;
+ procedure method_virtual_call_overriden_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;saveregisters;
+ procedure method_virtual_call_normal_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;saveregisters;
+ procedure method_virtual_call_constructor_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;saveregisters;
+ procedure method_virtual_call_inherited_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;saveregisters;
+
+ end;
+
+ pheritedvmtobject = ^theritedvmtobject;
+ theritedvmtobject = object(tvmtobject)
+ constructor constructor_params_mixed_call_virtual(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);
+ constructor constructor_params_mixed_call_overriden(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);
+ constructor constructor_params_mixed_call_static(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);
+ constructor constructor_params_mixed_call_normal(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);
+ constructor constructor_params_mixed_call_inherited(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);
+ procedure method_virtual_overriden_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;saveregisters;
+
+ { normal methods which call other methods }
+ procedure method_normal_call_static_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
+ procedure method_normal_call_virtual_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
+ procedure method_normal_call_overriden_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
+ procedure method_normal_call_normal_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
+ procedure method_normal_call_constructor_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
+ procedure method_normal_call_inherited_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
+
+ { virtual methods which call other methods }
+ procedure method_virtual_call_inherited_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;saveregisters;
+
+ end;
+
+ pfailvmtobject = ^tfailvmtobject;
+ tfailvmtobject = object(tvmtobject)
+ public
+ constructor constructor_public_none;
+ end;
+
+
+
+{**************************************************************************}
+{ NO VMT OBJECT }
+{**************************************************************************}
+
+ {****************** NO PARAMETERS ******************}
+ procedure tnovmtobject.method_public_none;saveregisters;
+ begin
+ global_u8bit := RESULT_U8BIT;
+ end;
+
+
+ procedure tnovmtobject.method_public_static_none;saveregisters;
+ begin
+ global_u8bit := RESULT_U8BIT;
+ end;
+
+
+ procedure tnovmtobject.method_call_private_none;saveregisters;
+ begin
+ method_private_none;
+ method_private_static_none;
+ end;
+
+ procedure tnovmtobject.method_call_private_static_none;saveregisters;
+ begin
+ method_private_static_none;
+ end;
+
+
+ procedure tnovmtobject.method_private_none;saveregisters;
+ begin
+ Inc(global_u16bit, RESULT_U8BIT);
+ end;
+
+
+ procedure tnovmtobject.method_private_static_none;saveregisters;
+ begin
+ Inc(global_u16bit, RESULT_U8BIT);
+ end;
+
+ {******************** PARAMETERS ******************}
+
+ procedure tnovmtobject.method_public_u8(x : byte);saveregisters;
+ begin
+ global_u8bit := x;
+ end;
+
+ procedure tnovmtobject.method_public_static_u8(x: byte);saveregisters;
+ begin
+ global_u8bit := x;
+ end;
+
+ procedure tnovmtobject.method_call_private_u8(x: byte);saveregisters;
+ begin
+ method_private_static_u8(x);
+ method_private_u8(x);
+ end;
+
+ procedure tnovmtobject. method_call_private_static_u8(x: byte);saveregisters;
+ begin
+ method_private_static_u8(x);
+ end;
+
+ procedure tnovmtobject.method_private_u8(x: byte);saveregisters;
+ begin
+ Inc(global_u16bit,x);
+ end;
+
+ procedure tnovmtobject.method_private_static_u8(x: byte);saveregisters;
+ begin
+ Inc(global_u16bit,x);
+ end;
+
+
+ function tnovmtobject.func_getu16bit : word;saveregisters;
+ begin
+ func_getu16bit := object_u16bit;
+ end;
+
+ {
+ complex testing, nested field access, with parameters and
+ comple return value.
+
+ On exit : global_u8bit := x;
+ global_u16bit := object_u16bit (from func_getu16bit);
+ global_s32bit := RESULT_S32BIT
+ global_bigstring := object_bigstring
+ global_s64bit := x;
+ }
+ function tnovmtobject.func_array_mixed_nested(b: byte): tsmallarray;saveregisters;
+
+ procedure nested_one_proc(l: longint);
+ begin
+ global_u16bit := func_getu16bit;
+ global_s32bit := l;
+ end;
+
+ procedure nested_two_proc(l : longint);
+ begin
+ global_s64bit := l;
+ end;
+
+
+
+ function nested_one_func(level1_b : byte; s: shortstring): byte;
+ var
+ s1 : shortstring;
+
+ function nested_two_func(level2_b : byte; s :shortstring): byte;
+ begin
+ nested_two_func:=level2_b;
+ global_bigstring := s;
+ nested_one_proc(RESULT_S32BIT);
+ end;
+
+ begin
+ s1:=s;
+ nested_one_func := nested_two_func(level1_b,s1);
+ nested_two_proc(level1_b);
+ end;
+
+
+ var
+ local_b: byte;
+ smallarray: tsmallarray;
+ begin
+ fillchar(smallarray, sizeof(smallarray), #0);
+ smallarray[1] := RESULT_U8BIT;
+ smallarray[SMALL_INDEX] := RESULT_U8BIT;
+ func_array_mixed_nested := smallarray;
+ local_b:=b;
+ global_u8bit := nested_one_func(local_b, object_bigstring);
+ end;
+
+{**************************************************************************}
+{ FAILED OBJECT }
+{**************************************************************************}
+constructor tfailvmtobject.constructor_public_none;
+ begin
+ { this calls the constructor fail special keyword }
+ fail;
+ end;
+
+{**************************************************************************}
+{ VMT OBJECT }
+{**************************************************************************}
+constructor tvmtobject.constructor_params_mixed(u8 :byte; u16: word;
+ bigstring: shortstring; s32: longint; s64: int64);
+ begin
+ object_u8bit := u8;
+ object_u16bit := u16;
+ object_bigstring := bigstring;
+ object_s32bit := s32;
+ object_s64bit := s64;
+ end;
+
+
+constructor tvmtobject.constructor_init;
+ begin
+ object_u8bit := 0;
+ object_u16bit := 0;
+ object_bigstring := '';
+ object_s32bit := 0;
+ object_s64bit := 0;
+ end;
+
+destructor tvmtobject.destructor_params_done;
+ begin
+ object_u8bit := 0;
+ object_u16bit := 0;
+ object_bigstring := '';
+ object_s32bit := 0;
+ object_s64bit := 0;
+ end;
+
+
+procedure tvmtobject.method_normal_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
+ begin
+ object_u8bit := u8;
+ object_u16bit := u16;
+ object_bigstring := bigstring;
+ object_s32bit := s32;
+ object_s64bit := s64;
+ end;
+
+procedure tvmtobject.method_virtual_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
+ begin
+ object_u8bit := u8;
+ object_u16bit := u16;
+ object_bigstring := bigstring;
+ object_s32bit := s32;
+ object_s64bit := s64;
+ end;
+
+{ this one should be overriden }
+procedure tvmtobject.method_virtual_overriden_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
+ begin
+ RunError(211);
+ end;
+
+{ can't access field of instances in static methods }
+procedure tvmtobject.method_static_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
+ begin
+ global_u8bit := u8;
+ global_u16bit := u16;
+ global_bigstring := bigstring;
+ global_s32bit := s32;
+ global_s64bit := s64;
+ end;
+
+procedure tvmtobject.method_normal_call_inherited_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
+ begin
+ object_u8bit := u8;
+ object_u16bit := u16;
+ object_bigstring := bigstring;
+ object_s32bit := s32;
+ object_s64bit := s64;
+ end;
+
+
+procedure tvmtobject.method_virtual_call_static_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
+ begin
+ method_static_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+procedure tvmtobject.method_virtual_call_virtual_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
+ begin
+ method_virtual_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+procedure tvmtobject.method_virtual_call_overriden_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
+ begin
+ method_virtual_overriden_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+
+procedure tvmtobject.method_virtual_call_normal_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
+ begin
+ method_normal_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+procedure tvmtobject.method_virtual_call_constructor_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
+ begin
+ constructor_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+procedure tvmtobject.method_virtual_call_inherited_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
+ begin
+ object_u8bit := u8;
+ object_u16bit := u16;
+ object_bigstring := bigstring;
+ object_s32bit := s32;
+ object_s64bit := s64;
+ end;
+
+
+{**************************************************************************}
+{ INHERITED VMT OBJECT }
+{**************************************************************************}
+constructor theritedvmtobject.constructor_params_mixed_call_virtual(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
+ begin
+ object_u8bit := 0;
+ object_u16bit := 0;
+ object_bigstring := '';
+ object_s32bit := 0;
+ object_s64bit := 0;
+ method_virtual_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+constructor theritedvmtobject.constructor_params_mixed_call_overriden(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
+ begin
+ object_u8bit := 0;
+ object_u16bit := 0;
+ object_bigstring := '';
+ object_s32bit := 0;
+ object_s64bit := 0;
+ method_virtual_overriden_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+constructor theritedvmtobject.constructor_params_mixed_call_static(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
+ begin
+ object_u8bit := 0;
+ object_u16bit := 0;
+ object_bigstring := '';
+ object_s32bit := 0;
+ object_s64bit := 0;
+ method_static_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+constructor theritedvmtobject.constructor_params_mixed_call_normal(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
+ begin
+ object_u8bit := 0;
+ object_u16bit := 0;
+ object_bigstring := '';
+ object_s32bit := 0;
+ object_s64bit := 0;
+ method_normal_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+constructor theritedvmtobject.constructor_params_mixed_call_inherited
+ (u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
+ begin
+ object_u8bit := 0;
+ object_u16bit := 0;
+ object_bigstring := '';
+ object_s32bit := 0;
+ object_s64bit := 0;
+ inherited constructor_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+{ this one should be overriden }
+procedure theritedvmtobject.method_virtual_overriden_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);
+ begin
+ object_u8bit := u8;
+ object_u16bit := u16;
+ object_bigstring := bigstring;
+ object_s32bit := s32;
+ object_s64bit := s64;
+ end;
+
+procedure theritedvmtobject.method_normal_call_static_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
+ begin
+ method_static_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+procedure theritedvmtobject.method_normal_call_virtual_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
+ begin
+ method_virtual_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+procedure theritedvmtobject.method_normal_call_overriden_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
+ begin
+ method_virtual_overriden_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+
+procedure theritedvmtobject.method_normal_call_normal_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
+ begin
+ method_normal_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+procedure theritedvmtobject.method_normal_call_constructor_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
+ begin
+ constructor_params_mixed(u8, u16, bigstring, s32, s64);
+ end;
+
+procedure theritedvmtobject.method_normal_call_inherited_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
+ begin
+ Inherited method_normal_call_inherited_params_mixed(u8, u16, bigstring,
+ s32, s64);
+ end;
+
+procedure theritedvmtobject.method_virtual_call_inherited_params_mixed(
+ u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);saveregisters;
+ begin
+ Inherited method_virtual_call_inherited_params_mixed(u8, u16, bigstring,
+ s32, s64);
+ end;
+
+
+procedure testnovmtobject;
+var
+ novmtobject : tnovmtobject;
+ failed : boolean;
+begin
+ {******************** STATIC / METHOD SIMPLE CALL **********************}
+ Write('No parameter / method call testing...');
+ failed := false;
+
+ clear_globals;
+ clear_values;
+
+ tnovmtobject.method_public_static_none;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+ novmtobject.method_public_static_none;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ tnovmtobject.method_call_private_static_none;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_call_private_static_none;
+ if global_u16bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_public_none;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_call_private_none;
+ if global_u16bit <> (RESULT_U16BIT) then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ Write('Simple parameter (LOC_CONSTANT) / method call testing...');
+ failed := false;
+
+ clear_globals;
+ clear_values;
+
+ { parameter is LOC_CONSTANT }
+ novmtobject.method_public_u8(RESULT_U8BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ tnovmtobject.method_public_static_u8(RESULT_U8BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_public_static_u8(RESULT_U8BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_call_private_u8(RESULT_U8BIT);
+ if global_u16bit <> (RESULT_U16BIT) then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_call_private_static_u8(RESULT_U8BIT);
+ if global_u16bit <> (RESULT_U8BIT) then
+ failed := true;
+
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+
+ Write('Simple parameter (LOC_REFERENCE) / method call testing...');
+ failed := false;
+
+ clear_globals;
+ clear_values;
+
+ value_u8bit := RESULT_U8BIT;
+ novmtobject.method_public_u8(value_u8bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ value_u8bit := RESULT_U8BIT;
+ tnovmtobject.method_public_static_u8(value_u8bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ value_u8bit := RESULT_U8BIT;
+ novmtobject.method_public_static_u8(value_u8bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ value_u8bit := RESULT_U8BIT;
+ novmtobject.method_call_private_u8(value_u8bit);
+ if global_u16bit <> (RESULT_U16BIT) then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ value_u8bit := RESULT_U8BIT;
+ novmtobject.method_call_private_static_u8(value_u8bit);
+ if global_u16bit <> (RESULT_U8BIT) then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ Write('Simple parameter (LOC_REGISTER) / method call testing...');
+ failed := false;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_public_u8(getu8);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ tnovmtobject.method_public_static_u8(getu8);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_public_static_u8(getu8);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_call_private_u8(getu8);
+ if global_u16bit <> (RESULT_U16BIT) then
+ failed := true;
+
+ clear_globals;
+ clear_values;
+
+ novmtobject.method_call_private_static_u8(getu8);
+ if global_u16bit <> (RESULT_U8BIT) then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+
+ Write('Simple parameter / complex return / nested method access testing...');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+ novmtobject.object_bigstring := RESULT_BIGSTRING;
+ novmtobject.object_u16bit := RESULT_U16BIT;
+
+ value_smallarray := novmtobject.func_array_mixed_nested(RESULT_U8BIT);
+ if (value_smallarray[1] <> RESULT_U8BIT) or (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) then
+ failed := true;
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_U8BIT then
+ failed := true;
+
+ if failed then
+ fail
+ else
+ WriteLn('Passed!');
+end;
+
+
+procedure testfailedobject;
+var
+ failedobject : tfailvmtobject;
+ begin
+ Write('Testing constructor return value...');
+ if failedobject.constructor_public_none then
+ fail
+ else
+ Writeln('Passed!');
+ end;
+
+
+ procedure testvmtobject;
+ var
+ vmtobject : tvmtobject;
+ failed : boolean;
+ begin
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call...');
+ vmtobject.constructor_params_mixed(RESULT_U8BIT, RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.constructor_params_mixed(value_u8bit, value_u16bit, value_bigstring,
+ value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ end;
+
+
+ procedure testheritedvmtobject;
+ var
+ vmtobject : theritedvmtobject;
+ failed : boolean;
+ begin
+ {********************** CONSTRUCTOR TESTING ************************}
+ {********************** DESTRUCTOR TESTING ************************}
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) inherited constructor call...');
+ vmtobject.constructor_params_mixed_call_inherited(RESULT_U8BIT, RESULT_U16BIT, RESULT_BIGSTRING,
+ RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) inherited constructor call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.constructor_params_mixed_call_inherited(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
+ vmtobject.constructor_params_mixed_call_virtual(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.constructor_params_mixed_call_virtual(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
+ vmtobject.constructor_params_mixed_call_overriden(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.constructor_params_mixed_call_overriden(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/method call...');
+ vmtobject.constructor_params_mixed_call_normal(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.constructor_params_mixed_call_normal(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/static call...');
+ vmtobject.constructor_params_mixed_call_static(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/static call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.constructor_params_mixed_call_static(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ {************************* METHOD TESTING **************************}
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
+ vmtobject.method_virtual_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_virtual_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
+ vmtobject.method_virtual_overriden_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_virtual_overriden_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call...');
+ vmtobject.method_normal_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_normal_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) static method call...');
+ vmtobject.method_static_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) static method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_static_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { ********************************************************************
+ This calls methods which in turn call other methods, or a constructor
+ or a destructor.
+ *********************************************************************
+ }
+ clear_globals;
+ clear_values;
+ failed := false;
+ { Calls the ancestor virtual method }
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
+ vmtobject.method_normal_call_virtual_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_normal_call_virtual_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { The virtual method has been overriden by the object in this case }
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
+ vmtobject.method_normal_call_overriden_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_normal_call_overriden_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/normal call...');
+ vmtobject.method_normal_call_normal_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/normal call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_normal_call_normal_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ (* constructor call inside a normal method *)
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/constructor call...');
+ vmtobject.method_normal_call_constructor_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/constructor call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_normal_call_constructor_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { static method call }
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/static call...');
+ vmtobject.method_normal_call_static_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/static call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_normal_call_static_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ (* calls the inherited method *)
+ clear_globals;
+ clear_values;
+ failed := false;
+ { Calls the ancestor virtual method }
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/inherited call...');
+ vmtobject.method_normal_call_inherited_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/inherited call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_normal_call_inherited_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { ********************************************************************
+ This calls virtual methods which in turn call other methods,
+ or a constructor or a destructor.
+ *********************************************************************
+ }
+ clear_globals;
+ clear_values;
+ failed := false;
+ { Calls the ancestor virtual method }
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
+ vmtobject.method_virtual_call_virtual_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_virtual_call_virtual_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { The virtual method has been overriden by the object in this case }
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
+ vmtobject.method_virtual_call_overriden_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_virtual_call_overriden_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/normal call...');
+ vmtobject.method_virtual_call_normal_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/normal call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_virtual_call_normal_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ (* constructor call inside a normal method *)
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/constructor call...');
+ vmtobject.method_virtual_call_constructor_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/constructor call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_virtual_call_constructor_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { static virtual call }
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/static call...');
+ vmtobject.method_virtual_call_static_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/static call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_virtual_call_static_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ (* calls the inherited method *)
+ clear_globals;
+ clear_values;
+ failed := false;
+ { Calls the ancestor virtual method }
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/inherited call...');
+ vmtobject.method_virtual_call_inherited_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ vmtobject.constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/inherited call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ vmtobject.method_virtual_call_inherited_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if vmtobject.object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if vmtobject.object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if vmtobject.object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if vmtobject.object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if vmtobject.object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ vmtobject.destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+
+ end;
+
+
+ { same as testvmtherited, except uses with statement }
+ procedure testwith;
+ var
+ vmtobject : theritedvmtobject;
+ failed : boolean;
+ begin
+ with vmtobject do
+ begin
+ {********************** CONSTRUCTOR TESTING ************************}
+ {********************** DESTRUCTOR TESTING ************************}
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) inherited constructor call...');
+ constructor_params_mixed_call_inherited(RESULT_U8BIT, RESULT_U16BIT, RESULT_BIGSTRING,
+ RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) inherited constructor call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ constructor_params_mixed_call_inherited(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
+ constructor_params_mixed_call_virtual(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ constructor_params_mixed_call_virtual(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/virtual call...');
+ constructor_params_mixed_call_overriden(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ constructor_params_mixed_call_overriden(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/method call...');
+ constructor_params_mixed_call_normal(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ constructor_params_mixed_call_normal(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_CONSTANT) constructor call w/static call...');
+ constructor_params_mixed_call_static(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ Write('Testing mixed parameter (LOC_REFERENCE) constructor call w/static call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ constructor_params_mixed_call_static(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ {************************* METHOD TESTING **************************}
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
+ method_virtual_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_virtual_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...');
+ method_virtual_overriden_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_virtual_overriden_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call...');
+ method_normal_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_normal_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) static method call...');
+ method_static_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) static method call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_static_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { ********************************************************************
+ This calls methods which in turn call other methods, or a constructor
+ or a destructor.
+ *********************************************************************
+ }
+ clear_globals;
+ clear_values;
+ failed := false;
+ { Calls the ancestor virtual method }
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
+ method_normal_call_virtual_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_normal_call_virtual_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { The virtual method has been overriden by the object in this case }
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...');
+ method_normal_call_overriden_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_normal_call_overriden_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/normal call...');
+ method_normal_call_normal_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/normal call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_normal_call_normal_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ (* constructor call inside a normal method *)
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/constructor call...');
+ method_normal_call_constructor_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/constructor call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_normal_call_constructor_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { static method call }
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/static call...');
+ method_normal_call_static_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/static call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_normal_call_static_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ (* calls the inherited method *)
+ clear_globals;
+ clear_values;
+ failed := false;
+ { Calls the ancestor virtual method }
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) method call w/inherited call...');
+ method_normal_call_inherited_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) method call w/inherited call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_normal_call_inherited_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { ********************************************************************
+ This calls virtual methods which in turn call other methods,
+ or a constructor or a destructor.
+ *********************************************************************
+ }
+ clear_globals;
+ clear_values;
+ failed := false;
+ { Calls the ancestor virtual method }
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
+ method_virtual_call_virtual_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_virtual_call_virtual_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { The virtual method has been overriden by the object in this case }
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...');
+ method_virtual_call_overriden_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/virtual call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_virtual_call_overriden_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/normal call...');
+ method_virtual_call_normal_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/normal call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_virtual_call_normal_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ (* constructor call inside a normal method *)
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/constructor call...');
+ method_virtual_call_constructor_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/constructor call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_virtual_call_constructor_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ { static virtual call }
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/static call...');
+ method_virtual_call_static_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/static call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_virtual_call_static_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if global_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if global_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if global_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if global_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if global_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ (* calls the inherited method *)
+ clear_globals;
+ clear_values;
+ failed := false;
+ { Calls the ancestor virtual method }
+ constructor_init;
+ Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/inherited call...');
+ method_virtual_call_inherited_params_mixed(RESULT_U8BIT,
+ RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+
+ clear_globals;
+ clear_values;
+ failed := false;
+
+ constructor_init;
+ Write('Testing mixed parameter (LOC_REFERENCE) virtual call w/inherited call...');
+ value_u8bit := RESULT_U8BIT;
+ value_u16bit := RESULT_U16BIT;
+ value_bigstring := RESULT_BIGSTRING;
+ value_s32bit := RESULT_S32BIT;
+ value_s64bit := RESULT_S64BIT;
+ method_virtual_call_inherited_params_mixed(value_u8bit,
+ value_u16bit, value_bigstring, value_s32bit, value_s64bit);
+ if object_u8bit <> RESULT_U8BIT then
+ failed := true;
+ if object_u16bit <> RESULT_U16BIT then
+ failed := true;
+ if object_s32bit <> RESULT_S32BIT then
+ failed := true;
+ if object_s64bit <> RESULT_S64BIT then
+ failed := true;
+ if object_bigstring <> RESULT_BIGSTRING then
+ failed := true;
+ destructor_params_done;
+
+ if failed then
+ fail
+ else
+ Writeln('Passed!');
+ end; { end with }
+ end;
+
+
+begin
+ WriteLN('*********************** NO VMT OBJECT TESTS ********************');
+ testnovmtobject;
+ WriteLN('************************ VMT OBJECT FAIL **********************');
+ testfailedobject;
+ WriteLN('************************* VMT OBJECT TESTS *********************');
+ testvmtobject;
+ testheritedvmtobject;
+ WriteLN('**************** VMT OBJECT TESTS USING WITH *******************');
+ testwith;
+end.
+
+{
$Log$
- Revision 1.5 2003-04-22 10:24:29 florian
+ Revision 1.6 2004-05-02 12:11:44 peter
+ * fixed linefeeds
+
+ Revision 1.5 2003/04/22 10:24:29 florian
* fixed defines for powerpc
-
- Revision 1.4 2002/12/29 15:30:55 peter
- * updated for 1.1 compiler that does not allow calling conventions
- for constructor/destructor
-
- Revision 1.3 2002/09/07 15:40:54 peter
- * old logs removed and tabs fixed
-
- Revision 1.2 2002/05/05 19:13:19 carl
- + withsymtable checking
-
- Revision 1.1 2002/05/05 13:58:50 carl
- + finished procedural variable testsuit
- + finished method testsuit
-
-}
+
+ Revision 1.4 2002/12/29 15:30:55 peter
+ * updated for 1.1 compiler that does not allow calling conventions
+ for constructor/destructor
+
+ Revision 1.3 2002/09/07 15:40:54 peter
+ * old logs removed and tabs fixed
+
+ Revision 1.2 2002/05/05 19:13:19 carl
+ + withsymtable checking
+
+ Revision 1.1 2002/05/05 13:58:50 carl
+ + finished procedural variable testsuit
+ + finished method testsuit
+
+}
diff --git a/tests/test/cg/tcnvint2.pp b/tests/test/cg/tcnvint2.pp
index aefd4f9eec..3ac0139103 100644
--- a/tests/test/cg/tcnvint2.pp
+++ b/tests/test/cg/tcnvint2.pp
@@ -42,7 +42,7 @@ var
begin
getint64 := $10000000;
end;
-
+
function getint64_2 : int64;
var
i: longint;
@@ -200,7 +200,10 @@ end.
{
$Log$
- Revision 1.6 2002-09-29 14:37:22 carl
+ Revision 1.7 2004-05-02 12:11:44 peter
+ * fixed linefeeds
+
+ Revision 1.6 2002/09/29 14:37:22 carl
* must more 64-bit testing (to detect endian specific problems)
Revision 1.5 2002/09/27 17:46:01 carl
diff --git a/tests/test/cg/tcnvstr1.pp b/tests/test/cg/tcnvstr1.pp
index 59eec29663..e7124c16bf 100644
--- a/tests/test/cg/tcnvstr1.pp
+++ b/tests/test/cg/tcnvstr1.pp
@@ -28,7 +28,7 @@
{$endif}
{$endif}
-{$H+}
+{$H+}
const
{ exactly 255 characters in length }
@@ -48,65 +48,65 @@ const
' aren''t any problems with maximum length strings. I hope you understand'+
HUGE_STRING_END;
EMPTY_STRING = '';
-
+
type
shortstr = string[127];
var
s2: shortstr;
str_ansi: ansistring;
str_short: shortstring;
-{$ifdef haswidestring}
+{$ifdef haswidestring}
str_wide : widestring;
-{$endif}
-
-
+{$endif}
+
+
procedure fail;
begin
WriteLn('Failure!');
Halt(1);
end;
-
-
+
+
procedure test_ansi_to_short;
begin
- {************************************************************************}
+ {************************************************************************}
{ ansistring -> shortstring }
- {************************************************************************}
+ {************************************************************************}
WriteLn('Test ansistring -> shortstring');
{ ansistring -> shortstring }
str_short := '';
str_ansi:='';
str_ansi := SMALL_STRING;
str_short:=str_ansi;
- Write('small ansistring -> shortstring...');
+ Write('small ansistring -> shortstring...');
if str_short = str_ansi then
WriteLn('Success.')
else
fail;
-
+
str_short := '';
str_ansi:='';
str_ansi := EMPTY_STRING;
str_short:=str_ansi;
- Write('empty ansistring -> shortstring...');
+ Write('empty ansistring -> shortstring...');
if str_short = str_ansi then
WriteLn('Success.')
else
fail;
-
+
str_short := '';
str_ansi:='';
str_ansi := BIG_STRING;
str_short:=str_ansi;
- Write('big ansistring -> shortstring...');
+ Write('big ansistring -> shortstring...');
if str_short = str_ansi then
WriteLn('Success.')
else
fail;
- Write('huge ansistring -> shortstring...');
+ Write('huge ansistring -> shortstring...');
str_short := '';
str_ansi:='';
str_ansi := HUGE_STRING;
@@ -121,17 +121,17 @@ begin
str_ansi:='';
str_ansi := SMALL_STRING;
s2:=str_ansi;
- Write('small ansistring -> shortstring...');
+ Write('small ansistring -> shortstring...');
if s2 = str_ansi then
WriteLn('Success.')
else
fail;
-
+
s2 := '';
str_ansi:='';
str_ansi := EMPTY_STRING;
s2:=str_ansi;
- Write('empty ansistring -> shortstring...');
+ Write('empty ansistring -> shortstring...');
if s2 = str_ansi then
WriteLn('Success.')
else
@@ -141,18 +141,18 @@ begin
str_ansi:='';
str_ansi := BIG_STRING;
s2:=str_ansi;
- Write('big ansistring -> shortstring...');
+ Write('big ansistring -> shortstring...');
{ Should fail, since comparing different string lengths }
if s2 <> str_ansi then
WriteLn('Success.')
else
fail;
-
+
s2 := '';
str_ansi:='';
str_ansi := HUGE_STRING;
s2:=str_ansi;
- Write('huge ansistring -> shortstring...');
+ Write('huge ansistring -> shortstring...');
{ Should fail, since comparing different string lengths }
if s2 <> str_ansi then
WriteLn('Success.')
@@ -163,9 +163,9 @@ end;
procedure test_short_to_short;
begin
- {************************************************************************}
+ {************************************************************************}
{ shortstring -> shortstring }
- {************************************************************************}
+ {************************************************************************}
WriteLn('Test shortstring -> shortstring...');
{ shortstring -> shortstring }
str_short := '';
@@ -177,7 +177,7 @@ begin
WriteLn('Success.')
else
fail;
-
+
str_short := '';
s2:='';
s2 := EMPTY_STRING;
@@ -222,7 +222,7 @@ begin
WriteLn('Success.')
else
fail;
-
+
s2 := '';
str_short:='';
str_short := EMPTY_STRING;
@@ -244,7 +244,7 @@ begin
else
fail;
-{$ifdef fpc}
+{$ifdef fpc}
s2 := '';
str_short:='';
str_short := HUGE_STRING;
@@ -255,17 +255,17 @@ begin
WriteLn('Success.')
else
fail;
-{$endif}
+{$endif}
end;
procedure test_short_to_ansi;
begin
- {************************************************************************}
+ {************************************************************************}
{ shortstring -> ansistring }
- {************************************************************************}
+ {************************************************************************}
WriteLn('Test shortstring -> ansistring');
- Write('small shortstring -> ansistring...');
+ Write('small shortstring -> ansistring...');
{ shortstring -> ansistring }
str_short := SMALL_STRING;
str_ansi:=str_short;
@@ -273,8 +273,8 @@ begin
WriteLn('Success.')
else
fail;
-
- Write('empty shortstring -> ansistring...');
+
+ Write('empty shortstring -> ansistring...');
str_short := EMPTY_STRING;
str_ansi:=str_short;
if str_short = str_ansi then
@@ -282,7 +282,7 @@ begin
else
fail;
- Write('big shortstring -> ansistring...');
+ Write('big shortstring -> ansistring...');
str_short := BIG_STRING;
str_ansi:=str_short;
if str_short = str_ansi then
@@ -290,7 +290,7 @@ begin
else
fail;
- Write('small shortstring -> ansistring...');
+ Write('small shortstring -> ansistring...');
{ shortstring -> ansistring }
s2 := SMALL_STRING;
str_ansi:=s2;
@@ -298,8 +298,8 @@ begin
WriteLn('Success.')
else
fail;
-
- Write('empty shortstring -> ansistring...');
+
+ Write('empty shortstring -> ansistring...');
s2 := EMPTY_STRING;
str_ansi:=s2;
if s2 = str_ansi then
@@ -313,11 +313,11 @@ end;
{$ifdef haswidestring}
procedure test_wide_to_ansi;
begin
- {************************************************************************}
+ {************************************************************************}
{ widestring -> ansistring }
- {************************************************************************}
+ {************************************************************************}
WriteLn('Test widestring -> ansistring');
- Write('small widestring -> ansistring...');
+ Write('small widestring -> ansistring...');
{ widestring -> ansistring }
str_wide := SMALL_STRING;
str_ansi:=str_wide;
@@ -325,8 +325,8 @@ begin
WriteLn('Success.')
else
fail;
-
- Write('empty widestring -> ansistring...');
+
+ Write('empty widestring -> ansistring...');
str_wide := EMPTY_STRING;
str_ansi:=str_wide;
if str_wide = str_ansi then
@@ -334,7 +334,7 @@ begin
else
fail;
- Write('big widestring -> ansistring...');
+ Write('big widestring -> ansistring...');
str_wide := BIG_STRING;
str_ansi:=str_wide;
if str_wide = str_ansi then
@@ -342,7 +342,7 @@ begin
else
fail;
- Write('huge widestring -> ansistring...');
+ Write('huge widestring -> ansistring...');
str_wide := HUGE_STRING;
str_ansi:=str_wide;
if str_wide = str_ansi then
@@ -356,11 +356,11 @@ end;
procedure test_short_to_wide;
begin
- {************************************************************************}
+ {************************************************************************}
{ shortstring -> widestring }
- {************************************************************************}
+ {************************************************************************}
WriteLn('Test shortstring -> widestring');
- Write('small shortstring -> widestring...');
+ Write('small shortstring -> widestring...');
{ shortstring -> widestring }
str_short := SMALL_STRING;
str_wide:=str_short;
@@ -368,8 +368,8 @@ begin
WriteLn('Success.')
else
fail;
-
- Write('empty shortstring -> widestring...');
+
+ Write('empty shortstring -> widestring...');
str_short := EMPTY_STRING;
str_wide:=str_short;
if str_short = str_wide then
@@ -377,7 +377,7 @@ begin
else
fail;
- Write('big shortstring -> widestring...');
+ Write('big shortstring -> widestring...');
str_short := BIG_STRING;
str_wide:=str_short;
if str_short = str_wide then
@@ -385,7 +385,7 @@ begin
else
fail;
- Write('small shortstring -> widestring...');
+ Write('small shortstring -> widestring...');
{ shortstring -> widestring }
s2 := SMALL_STRING;
str_wide:=s2;
@@ -393,8 +393,8 @@ begin
WriteLn('Success.')
else
fail;
-
- Write('empty shortstring -> widestring...');
+
+ Write('empty shortstring -> widestring...');
s2 := EMPTY_STRING;
str_wide:=s2;
if s2 = str_wide then
@@ -407,11 +407,11 @@ end;
procedure test_ansi_to_wide;
begin
- {************************************************************************}
+ {************************************************************************}
{ ansistring -> widestring }
- {************************************************************************}
+ {************************************************************************}
WriteLn('Test ansistring -> widestring');
- Write('small ansistring -> widestring...');
+ Write('small ansistring -> widestring...');
{ ansistring -> widestring }
str_ansi := SMALL_STRING;
str_wide:=str_ansi;
@@ -419,8 +419,8 @@ begin
WriteLn('Success.')
else
fail;
-
- Write('empty ansistring -> widestring...');
+
+ Write('empty ansistring -> widestring...');
str_ansi := EMPTY_STRING;
str_wide:=str_ansi;
if str_ansi = str_wide then
@@ -428,7 +428,7 @@ begin
else
fail;
- Write('big ansistring -> widestring...');
+ Write('big ansistring -> widestring...');
str_ansi := BIG_STRING;
str_wide:=str_ansi;
if str_ansi = str_wide then
@@ -436,7 +436,7 @@ begin
else
fail;
- Write('small ansistring -> widestring...');
+ Write('small ansistring -> widestring...');
{ ansistring -> widestring }
s2 := SMALL_STRING;
str_wide:=s2;
@@ -444,8 +444,8 @@ begin
WriteLn('Success.')
else
fail;
-
- Write('empty ansistring -> widestring...');
+
+ Write('empty ansistring -> widestring...');
s2 := EMPTY_STRING;
str_wide:=s2;
if s2 = str_wide then
@@ -459,33 +459,33 @@ end;
procedure test_wide_to_short;
begin
- {************************************************************************}
+ {************************************************************************}
{ widestring -> shortstring }
- {************************************************************************}
+ {************************************************************************}
WriteLn('Test widestring -> shortstring');
{ widestring -> shortstring }
str_short := '';
str_wide:='';
str_wide := SMALL_STRING;
- Write('small widestring -> shortstring...');
- str_short:=str_wide;
- if str_short = str_wide then
- WriteLn('Success.')
- else
- fail;
-
- str_short := '';
- str_wide:='';
- str_wide := EMPTY_STRING;
- Write('empty widestring -> shortstring...');
+ Write('small widestring -> shortstring...');
str_short:=str_wide;
if str_short = str_wide then
WriteLn('Success.')
else
fail;
-
- Write('big widestring -> shortstring...');
+ str_short := '';
+ str_wide:='';
+ str_wide := EMPTY_STRING;
+ Write('empty widestring -> shortstring...');
+ str_short:=str_wide;
+ if str_short = str_wide then
+ WriteLn('Success.')
+ else
+ fail;
+
+
+ Write('big widestring -> shortstring...');
str_short := '';
str_wide:='';
str_wide := BIG_STRING;
@@ -495,16 +495,16 @@ begin
else
fail;
- Write('huge widestring -> shortstring...');
+ Write('huge widestring -> shortstring...');
str_wide := HUGE_STRING;
str_short:=str_wide;
if str_short <> str_wide then
WriteLn('Success.')
else
fail;
-
+
{}
- Write('small widestring -> shortstring...');
+ Write('small widestring -> shortstring...');
s2 := '';
str_wide:='';
str_wide := SMALL_STRING;
@@ -513,8 +513,8 @@ begin
WriteLn('Success.')
else
fail;
-
- Write('empty widestring -> shortstring...');
+
+ Write('empty widestring -> shortstring...');
s2 := '';
str_wide:='';
str_wide := EMPTY_STRING;
@@ -524,7 +524,7 @@ begin
else
fail;
- Write('big widestring -> shortstring...');
+ Write('big widestring -> shortstring...');
s2 := '';
str_wide:='';
str_wide := BIG_STRING;
@@ -533,8 +533,8 @@ begin
WriteLn('Success.')
else
fail;
-
- Write('huge widestring -> shortstring...');
+
+ Write('huge widestring -> shortstring...');
s2 := '';
str_wide:='';
str_wide := HUGE_STRING;
@@ -551,17 +551,20 @@ Begin
test_short_to_short;
test_short_to_ansi;
{ requires widestring support }
-{$ifdef haswidestring}
+{$ifdef haswidestring}
test_short_to_wide;
test_ansi_to_wide;
test_wide_to_short;
test_wide_to_ansi;
-{$endif}
+{$endif}
End.
{
$Log$
- Revision 1.3 2002-10-02 19:26:49 carl
+ Revision 1.4 2004-05-02 12:11:44 peter
+ * fixed linefeeds
+
+ Revision 1.3 2002/10/02 19:26:49 carl
+ added much much more testing of different string types
* str() format depends on size of real
diff --git a/tests/test/cg/tcnvstr3.pp b/tests/test/cg/tcnvstr3.pp
index de469ceb21..d65e74c98d 100644
--- a/tests/test/cg/tcnvstr3.pp
+++ b/tests/test/cg/tcnvstr3.pp
@@ -26,10 +26,10 @@ procedure fail;
var
str_ansi : ansistring;
str_short : shortstring;
-{$ifdef haswidestring}
+{$ifdef haswidestring}
str_wide : widestring;
wc : widechar;
-{$endif haswidestring}
+{$endif haswidestring}
c: char;
_result : boolean;
Begin
@@ -40,7 +40,7 @@ Begin
{ empty string -> shortstring }
str_short := '';
if str_short <> '' then
- _result := false;
+ _result := false;
{ constant char -> shortstring }
str_short := 'c';
if str_short <> 'c' then
@@ -52,12 +52,12 @@ Begin
if str_short <> 'c' then
_result := false;
{* wide char *}
-{$ifdef haswidestring}
+{$ifdef haswidestring}
{ constant char -> shortstring }
str_short := shortstring(widechar('c'));
if str_short <> 'c' then
_result := false;
-{$endif}
+{$endif}
{ wide char -> shortstring }
{ This should not compile - at least it does not compile under Delphi }
{ str_short := '';
@@ -65,8 +65,8 @@ Begin
str_short:=wc;
if str_short <> 'c' then
_result := false;}
-
-
+
+
if _result then
WriteLn('Success!')
else
@@ -78,7 +78,7 @@ Begin
{ empty string -> ansistring }
str_ansi := '';
if str_ansi <> '' then
- _result := false;
+ _result := false;
{ constant char -> ansistring }
str_ansi := 'c';
if str_ansi <> 'c' then
@@ -90,7 +90,7 @@ Begin
if str_ansi <> 'c' then
_result := false;
{* wide char *}
-{$ifdef haswidestring}
+{$ifdef haswidestring}
{ constant char -> ansistring }
str_ansi := widechar('c');
if str_ansi <> 'c' then
@@ -101,14 +101,14 @@ Begin
str_ansi:=wc;
if str_ansi <> 'c' then
_result := false;
-{$endif}
-
+{$endif}
+
if _result then
WriteLn('Success!')
else
fail;
{}
-{$ifdef haswidestring}
+{$ifdef haswidestring}
{********************** char/widechar -> widestring *******************}
Write('widechar/char -> widestring...');
{* normal char *}
@@ -116,7 +116,7 @@ Begin
{ empty string -> widestring }
str_wide := '';
if str_wide <> '' then
- _result := false;
+ _result := false;
{ constant char -> widestring }
str_wide := 'c';
if str_wide <> 'c' then
@@ -138,8 +138,8 @@ Begin
str_wide:=wc;
if str_wide <> 'c' then
_result := false;
-
-
+
+
if _result then
WriteLn('Success!')
else
diff --git a/tests/test/cg/tdivz1.pp b/tests/test/cg/tdivz1.pp
index 275459db9d..45b1111ac4 100644
--- a/tests/test/cg/tdivz1.pp
+++ b/tests/test/cg/tdivz1.pp
@@ -27,7 +27,7 @@ var
int64res : int64;
int64cnt : int64;
begin
-
+
{ RIGHT : LOC_REFERENCE }
{ LEFT : LOC_REGISTER }
int64res := 1;
@@ -36,7 +36,10 @@ begin
end.
{
$Log$
- Revision 1.1 2002-09-21 13:28:06 carl
+ Revision 1.2 2004-05-02 12:11:44 peter
+ * fixed linefeeds
+
+ Revision 1.1 2002/09/21 13:28:06 carl
+ division by zero testing
}
diff --git a/tests/test/cg/tdivz2.pp b/tests/test/cg/tdivz2.pp
index c040355b7f..c654a54951 100644
--- a/tests/test/cg/tdivz2.pp
+++ b/tests/test/cg/tdivz2.pp
@@ -25,14 +25,17 @@ var
longres : longint;
longcnt : longint;
begin
-
+
longres := 1;
longcnt := 0;
longres := longres div longcnt;
end.
{
$Log$
- Revision 1.1 2002-09-21 13:28:06 carl
+ Revision 1.2 2004-05-02 12:11:44 peter
+ * fixed linefeeds
+
+ Revision 1.1 2002/09/21 13:28:06 carl
+ division by zero testing
}
diff --git a/tests/test/cg/tpara1.pp b/tests/test/cg/tpara1.pp
new file mode 100644
index 0000000000..5aab052d53
--- /dev/null
+++ b/tests/test/cg/tpara1.pp
@@ -0,0 +1,17 @@
+function f(l1,l2,l3,l4,l5,l6,l7,l8:longint):longint;
+begin
+ f:=l1+l2+l3+l4+l5+l6+l7+l8;
+end;
+
+var
+ l : longint;
+begin
+ l:=f(f(1,2,3,4,5,6,7,8),f(1,2,3,4,5,6,7,8),f(1,2,3,4,5,6,7,8),f(1,2,3,4,5,6,7,8),f(1,2,3,4,5,6,7,8),f(1,2,3,4,5,6,7,8),f(1,2,3,4,5,6,7,8),f(1,2,3,4,5,6,7,8));
+ writeln('Got ',l,' expected ',8*(1+2+3+4+5+6+7+8));
+ if l<>8*(1+2+3+4+5+6+7+8) then
+ begin
+ writeln('Error!');
+ halt(1);
+ end;
+end.
+
diff --git a/tests/test/cg/treadwrt.pp b/tests/test/cg/treadwrt.pp
index 1237238c36..b5b1be0b88 100644
--- a/tests/test/cg/treadwrt.pp
+++ b/tests/test/cg/treadwrt.pp
@@ -10,7 +10,7 @@ var
value : longint;
begin
value:=1;
- getint64_1 := int64(value) shl 40;
+ getint64_1 := int64(value) shl 40;
end;
function getint64_2 : int64;
@@ -18,7 +18,7 @@ var
value : longint;
begin
value:=65535;
- getint64_2 := value;
+ getint64_2 := value;
end;
procedure test_rwtext;
@@ -65,7 +65,7 @@ begin
a := 'this is an ansistring';
writeln(a);
-
+
vl:=getint64_1;
vl1:=getint64_2;
writeln('int64 test : ',vl, ' ',vl1);
diff --git a/tests/test/cg/tshlshr.pp b/tests/test/cg/tshlshr.pp
index 7d1ce322a2..dc251f6818 100644
--- a/tests/test/cg/tshlshr.pp
+++ b/tests/test/cg/tshlshr.pp
@@ -251,7 +251,7 @@ Begin
int64res := int64res shl int64cnt;
Write('(SHL) Value should be -32768...');
test(int64res, -32768);
-
+
int64res := 1;
int64cnt := 33;
int64res := int64res shl int64cnt;
@@ -282,7 +282,7 @@ Begin
{ left : LOC_REFERENCE }
{ right : LOC_REGISRER }
-{
+{
WriteLn('(left) : LOC_REFERENCE; (right) : LOC_REGISTER');
int64res := 1;
bytecnt := -2;
@@ -317,14 +317,14 @@ Begin
int64res := int64res shr bytecnt;
Write('(SHR) Value should be 1...');
test(int64res, 1);
-
+
int64res := 1;
bytecnt := 33;
int64res := int64res shl bytecnt;
Write('(SHL) Value should be 2 in high longint (85899345)...');
move(int64res,int64rec, sizeof(int64));
test(int64rec.highval, 2);
-
+
{ int64res:=-1;
bytecnt := 15;
int64res := int64res shr bytecnt;
@@ -335,7 +335,10 @@ end.
{
$Log$
- Revision 1.7 2003-12-07 11:59:44 jonas
+ Revision 1.8 2004-05-02 12:11:44 peter
+ * fixed linefeeds
+
+ Revision 1.7 2003/12/07 11:59:44 jonas
* test procedure uses 64bit arguments under FPC
- disabled tests with negative shift counts (illegal)
diff --git a/tests/test/cg/tstr.pp b/tests/test/cg/tstr.pp
index bd8effc4b9..ba859755ed 100644
--- a/tests/test/cg/tstr.pp
+++ b/tests/test/cg/tstr.pp
@@ -64,7 +64,7 @@ begin
{ for more in-depth tests of str_real, see ../tstreal[1,2].pp }
f := -1.12345;
-{$IFOPT E-}
+{$IFOPT E-}
str(f,s);
if (sizeof(extended) = 10) or
(sizeof(extended) = 12) then
@@ -73,7 +73,7 @@ begin
check('-1.12345000000000E+000')
else
check('error, not yet implemented!!!!');
-{$endif}
+{$endif}
{ the number of exponents depends on the maaping of the real type }
if sizeof(real) = 8 then
begin
@@ -248,7 +248,7 @@ begin
{ for more in-depth tests of str_real, see ../tstreal[1,2].pp }
f := -1.12345;
-{$IFOPT E-}
+{$IFOPT E-}
str(f,s);
if (sizeof(extended) = 10) or
(sizeof(extended) = 12) then
@@ -257,7 +257,7 @@ begin
check('-1.12345000000000E+000')
else
check('error, not yet implemented!!!!');
-{$endif}
+{$endif}
{ the number of exponents depends on the maaping of the real type }
if sizeof(real) = 8 then
begin
@@ -433,7 +433,7 @@ begin
{ for more in-depth tests of str_real, see ../tstreal[1,2].pp }
f := -1.12345;
-{$IFOPT E-}
+{$IFOPT E-}
str(f,s);
if sizeof(extended) = 10 then
check('-1.123450000000000E+000')
@@ -441,7 +441,7 @@ begin
check('-1.12345000000000E+000')
else
check('error, not yet implemented!!!!');
-{$endif}
+{$endif}
{ the number of exponents depends on the maaping of the real type }
if sizeof(real) = 8 then
begin