diff --git a/tests/test/cg/tcalcla1.pp b/tests/test/cg/tcalcla1.pp index a89916b0db..8a24a3c6f3 100644 --- a/tests/test/cg/tcalcla1.pp +++ b/tests/test/cg/tcalcla1.pp @@ -1,4134 +1,4136 @@ -{****************************************************************} -{ 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 classes with conventional calling } -{ conventions. } -{ } -{ REMARKS: dynamic method testing does not test all cases, } -{ this is done because it is assumed that the code generator } -{ generates the same code for both dynamic and virtual methods } -{****************************************************************} -program tcalcla1; -{$STATIC ON} -{$mode objfpc} -{$R+} - - const - { should be defined depending on CPU target } - {$ifdef cpu68k} - BIG_INDEX = 8000; - SMALL_INDEX = 13; - {$endif} - {$ifdef cpu86} - 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 } - pnovmtclass = ^tnovmtclass; - tnovmtclass = class - public - object_bigstring : shortstring; - object_u16bit : word; - { no parameter testing } - procedure method_public_none; - class procedure method_public_static_none; - procedure method_call_private_none; - class procedure method_call_private_static_none; - { simple value parameter testing } - procedure method_public_u8(x : byte); - class procedure method_public_static_u8(x: byte); - procedure method_call_private_u8(x: byte); - class procedure method_call_private_static_u8(x: byte); - function func_array_mixed_nested(b: byte): tsmallarray; - private - procedure method_private_none; - class procedure method_private_static_none; - function func_getu16bit : word; - { simple value parameter testing } - procedure method_private_u8(x: byte); - class procedure method_private_static_u8(x: byte); - end; - - - { object with vmt } - pvmtclass = ^tvmtclass; - tvmtclass = class - 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); - 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;abstract; - procedure method_dynamic_params_mixed(u8 :byte; u16: word; - bigstring: shortstring; s32: longint; s64: int64);dynamic; - procedure method_dynamic_overriden_params_mixed(u8 :byte; u16: word; - bigstring: shortstring; s32: longint; s64: int64);dynamic;abstract; - class procedure method_static_params_mixed(u8 :byte; u16: word; - bigstring: shortstring; s32: longint; s64: int64); - procedure method_normal_call_inherited_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); - - { 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_destructor; virtual; - procedure method_virtual_call_inherited_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual; - - procedure method_dynamic_call_static_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);dynamic; - procedure method_dynamic_call_virtual_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);dynamic; - procedure method_dynamic_call_overriden_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);dynamic; - procedure method_dynamic_call_normal_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);dynamic; - procedure method_dynamic_call_constructor_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);dynamic; - procedure method_dynamic_call_destructor;dynamic; - procedure method_dynamic_call_inherited_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);dynamic; - - { message methods which contain self } - procedure method_message_params_mixed(self : tvmtclass; - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);message 0; - procedure method_message_call_virtual_params_mixed(self : tvmtclass; - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);message 1; - procedure method_message_call_normal_params_mixed(self : tvmtclass; - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);message 2; - procedure method_message_call_dynamic_params_mixed(self : tvmtclass; - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);message 3; - - end; - - pheritedvmtclass = ^theritedvmtclass; - theritedvmtclass = class(tvmtclass) - 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);override; - procedure method_dynamic_overriden_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);override; - - { normal methods which call other methods } - procedure method_normal_call_static_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); - procedure method_normal_call_virtual_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); - procedure method_normal_call_overriden_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); - procedure method_normal_call_normal_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); - procedure method_normal_call_constructor_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); - procedure method_normal_call_inherited_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); - - { virtual methods which call other methods } - procedure method_virtual_call_inherited_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);override; - - end; - - pfailvmtclass = ^tfailvmtclass; - tfailvmtclass = class(tvmtclass) - public - constructor constructor_public_none; - end; - - - -{**************************************************************************} -{ NO VMT OBJECT } -{**************************************************************************} - - {****************** NO PARAMETERS ******************} - procedure tnovmtclass.method_public_none; - begin - global_u8bit := RESULT_U8BIT; - end; - - - procedure tnovmtclass.method_public_static_none; - begin - global_u8bit := RESULT_U8BIT; - end; - - - procedure tnovmtclass.method_call_private_none; - begin - method_private_none; - method_private_static_none; - end; - - procedure tnovmtclass.method_call_private_static_none; - begin - method_private_static_none; - end; - - - procedure tnovmtclass.method_private_none; - begin - Inc(global_u16bit, RESULT_U8BIT); - end; - - - procedure tnovmtclass.method_private_static_none; - begin - Inc(global_u16bit, RESULT_U8BIT); - end; - - {******************** PARAMETERS ******************} - - procedure tnovmtclass.method_public_u8(x : byte); - begin - global_u8bit := x; - end; - - procedure tnovmtclass.method_public_static_u8(x: byte); - begin - global_u8bit := x; - end; - - procedure tnovmtclass.method_call_private_u8(x: byte); - begin - method_private_static_u8(x); - method_private_u8(x); - end; - - procedure tnovmtclass. method_call_private_static_u8(x: byte); - begin - method_private_static_u8(x); - end; - - procedure tnovmtclass.method_private_u8(x: byte); - begin - Inc(global_u16bit,x); - end; - - procedure tnovmtclass.method_private_static_u8(x: byte); - begin - Inc(global_u16bit,x); - end; - - - function tnovmtclass.func_getu16bit : word; - 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 tnovmtclass.func_array_mixed_nested(b: byte): tsmallarray; - - 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 tfailvmtclass.constructor_public_none; - begin - { this calls the constructor fail special keyword } - fail; - end; - -{**************************************************************************} -{ VMT OBJECT } -{**************************************************************************} -constructor tvmtclass.constructor_params_mixed(u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); - begin - inherited create; - object_u8bit := u8; - object_u16bit := u16; - object_bigstring := bigstring; - object_s32bit := s32; - object_s64bit := s64; - end; - - -constructor tvmtclass.constructor_init; - begin - inherited create; - object_u8bit := 0; - object_u16bit := 0; - object_bigstring := ''; - object_s32bit := 0; - object_s64bit := 0; - end; - -destructor tvmtclass.destructor_params_done; - begin - { this is used to call the destructor inside the class } - global_u8bit := object_u8bit; - global_u16bit := object_u16bit; - global_bigstring := object_bigstring; - global_s32bit := object_s32bit; - global_s64bit := object_s64bit; - object_u8bit := 0; - object_u16bit := 0; - object_bigstring := ''; - object_s32bit := 0; - object_s64bit := 0; - inherited destroy; - end; - - -procedure tvmtclass.method_normal_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 tvmtclass.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; - -procedure tvmtclass.method_dynamic_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; - - - -{ can't access field of instances in static methods } -procedure tvmtclass.method_static_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); - begin - global_u8bit := u8; - global_u16bit := u16; - global_bigstring := bigstring; - global_s32bit := s32; - global_s64bit := s64; - end; - -procedure tvmtclass.method_normal_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; - - -procedure tvmtclass.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 tvmtclass.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 tvmtclass.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 tvmtclass.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 tvmtclass.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 tvmtclass.method_virtual_call_destructor; - begin - destructor_params_done; - end; - - -procedure tvmtclass.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; - -{ dynamic methods } -procedure tvmtclass.method_dynamic_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 tvmtclass.method_dynamic_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 tvmtclass.method_dynamic_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 tvmtclass.method_dynamic_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 tvmtclass.method_dynamic_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 tvmtclass.method_dynamic_call_destructor; - begin - destructor_params_done; - end; - - -procedure tvmtclass.method_dynamic_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; - - (* message routines with self *) - procedure tvmtclass.method_message_params_mixed(self : tvmtclass; - 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 tvmtclass.method_message_call_virtual_params_mixed(self : tvmtclass; - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); - begin - method_virtual_params_mixed(u8, u16, bigstring, s32, s64); - end; - - procedure tvmtclass.method_message_call_normal_params_mixed(self : tvmtclass; - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); - begin - method_normal_params_mixed(u8, u16, bigstring, s32, s64); - end; - - procedure tvmtclass.method_message_call_dynamic_params_mixed(self : tvmtclass; - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); - begin - method_dynamic_params_mixed(u8, u16, bigstring, s32, s64); - end; - - - - -{**************************************************************************} -{ INHERITED VMT OBJECT } -{**************************************************************************} -constructor theritedvmtclass.constructor_params_mixed_call_virtual( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); - begin - inherited create; - 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 theritedvmtclass.constructor_params_mixed_call_overriden( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); - begin - inherited create; - 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 theritedvmtclass.constructor_params_mixed_call_static( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); - begin - inherited create; - 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 theritedvmtclass.constructor_params_mixed_call_normal( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); - begin - inherited create; - 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 theritedvmtclass.constructor_params_mixed_call_inherited - (u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); - begin - inherited create; - object_u8bit := 0; - object_u16bit := 0; - object_bigstring := ''; - object_s32bit := 0; - object_s64bit := 0; - inherited constructor_params_mixed(u8, u16, bigstring, s32, s64); - end; - -procedure theritedvmtclass.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 theritedvmtclass.method_dynamic_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 theritedvmtclass.method_normal_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 theritedvmtclass.method_normal_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 theritedvmtclass.method_normal_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 theritedvmtclass.method_normal_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 theritedvmtclass.method_normal_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 theritedvmtclass.method_normal_call_inherited_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); - begin - Inherited method_normal_call_inherited_params_mixed(u8, u16, bigstring, - s32, s64); - end; - -procedure theritedvmtclass.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 testnovmtclass; -var - novmtclass : tnovmtclass; - failed : boolean; -begin - {******************** STATIC / METHOD SIMPLE CALL **********************} - Write('No parameter / method call testing...'); - failed := false; - - novmtclass := tnovmtclass.create; - clear_globals; - clear_values; - - tnovmtclass.method_public_static_none; - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - novmtclass.method_public_static_none; - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - tnovmtclass.method_call_private_static_none; - if global_u16bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - novmtclass.method_call_private_static_none; - if global_u16bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - novmtclass.method_public_none; - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - novmtclass.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 } - novmtclass.method_public_u8(RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - tnovmtclass.method_public_static_u8(RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - novmtclass.method_public_static_u8(RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - novmtclass.method_call_private_u8(RESULT_U8BIT); - if global_u16bit <> (RESULT_U16BIT) then - failed := true; - - clear_globals; - clear_values; - - novmtclass.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; - novmtclass.method_public_u8(value_u8bit); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - value_u8bit := RESULT_U8BIT; - tnovmtclass.method_public_static_u8(value_u8bit); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - value_u8bit := RESULT_U8BIT; - novmtclass.method_public_static_u8(value_u8bit); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - value_u8bit := RESULT_U8BIT; - novmtclass.method_call_private_u8(value_u8bit); - if global_u16bit <> (RESULT_U16BIT) then - failed := true; - - clear_globals; - clear_values; - - value_u8bit := RESULT_U8BIT; - novmtclass.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; - - novmtclass.method_public_u8(getu8); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - tnovmtclass.method_public_static_u8(getu8); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - novmtclass.method_public_static_u8(getu8); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - novmtclass.method_call_private_u8(getu8); - if global_u16bit <> (RESULT_U16BIT) then - failed := true; - - clear_globals; - clear_values; - - novmtclass.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; - novmtclass.object_bigstring := RESULT_BIGSTRING; - novmtclass.object_u16bit := RESULT_U16BIT; - - value_smallarray := novmtclass.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!'); - - - novmtclass.destroy; -end; - - -procedure testfailedclass; -var - failedobject : tfailvmtclass; - begin - Write('Testing constructor return value...'); -{ if failedobject.constructor_public_none then - fail - else - Writeln('Passed!');} - end; - - - procedure testvmtclass; - var - vmtclass : tvmtclass; - failed : boolean; - begin - - clear_globals; - clear_values; - failed := false; - - Write('Testing mixed parameter (LOC_CONSTANT) constructor call...'); - vmtclass:=tvmtclass.constructor_params_mixed(RESULT_U8BIT, RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.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; - vmtclass := tvmtclass.constructor_params_mixed(value_u8bit, value_u16bit, value_bigstring, - value_s32bit, value_s64bit); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.destructor_params_done; - - if failed then - fail - else - Writeln('Passed!'); - - - (* Message method testing - - DON'T KNOW HOW TO CALL DIRECTLY - cannot test - Carl - - clear_globals; - clear_values; - failed := false; - - Write('Testing mixed parameter (LOC_CONSTANT) message call...'); - vmtclass := tvmtclass.constructor_init; - vmtclass.method_message_params_mixed(vmtclass, - RESULT_U8BIT, RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.destructor_params_done; - - if failed then - fail - else - Writeln('Passed!'); - - clear_globals; - clear_values; - failed := false; - - Write('Testing mixed parameter (LOC_REFERENCE) message call...'); - value_u8bit := RESULT_U8BIT; - value_u16bit := RESULT_U16BIT; - value_bigstring := RESULT_BIGSTRING; - value_s32bit := RESULT_S32BIT; - value_s64bit := RESULT_S64BIT; - vmtclass := tvmtclass.constructor_init; - vmtclass.method_message_params_mixed(vmtclass - ,value_u8bit, value_u16bit, value_bigstring, value_s32bit, - value_s64bit); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.destructor_params_done; - - if failed then - fail - else - Writeln('Passed!'); - procedure tvmtclass.method_message_params_mixed(self : tvmtclass; - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); - procedure tvmtclass.method_message_call_virtual_params_mixed(self : tvmtclass; - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); - procedure tvmtclass.method_message_call_normal_params_mixed(self : tvmtclass; - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); - procedure tvmtclass.method_message_call_dynamic_params_mixed(self : tvmtclass; - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); -*) - end; - - - procedure testheritedvmtclass; - var - vmtclass : theritedvmtclass; - failed : boolean; - begin - {********************** CONSTRUCTOR TESTING ************************} - {********************** DESTRUCTOR TESTING ************************} - clear_globals; - clear_values; - failed := false; - - Write('Testing mixed parameter (LOC_CONSTANT) inherited constructor call...'); - vmtclass := theritedvmtclass.constructor_params_mixed_call_inherited(RESULT_U8BIT, RESULT_U16BIT, RESULT_BIGSTRING, - RESULT_S32BIT, RESULT_S64BIT); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.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; - vmtclass := theritedvmtclass.constructor_params_mixed_call_inherited(value_u8bit, - value_u16bit, value_bigstring, value_s32bit, value_s64bit); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.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...'); - vmtclass := theritedvmtclass.constructor_params_mixed_call_virtual(RESULT_U8BIT, - RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.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; - vmtclass:=theritedvmtclass.constructor_params_mixed_call_virtual(value_u8bit, - value_u16bit, value_bigstring, value_s32bit, value_s64bit); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.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...'); - vmtclass:=theritedvmtclass.constructor_params_mixed_call_overriden(RESULT_U8BIT, - RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.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; - vmtclass:=theritedvmtclass.constructor_params_mixed_call_overriden(value_u8bit, - value_u16bit, value_bigstring, value_s32bit, value_s64bit); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.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...'); - vmtclass:=theritedvmtclass.constructor_params_mixed_call_normal(RESULT_U8BIT, - RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.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; - vmtclass:=theritedvmtclass.constructor_params_mixed_call_normal(value_u8bit, - value_u16bit, value_bigstring, value_s32bit, value_s64bit); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.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...'); - vmtclass:=theritedvmtclass.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; - vmtclass.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; - vmtclass:=theritedvmtclass.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; - vmtclass.destructor_params_done; - - if failed then - fail - else - Writeln('Passed!'); - - {************************* METHOD TESTING **************************} - clear_globals; - clear_values; - failed := false; - - vmtclass:=theritedvmtclass.constructor_init; - Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...'); - vmtclass.method_virtual_params_mixed(RESULT_U8BIT, - RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.destructor_params_done; - - if failed then - fail - else - Writeln('Passed!'); - - clear_globals; - clear_values; - failed := false; - - vmtclass:=theritedvmtclass.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; - vmtclass.method_virtual_params_mixed(value_u8bit, - value_u16bit, value_bigstring, value_s32bit, value_s64bit); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.destructor_params_done; - - if failed then - fail - else - Writeln('Passed!'); - - clear_globals; - clear_values; - failed := false; - - vmtclass:=theritedvmtclass.constructor_init; - Write('Testing mixed parameter (LOC_CONSTANT) dynamic method call...'); - vmtclass.method_dynamic_params_mixed(RESULT_U8BIT, - RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.destructor_params_done; - - if failed then - fail - else - Writeln('Passed!'); - - clear_globals; - clear_values; - failed := false; - - vmtclass:=theritedvmtclass.constructor_init; - Write('Testing mixed parameter (LOC_CONSTANT) dynamic method call...'); - vmtclass.method_dynamic_overriden_params_mixed(RESULT_U8BIT, - RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.destructor_params_done; - - if failed then - fail - else - Writeln('Passed!'); - - clear_globals; - clear_values; - failed := false; - - vmtclass:=theritedvmtclass.constructor_init; - Write('Testing mixed parameter (LOC_REFERENCE) dynamic method call...'); - value_u8bit := RESULT_U8BIT; - value_u16bit := RESULT_U16BIT; - value_bigstring := RESULT_BIGSTRING; - value_s32bit := RESULT_S32BIT; - value_s64bit := RESULT_S64BIT; - vmtclass.method_dynamic_overriden_params_mixed(value_u8bit, - value_u16bit, value_bigstring, value_s32bit, value_s64bit); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.destructor_params_done; - - if failed then - fail - else - Writeln('Passed!'); - - clear_globals; - clear_values; - failed := false; - - vmtclass:=theritedvmtclass.constructor_init; - Write('Testing mixed parameter (LOC_REFERENCE) dynamic method call...'); - value_u8bit := RESULT_U8BIT; - value_u16bit := RESULT_U16BIT; - value_bigstring := RESULT_BIGSTRING; - value_s32bit := RESULT_S32BIT; - value_s64bit := RESULT_S64BIT; - vmtclass.method_dynamic_params_mixed(value_u8bit, - value_u16bit, value_bigstring, value_s32bit, value_s64bit); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.destructor_params_done; - - if failed then - fail - else - Writeln('Passed!'); - - - clear_globals; - clear_values; - failed := false; - - vmtclass:=theritedvmtclass.constructor_init; - Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...'); - vmtclass.method_virtual_overriden_params_mixed(RESULT_U8BIT, - RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.destructor_params_done; - - if failed then - fail - else - Writeln('Passed!'); - - clear_globals; - clear_values; - failed := false; - - vmtclass:=theritedvmtclass.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; - vmtclass.method_virtual_overriden_params_mixed(value_u8bit, - value_u16bit, value_bigstring, value_s32bit, value_s64bit); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.destructor_params_done; - - if failed then - fail - else - Writeln('Passed!'); - - clear_globals; - clear_values; - failed := false; - - vmtclass:=theritedvmtclass.constructor_init; - Write('Testing mixed parameter (LOC_CONSTANT) method call...'); - vmtclass.method_normal_params_mixed(RESULT_U8BIT, - RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.destructor_params_done; - - if failed then - fail - else - Writeln('Passed!'); - - clear_globals; - clear_values; - failed := false; - - vmtclass:=theritedvmtclass.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; - vmtclass.method_normal_params_mixed(value_u8bit, - value_u16bit, value_bigstring, value_s32bit, value_s64bit); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.destructor_params_done; - - if failed then - fail - else - Writeln('Passed!'); - - clear_globals; - clear_values; - failed := false; - - vmtclass:=theritedvmtclass.constructor_init; - Write('Testing mixed parameter (LOC_CONSTANT) static method call...'); - vmtclass.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; - vmtclass.destructor_params_done; - - if failed then - fail - else - Writeln('Passed!'); - - clear_globals; - clear_values; - failed := false; - - vmtclass:=theritedvmtclass.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; - vmtclass.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; - vmtclass.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 } - vmtclass:=theritedvmtclass.constructor_init; - Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...'); - vmtclass.method_normal_call_virtual_params_mixed(RESULT_U8BIT, - RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.destructor_params_done; - - if failed then - fail - else - Writeln('Passed!'); - - clear_globals; - clear_values; - failed := false; - - vmtclass:=theritedvmtclass.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; - vmtclass.method_normal_call_virtual_params_mixed(value_u8bit, - value_u16bit, value_bigstring, value_s32bit, value_s64bit); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.destructor_params_done; - - if failed then - fail - else - Writeln('Passed!'); - - { The virtual method has been overriden by the object in this case } - vmtclass:=theritedvmtclass.constructor_init; - Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...'); - vmtclass.method_normal_call_overriden_params_mixed(RESULT_U8BIT, - RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.destructor_params_done; - - if failed then - fail - else - Writeln('Passed!'); - - clear_globals; - clear_values; - failed := false; - - vmtclass:=theritedvmtclass.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; - vmtclass.method_normal_call_overriden_params_mixed(value_u8bit, - value_u16bit, value_bigstring, value_s32bit, value_s64bit); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.destructor_params_done; - - if failed then - fail - else - Writeln('Passed!'); - - clear_globals; - clear_values; - failed := false; - - vmtclass:=theritedvmtclass.constructor_init; - Write('Testing mixed parameter (LOC_CONSTANT) method call w/normal call...'); - vmtclass.method_normal_call_normal_params_mixed(RESULT_U8BIT, - RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.destructor_params_done; - - if failed then - fail - else - Writeln('Passed!'); - - clear_globals; - clear_values; - failed := false; - - vmtclass:=theritedvmtclass.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; - vmtclass.method_normal_call_normal_params_mixed(value_u8bit, - value_u16bit, value_bigstring, value_s32bit, value_s64bit); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.destructor_params_done; - - if failed then - fail - else - Writeln('Passed!'); - - (* constructor call inside a normal method *) - - clear_globals; - clear_values; - failed := false; - - vmtclass:=theritedvmtclass.constructor_init; - Write('Testing mixed parameter (LOC_CONSTANT) method call w/constructor call...'); - vmtclass.method_normal_call_constructor_params_mixed(RESULT_U8BIT, - RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.destructor_params_done; - - if failed then - fail - else - Writeln('Passed!'); - - clear_globals; - clear_values; - failed := false; - - vmtclass:=theritedvmtclass.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; - vmtclass.method_normal_call_constructor_params_mixed(value_u8bit, - value_u16bit, value_bigstring, value_s32bit, value_s64bit); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.destructor_params_done; - - if failed then - fail - else - Writeln('Passed!'); - - { static method call } - clear_globals; - clear_values; - failed := false; - - vmtclass:=theritedvmtclass.constructor_init; - Write('Testing mixed parameter (LOC_CONSTANT) method call w/static call...'); - vmtclass.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; - vmtclass.destructor_params_done; - - if failed then - fail - else - Writeln('Passed!'); - - clear_globals; - clear_values; - failed := false; - - vmtclass:=theritedvmtclass.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; - vmtclass.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; - vmtclass.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 } - vmtclass:=theritedvmtclass.constructor_init; - Write('Testing mixed parameter (LOC_CONSTANT) method call w/inherited call...'); - vmtclass.method_normal_call_inherited_params_mixed(RESULT_U8BIT, - RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.destructor_params_done; - - if failed then - fail - else - Writeln('Passed!'); - - clear_globals; - clear_values; - failed := false; - - vmtclass:=theritedvmtclass.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; - vmtclass.method_normal_call_inherited_params_mixed(value_u8bit, - value_u16bit, value_bigstring, value_s32bit, value_s64bit); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.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 } - vmtclass:=theritedvmtclass.constructor_init; - Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...'); - vmtclass.method_virtual_call_virtual_params_mixed(RESULT_U8BIT, - RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.destructor_params_done; - - if failed then - fail - else - Writeln('Passed!'); - - clear_globals; - clear_values; - failed := false; - - vmtclass:=theritedvmtclass.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; - vmtclass.method_virtual_call_virtual_params_mixed(value_u8bit, - value_u16bit, value_bigstring, value_s32bit, value_s64bit); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.destructor_params_done; - - if failed then - fail - else - Writeln('Passed!'); - - { The virtual method has been overriden by the object in this case } - vmtclass:=theritedvmtclass.constructor_init; - Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...'); - vmtclass.method_virtual_call_overriden_params_mixed(RESULT_U8BIT, - RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.destructor_params_done; - - if failed then - fail - else - Writeln('Passed!'); - - clear_globals; - clear_values; - failed := false; - - vmtclass:=theritedvmtclass.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; - vmtclass.method_virtual_call_overriden_params_mixed(value_u8bit, - value_u16bit, value_bigstring, value_s32bit, value_s64bit); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.destructor_params_done; - - if failed then - fail - else - Writeln('Passed!'); - - clear_globals; - clear_values; - failed := false; - - vmtclass:=theritedvmtclass.constructor_init; - Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/normal call...'); - vmtclass.method_virtual_call_normal_params_mixed(RESULT_U8BIT, - RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.destructor_params_done; - - if failed then - fail - else - Writeln('Passed!'); - - clear_globals; - clear_values; - failed := false; - - vmtclass:=theritedvmtclass.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; - vmtclass.method_virtual_call_normal_params_mixed(value_u8bit, - value_u16bit, value_bigstring, value_s32bit, value_s64bit); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.destructor_params_done; - - if failed then - fail - else - Writeln('Passed!'); - - (* destructor call inside a normal method *) - clear_globals; - clear_values; - failed := false; - - vmtclass:=theritedvmtclass.constructor_params_mixed(RESULT_U8BIT, - RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); - Write('Testing virtual call w/destructor call...'); - vmtclass.method_virtual_call_destructor; - 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; - vmtclass.destructor_params_done; - - if failed then - fail - else - Writeln('Passed!'); - - - (* constructor call inside a normal method *) - - clear_globals; - clear_values; - failed := false; - - vmtclass:=theritedvmtclass.constructor_init; - Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/constructor call...'); - vmtclass.method_virtual_call_constructor_params_mixed(RESULT_U8BIT, - RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.destructor_params_done; - - if failed then - fail - else - Writeln('Passed!'); - - clear_globals; - clear_values; - failed := false; - - vmtclass:=theritedvmtclass.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; - vmtclass.method_virtual_call_constructor_params_mixed(value_u8bit, - value_u16bit, value_bigstring, value_s32bit, value_s64bit); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.destructor_params_done; - - if failed then - fail - else - Writeln('Passed!'); - - (* static virtual call *) - clear_globals; - clear_values; - failed := false; - - vmtclass:=theritedvmtclass.constructor_init; - Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/static call...'); - vmtclass.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; - vmtclass.destructor_params_done; - - if failed then - fail - else - Writeln('Passed!'); - - clear_globals; - clear_values; - failed := false; - - vmtclass:=theritedvmtclass.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; - vmtclass.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; - vmtclass.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 } - vmtclass:=theritedvmtclass.constructor_init; - Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/inherited call...'); - vmtclass.method_virtual_call_inherited_params_mixed(RESULT_U8BIT, - RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.destructor_params_done; - - if failed then - fail - else - Writeln('Passed!'); - - clear_globals; - clear_values; - failed := false; - - vmtclass:=theritedvmtclass.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; - vmtclass.method_virtual_call_inherited_params_mixed(value_u8bit, - value_u16bit, value_bigstring, value_s32bit, value_s64bit); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.destructor_params_done; - - if failed then - fail - else - Writeln('Passed!'); - - (* dynamic call testing *) - clear_globals; - clear_values; - failed := false; - - vmtclass:=theritedvmtclass.constructor_init; - Write('Testing mixed parameter (LOC_CONSTANT) dynamic call w/constructor call...'); - vmtclass.method_dynamic_call_constructor_params_mixed(RESULT_U8BIT, - RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.destructor_params_done; - - if failed then - fail - else - Writeln('Passed!'); - - clear_globals; - clear_values; - failed := false; - - vmtclass:=theritedvmtclass.constructor_init; - Write('Testing mixed parameter (LOC_REFERENCE) dynamic call w/constructor call...'); - value_u8bit := RESULT_U8BIT; - value_u16bit := RESULT_U16BIT; - value_bigstring := RESULT_BIGSTRING; - value_s32bit := RESULT_S32BIT; - value_s64bit := RESULT_S64BIT; - vmtclass.method_dynamic_call_constructor_params_mixed(value_u8bit, - value_u16bit, value_bigstring, value_s32bit, value_s64bit); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.destructor_params_done; - - if failed then - fail - else - Writeln('Passed!'); - - (* static virtual call *) - clear_globals; - clear_values; - failed := false; - - vmtclass:=theritedvmtclass.constructor_init; - Write('Testing mixed parameter (LOC_CONSTANT) dynamic call w/static call...'); - vmtclass.method_dynamic_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; - vmtclass.destructor_params_done; - - if failed then - fail - else - Writeln('Passed!'); - - clear_globals; - clear_values; - failed := false; - - vmtclass:=theritedvmtclass.constructor_init; - Write('Testing mixed parameter (LOC_REFERENCE) dynamic call w/static call...'); - value_u8bit := RESULT_U8BIT; - value_u16bit := RESULT_U16BIT; - value_bigstring := RESULT_BIGSTRING; - value_s32bit := RESULT_S32BIT; - value_s64bit := RESULT_S64BIT; - vmtclass.method_dynamic_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; - vmtclass.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 } - vmtclass:=theritedvmtclass.constructor_init; - Write('Testing mixed parameter (LOC_CONSTANT) dynamic call w/inherited call...'); - vmtclass.method_dynamic_call_inherited_params_mixed(RESULT_U8BIT, - RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.destructor_params_done; - - if failed then - fail - else - Writeln('Passed!'); - - clear_globals; - clear_values; - failed := false; - - vmtclass:=theritedvmtclass.constructor_init; - Write('Testing mixed parameter (LOC_REFERENCE) dynamic call w/inherited call...'); - value_u8bit := RESULT_U8BIT; - value_u16bit := RESULT_U16BIT; - value_bigstring := RESULT_BIGSTRING; - value_s32bit := RESULT_S32BIT; - value_s64bit := RESULT_S64BIT; - vmtclass.method_dynamic_call_inherited_params_mixed(value_u8bit, - value_u16bit, value_bigstring, value_s32bit, value_s64bit); - if vmtclass.object_u8bit <> RESULT_U8BIT then - failed := true; - if vmtclass.object_u16bit <> RESULT_U16BIT then - failed := true; - if vmtclass.object_s32bit <> RESULT_S32BIT then - failed := true; - if vmtclass.object_s64bit <> RESULT_S64BIT then - failed := true; - if vmtclass.object_bigstring <> RESULT_BIGSTRING then - failed := true; - vmtclass.destructor_params_done; - - if failed then - fail - else - Writeln('Passed!'); - end; - -procedure testwith; - var - vmtclass : theritedvmtclass; - failed : boolean; - begin - with vmtclass do - begin - - {********************** CONSTRUCTOR TESTING ************************} - {********************** DESTRUCTOR TESTING ************************} - clear_globals; - clear_values; - failed := false; - - Write('Testing mixed parameter (LOC_CONSTANT) inherited constructor call...'); - vmtclass := theritedvmtclass.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; - vmtclass := theritedvmtclass.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...'); - vmtclass := theritedvmtclass.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; - vmtclass:=theritedvmtclass.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...'); - vmtclass:=theritedvmtclass.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; - vmtclass:=theritedvmtclass.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...'); - vmtclass:=theritedvmtclass.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; - vmtclass:=theritedvmtclass.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...'); - vmtclass:=theritedvmtclass.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; - vmtclass:=theritedvmtclass.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; - - vmtclass:=theritedvmtclass.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; - - vmtclass:=theritedvmtclass.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; - - vmtclass:=theritedvmtclass.constructor_init; - Write('Testing mixed parameter (LOC_CONSTANT) dynamic method call...'); - method_dynamic_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; - - vmtclass:=theritedvmtclass.constructor_init; - Write('Testing mixed parameter (LOC_CONSTANT) dynamic method call...'); - method_dynamic_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; - - vmtclass:=theritedvmtclass.constructor_init; - Write('Testing mixed parameter (LOC_REFERENCE) dynamic method call...'); - value_u8bit := RESULT_U8BIT; - value_u16bit := RESULT_U16BIT; - value_bigstring := RESULT_BIGSTRING; - value_s32bit := RESULT_S32BIT; - value_s64bit := RESULT_S64BIT; - method_dynamic_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; - - vmtclass:=theritedvmtclass.constructor_init; - Write('Testing mixed parameter (LOC_REFERENCE) dynamic method call...'); - value_u8bit := RESULT_U8BIT; - value_u16bit := RESULT_U16BIT; - value_bigstring := RESULT_BIGSTRING; - value_s32bit := RESULT_S32BIT; - value_s64bit := RESULT_S64BIT; - method_dynamic_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; - - vmtclass:=theritedvmtclass.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; - - vmtclass:=theritedvmtclass.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; - - vmtclass:=theritedvmtclass.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; - - vmtclass:=theritedvmtclass.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; - - vmtclass:=theritedvmtclass.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; - - vmtclass:=theritedvmtclass.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 } - vmtclass:=theritedvmtclass.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; - - vmtclass:=theritedvmtclass.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 } - vmtclass:=theritedvmtclass.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; - - vmtclass:=theritedvmtclass.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; - - vmtclass:=theritedvmtclass.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; - - vmtclass:=theritedvmtclass.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; - - vmtclass:=theritedvmtclass.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; - - vmtclass:=theritedvmtclass.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; - - vmtclass:=theritedvmtclass.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; - - vmtclass:=theritedvmtclass.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 } - vmtclass:=theritedvmtclass.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; - - vmtclass:=theritedvmtclass.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 } - vmtclass:=theritedvmtclass.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; - - vmtclass:=theritedvmtclass.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 } - vmtclass:=theritedvmtclass.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; - - vmtclass:=theritedvmtclass.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; - - vmtclass:=theritedvmtclass.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; - - vmtclass:=theritedvmtclass.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!'); - - (* destructor call inside a normal method *) - clear_globals; - clear_values; - failed := false; - - vmtclass:=theritedvmtclass.constructor_params_mixed(RESULT_U8BIT, - RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); - Write('Testing virtual call w/destructor call...'); - method_virtual_call_destructor; - 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!'); - - - (* constructor call inside a normal method *) - - clear_globals; - clear_values; - failed := false; - - vmtclass:=theritedvmtclass.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; - - vmtclass:=theritedvmtclass.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; - - vmtclass:=theritedvmtclass.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; - - vmtclass:=theritedvmtclass.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 } - vmtclass:=theritedvmtclass.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; - - vmtclass:=theritedvmtclass.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!'); - - (* dynamic call testing *) - clear_globals; - clear_values; - failed := false; - - vmtclass:=theritedvmtclass.constructor_init; - Write('Testing mixed parameter (LOC_CONSTANT) dynamic call w/constructor call...'); - method_dynamic_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; - - vmtclass:=theritedvmtclass.constructor_init; - Write('Testing mixed parameter (LOC_REFERENCE) dynamic 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_dynamic_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; - - vmtclass:=theritedvmtclass.constructor_init; - Write('Testing mixed parameter (LOC_CONSTANT) dynamic call w/static call...'); - method_dynamic_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; - - vmtclass:=theritedvmtclass.constructor_init; - Write('Testing mixed parameter (LOC_REFERENCE) dynamic 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_dynamic_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 } - vmtclass:=theritedvmtclass.constructor_init; - Write('Testing mixed parameter (LOC_CONSTANT) dynamic call w/inherited call...'); - method_dynamic_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; - - vmtclass:=theritedvmtclass.constructor_init; - Write('Testing mixed parameter (LOC_REFERENCE) dynamic 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_dynamic_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('*********************** CLASS TESTS ***********************'); - testnovmtclass; -{ WriteLN('************************ VMT OBJECT FAIL **********************'); - testfailedclass;} - testvmtclass; - testheritedvmtclass; - WriteLN('*******************CLASS 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 classes with conventional calling } +{ conventions. } +{ } +{ REMARKS: dynamic method testing does not test all cases, } +{ this is done because it is assumed that the code generator } +{ generates the same code for both dynamic and virtual methods } +{****************************************************************} +program tcalcla1; +{$STATIC ON} +{$mode objfpc} +{$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 } + pnovmtclass = ^tnovmtclass; + tnovmtclass = class + public + object_bigstring : shortstring; + object_u16bit : word; + { no parameter testing } + procedure method_public_none; + class procedure method_public_static_none; + procedure method_call_private_none; + class procedure method_call_private_static_none; + { simple value parameter testing } + procedure method_public_u8(x : byte); + class procedure method_public_static_u8(x: byte); + procedure method_call_private_u8(x: byte); + class procedure method_call_private_static_u8(x: byte); + function func_array_mixed_nested(b: byte): tsmallarray; + private + procedure method_private_none; + class procedure method_private_static_none; + function func_getu16bit : word; + { simple value parameter testing } + procedure method_private_u8(x: byte); + class procedure method_private_static_u8(x: byte); + end; + + + { object with vmt } + pvmtclass = ^tvmtclass; + tvmtclass = class + 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); + 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;abstract; + procedure method_dynamic_params_mixed(u8 :byte; u16: word; + bigstring: shortstring; s32: longint; s64: int64);dynamic; + procedure method_dynamic_overriden_params_mixed(u8 :byte; u16: word; + bigstring: shortstring; s32: longint; s64: int64);dynamic;abstract; + class procedure method_static_params_mixed(u8 :byte; u16: word; + bigstring: shortstring; s32: longint; s64: int64); + procedure method_normal_call_inherited_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); + + { 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_destructor; virtual; + procedure method_virtual_call_inherited_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual; + + procedure method_dynamic_call_static_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);dynamic; + procedure method_dynamic_call_virtual_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);dynamic; + procedure method_dynamic_call_overriden_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);dynamic; + procedure method_dynamic_call_normal_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);dynamic; + procedure method_dynamic_call_constructor_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);dynamic; + procedure method_dynamic_call_destructor;dynamic; + procedure method_dynamic_call_inherited_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);dynamic; + + { message methods which contain self } + procedure method_message_params_mixed(self : tvmtclass; + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);message 0; + procedure method_message_call_virtual_params_mixed(self : tvmtclass; + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);message 1; + procedure method_message_call_normal_params_mixed(self : tvmtclass; + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);message 2; + procedure method_message_call_dynamic_params_mixed(self : tvmtclass; + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);message 3; + + end; + + pheritedvmtclass = ^theritedvmtclass; + theritedvmtclass = class(tvmtclass) + 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);override; + procedure method_dynamic_overriden_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);override; + + { normal methods which call other methods } + procedure method_normal_call_static_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); + procedure method_normal_call_virtual_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); + procedure method_normal_call_overriden_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); + procedure method_normal_call_normal_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); + procedure method_normal_call_constructor_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); + procedure method_normal_call_inherited_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); + + { virtual methods which call other methods } + procedure method_virtual_call_inherited_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);override; + + end; + + pfailvmtclass = ^tfailvmtclass; + tfailvmtclass = class(tvmtclass) + public + constructor constructor_public_none; + end; + + + +{**************************************************************************} +{ NO VMT OBJECT } +{**************************************************************************} + + {****************** NO PARAMETERS ******************} + procedure tnovmtclass.method_public_none; + begin + global_u8bit := RESULT_U8BIT; + end; + + + procedure tnovmtclass.method_public_static_none; + begin + global_u8bit := RESULT_U8BIT; + end; + + + procedure tnovmtclass.method_call_private_none; + begin + method_private_none; + method_private_static_none; + end; + + procedure tnovmtclass.method_call_private_static_none; + begin + method_private_static_none; + end; + + + procedure tnovmtclass.method_private_none; + begin + Inc(global_u16bit, RESULT_U8BIT); + end; + + + procedure tnovmtclass.method_private_static_none; + begin + Inc(global_u16bit, RESULT_U8BIT); + end; + + {******************** PARAMETERS ******************} + + procedure tnovmtclass.method_public_u8(x : byte); + begin + global_u8bit := x; + end; + + procedure tnovmtclass.method_public_static_u8(x: byte); + begin + global_u8bit := x; + end; + + procedure tnovmtclass.method_call_private_u8(x: byte); + begin + method_private_static_u8(x); + method_private_u8(x); + end; + + procedure tnovmtclass. method_call_private_static_u8(x: byte); + begin + method_private_static_u8(x); + end; + + procedure tnovmtclass.method_private_u8(x: byte); + begin + Inc(global_u16bit,x); + end; + + procedure tnovmtclass.method_private_static_u8(x: byte); + begin + Inc(global_u16bit,x); + end; + + + function tnovmtclass.func_getu16bit : word; + 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 tnovmtclass.func_array_mixed_nested(b: byte): tsmallarray; + + 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 tfailvmtclass.constructor_public_none; + begin + { this calls the constructor fail special keyword } + fail; + end; + +{**************************************************************************} +{ VMT OBJECT } +{**************************************************************************} +constructor tvmtclass.constructor_params_mixed(u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); + begin + inherited create; + object_u8bit := u8; + object_u16bit := u16; + object_bigstring := bigstring; + object_s32bit := s32; + object_s64bit := s64; + end; + + +constructor tvmtclass.constructor_init; + begin + inherited create; + object_u8bit := 0; + object_u16bit := 0; + object_bigstring := ''; + object_s32bit := 0; + object_s64bit := 0; + end; + +destructor tvmtclass.destructor_params_done; + begin + { this is used to call the destructor inside the class } + global_u8bit := object_u8bit; + global_u16bit := object_u16bit; + global_bigstring := object_bigstring; + global_s32bit := object_s32bit; + global_s64bit := object_s64bit; + object_u8bit := 0; + object_u16bit := 0; + object_bigstring := ''; + object_s32bit := 0; + object_s64bit := 0; + inherited destroy; + end; + + +procedure tvmtclass.method_normal_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 tvmtclass.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; + +procedure tvmtclass.method_dynamic_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; + + + +{ can't access field of instances in static methods } +procedure tvmtclass.method_static_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); + begin + global_u8bit := u8; + global_u16bit := u16; + global_bigstring := bigstring; + global_s32bit := s32; + global_s64bit := s64; + end; + +procedure tvmtclass.method_normal_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; + + +procedure tvmtclass.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 tvmtclass.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 tvmtclass.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 tvmtclass.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 tvmtclass.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 tvmtclass.method_virtual_call_destructor; + begin + destructor_params_done; + end; + + +procedure tvmtclass.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; + +{ dynamic methods } +procedure tvmtclass.method_dynamic_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 tvmtclass.method_dynamic_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 tvmtclass.method_dynamic_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 tvmtclass.method_dynamic_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 tvmtclass.method_dynamic_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 tvmtclass.method_dynamic_call_destructor; + begin + destructor_params_done; + end; + + +procedure tvmtclass.method_dynamic_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; + + (* message routines with self *) + procedure tvmtclass.method_message_params_mixed(self : tvmtclass; + 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 tvmtclass.method_message_call_virtual_params_mixed(self : tvmtclass; + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); + begin + method_virtual_params_mixed(u8, u16, bigstring, s32, s64); + end; + + procedure tvmtclass.method_message_call_normal_params_mixed(self : tvmtclass; + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); + begin + method_normal_params_mixed(u8, u16, bigstring, s32, s64); + end; + + procedure tvmtclass.method_message_call_dynamic_params_mixed(self : tvmtclass; + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); + begin + method_dynamic_params_mixed(u8, u16, bigstring, s32, s64); + end; + + + + +{**************************************************************************} +{ INHERITED VMT OBJECT } +{**************************************************************************} +constructor theritedvmtclass.constructor_params_mixed_call_virtual( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); + begin + inherited create; + 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 theritedvmtclass.constructor_params_mixed_call_overriden( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); + begin + inherited create; + 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 theritedvmtclass.constructor_params_mixed_call_static( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); + begin + inherited create; + 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 theritedvmtclass.constructor_params_mixed_call_normal( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); + begin + inherited create; + 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 theritedvmtclass.constructor_params_mixed_call_inherited + (u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); + begin + inherited create; + object_u8bit := 0; + object_u16bit := 0; + object_bigstring := ''; + object_s32bit := 0; + object_s64bit := 0; + inherited constructor_params_mixed(u8, u16, bigstring, s32, s64); + end; + +procedure theritedvmtclass.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 theritedvmtclass.method_dynamic_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 theritedvmtclass.method_normal_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 theritedvmtclass.method_normal_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 theritedvmtclass.method_normal_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 theritedvmtclass.method_normal_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 theritedvmtclass.method_normal_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 theritedvmtclass.method_normal_call_inherited_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); + begin + Inherited method_normal_call_inherited_params_mixed(u8, u16, bigstring, + s32, s64); + end; + +procedure theritedvmtclass.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 testnovmtclass; +var + novmtclass : tnovmtclass; + failed : boolean; +begin + {******************** STATIC / METHOD SIMPLE CALL **********************} + Write('No parameter / method call testing...'); + failed := false; + + novmtclass := tnovmtclass.create; + clear_globals; + clear_values; + + tnovmtclass.method_public_static_none; + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + novmtclass.method_public_static_none; + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + tnovmtclass.method_call_private_static_none; + if global_u16bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + novmtclass.method_call_private_static_none; + if global_u16bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + novmtclass.method_public_none; + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + novmtclass.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 } + novmtclass.method_public_u8(RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + tnovmtclass.method_public_static_u8(RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + novmtclass.method_public_static_u8(RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + novmtclass.method_call_private_u8(RESULT_U8BIT); + if global_u16bit <> (RESULT_U16BIT) then + failed := true; + + clear_globals; + clear_values; + + novmtclass.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; + novmtclass.method_public_u8(value_u8bit); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + value_u8bit := RESULT_U8BIT; + tnovmtclass.method_public_static_u8(value_u8bit); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + value_u8bit := RESULT_U8BIT; + novmtclass.method_public_static_u8(value_u8bit); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + value_u8bit := RESULT_U8BIT; + novmtclass.method_call_private_u8(value_u8bit); + if global_u16bit <> (RESULT_U16BIT) then + failed := true; + + clear_globals; + clear_values; + + value_u8bit := RESULT_U8BIT; + novmtclass.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; + + novmtclass.method_public_u8(getu8); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + tnovmtclass.method_public_static_u8(getu8); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + novmtclass.method_public_static_u8(getu8); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + novmtclass.method_call_private_u8(getu8); + if global_u16bit <> (RESULT_U16BIT) then + failed := true; + + clear_globals; + clear_values; + + novmtclass.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; + novmtclass.object_bigstring := RESULT_BIGSTRING; + novmtclass.object_u16bit := RESULT_U16BIT; + + value_smallarray := novmtclass.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!'); + + + novmtclass.destroy; +end; + + +procedure testfailedclass; +var + failedobject : tfailvmtclass; + begin + Write('Testing constructor return value...'); +{ if failedobject.constructor_public_none then + fail + else + Writeln('Passed!');} + end; + + + procedure testvmtclass; + var + vmtclass : tvmtclass; + failed : boolean; + begin + + clear_globals; + clear_values; + failed := false; + + Write('Testing mixed parameter (LOC_CONSTANT) constructor call...'); + vmtclass:=tvmtclass.constructor_params_mixed(RESULT_U8BIT, RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.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; + vmtclass := tvmtclass.constructor_params_mixed(value_u8bit, value_u16bit, value_bigstring, + value_s32bit, value_s64bit); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.destructor_params_done; + + if failed then + fail + else + Writeln('Passed!'); + + + (* Message method testing + + DON'T KNOW HOW TO CALL DIRECTLY - cannot test - Carl + + clear_globals; + clear_values; + failed := false; + + Write('Testing mixed parameter (LOC_CONSTANT) message call...'); + vmtclass := tvmtclass.constructor_init; + vmtclass.method_message_params_mixed(vmtclass, + RESULT_U8BIT, RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.destructor_params_done; + + if failed then + fail + else + Writeln('Passed!'); + + clear_globals; + clear_values; + failed := false; + + Write('Testing mixed parameter (LOC_REFERENCE) message call...'); + value_u8bit := RESULT_U8BIT; + value_u16bit := RESULT_U16BIT; + value_bigstring := RESULT_BIGSTRING; + value_s32bit := RESULT_S32BIT; + value_s64bit := RESULT_S64BIT; + vmtclass := tvmtclass.constructor_init; + vmtclass.method_message_params_mixed(vmtclass + ,value_u8bit, value_u16bit, value_bigstring, value_s32bit, + value_s64bit); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.destructor_params_done; + + if failed then + fail + else + Writeln('Passed!'); + procedure tvmtclass.method_message_params_mixed(self : tvmtclass; + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); + procedure tvmtclass.method_message_call_virtual_params_mixed(self : tvmtclass; + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); + procedure tvmtclass.method_message_call_normal_params_mixed(self : tvmtclass; + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); + procedure tvmtclass.method_message_call_dynamic_params_mixed(self : tvmtclass; + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); +*) + end; + + + procedure testheritedvmtclass; + var + vmtclass : theritedvmtclass; + failed : boolean; + begin + {********************** CONSTRUCTOR TESTING ************************} + {********************** DESTRUCTOR TESTING ************************} + clear_globals; + clear_values; + failed := false; + + Write('Testing mixed parameter (LOC_CONSTANT) inherited constructor call...'); + vmtclass := theritedvmtclass.constructor_params_mixed_call_inherited(RESULT_U8BIT, RESULT_U16BIT, RESULT_BIGSTRING, + RESULT_S32BIT, RESULT_S64BIT); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.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; + vmtclass := theritedvmtclass.constructor_params_mixed_call_inherited(value_u8bit, + value_u16bit, value_bigstring, value_s32bit, value_s64bit); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.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...'); + vmtclass := theritedvmtclass.constructor_params_mixed_call_virtual(RESULT_U8BIT, + RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.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; + vmtclass:=theritedvmtclass.constructor_params_mixed_call_virtual(value_u8bit, + value_u16bit, value_bigstring, value_s32bit, value_s64bit); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.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...'); + vmtclass:=theritedvmtclass.constructor_params_mixed_call_overriden(RESULT_U8BIT, + RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.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; + vmtclass:=theritedvmtclass.constructor_params_mixed_call_overriden(value_u8bit, + value_u16bit, value_bigstring, value_s32bit, value_s64bit); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.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...'); + vmtclass:=theritedvmtclass.constructor_params_mixed_call_normal(RESULT_U8BIT, + RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.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; + vmtclass:=theritedvmtclass.constructor_params_mixed_call_normal(value_u8bit, + value_u16bit, value_bigstring, value_s32bit, value_s64bit); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.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...'); + vmtclass:=theritedvmtclass.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; + vmtclass.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; + vmtclass:=theritedvmtclass.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; + vmtclass.destructor_params_done; + + if failed then + fail + else + Writeln('Passed!'); + + {************************* METHOD TESTING **************************} + clear_globals; + clear_values; + failed := false; + + vmtclass:=theritedvmtclass.constructor_init; + Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...'); + vmtclass.method_virtual_params_mixed(RESULT_U8BIT, + RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.destructor_params_done; + + if failed then + fail + else + Writeln('Passed!'); + + clear_globals; + clear_values; + failed := false; + + vmtclass:=theritedvmtclass.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; + vmtclass.method_virtual_params_mixed(value_u8bit, + value_u16bit, value_bigstring, value_s32bit, value_s64bit); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.destructor_params_done; + + if failed then + fail + else + Writeln('Passed!'); + + clear_globals; + clear_values; + failed := false; + + vmtclass:=theritedvmtclass.constructor_init; + Write('Testing mixed parameter (LOC_CONSTANT) dynamic method call...'); + vmtclass.method_dynamic_params_mixed(RESULT_U8BIT, + RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.destructor_params_done; + + if failed then + fail + else + Writeln('Passed!'); + + clear_globals; + clear_values; + failed := false; + + vmtclass:=theritedvmtclass.constructor_init; + Write('Testing mixed parameter (LOC_CONSTANT) dynamic method call...'); + vmtclass.method_dynamic_overriden_params_mixed(RESULT_U8BIT, + RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.destructor_params_done; + + if failed then + fail + else + Writeln('Passed!'); + + clear_globals; + clear_values; + failed := false; + + vmtclass:=theritedvmtclass.constructor_init; + Write('Testing mixed parameter (LOC_REFERENCE) dynamic method call...'); + value_u8bit := RESULT_U8BIT; + value_u16bit := RESULT_U16BIT; + value_bigstring := RESULT_BIGSTRING; + value_s32bit := RESULT_S32BIT; + value_s64bit := RESULT_S64BIT; + vmtclass.method_dynamic_overriden_params_mixed(value_u8bit, + value_u16bit, value_bigstring, value_s32bit, value_s64bit); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.destructor_params_done; + + if failed then + fail + else + Writeln('Passed!'); + + clear_globals; + clear_values; + failed := false; + + vmtclass:=theritedvmtclass.constructor_init; + Write('Testing mixed parameter (LOC_REFERENCE) dynamic method call...'); + value_u8bit := RESULT_U8BIT; + value_u16bit := RESULT_U16BIT; + value_bigstring := RESULT_BIGSTRING; + value_s32bit := RESULT_S32BIT; + value_s64bit := RESULT_S64BIT; + vmtclass.method_dynamic_params_mixed(value_u8bit, + value_u16bit, value_bigstring, value_s32bit, value_s64bit); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.destructor_params_done; + + if failed then + fail + else + Writeln('Passed!'); + + + clear_globals; + clear_values; + failed := false; + + vmtclass:=theritedvmtclass.constructor_init; + Write('Testing mixed parameter (LOC_CONSTANT) virtual method call...'); + vmtclass.method_virtual_overriden_params_mixed(RESULT_U8BIT, + RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.destructor_params_done; + + if failed then + fail + else + Writeln('Passed!'); + + clear_globals; + clear_values; + failed := false; + + vmtclass:=theritedvmtclass.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; + vmtclass.method_virtual_overriden_params_mixed(value_u8bit, + value_u16bit, value_bigstring, value_s32bit, value_s64bit); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.destructor_params_done; + + if failed then + fail + else + Writeln('Passed!'); + + clear_globals; + clear_values; + failed := false; + + vmtclass:=theritedvmtclass.constructor_init; + Write('Testing mixed parameter (LOC_CONSTANT) method call...'); + vmtclass.method_normal_params_mixed(RESULT_U8BIT, + RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.destructor_params_done; + + if failed then + fail + else + Writeln('Passed!'); + + clear_globals; + clear_values; + failed := false; + + vmtclass:=theritedvmtclass.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; + vmtclass.method_normal_params_mixed(value_u8bit, + value_u16bit, value_bigstring, value_s32bit, value_s64bit); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.destructor_params_done; + + if failed then + fail + else + Writeln('Passed!'); + + clear_globals; + clear_values; + failed := false; + + vmtclass:=theritedvmtclass.constructor_init; + Write('Testing mixed parameter (LOC_CONSTANT) static method call...'); + vmtclass.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; + vmtclass.destructor_params_done; + + if failed then + fail + else + Writeln('Passed!'); + + clear_globals; + clear_values; + failed := false; + + vmtclass:=theritedvmtclass.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; + vmtclass.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; + vmtclass.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 } + vmtclass:=theritedvmtclass.constructor_init; + Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...'); + vmtclass.method_normal_call_virtual_params_mixed(RESULT_U8BIT, + RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.destructor_params_done; + + if failed then + fail + else + Writeln('Passed!'); + + clear_globals; + clear_values; + failed := false; + + vmtclass:=theritedvmtclass.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; + vmtclass.method_normal_call_virtual_params_mixed(value_u8bit, + value_u16bit, value_bigstring, value_s32bit, value_s64bit); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.destructor_params_done; + + if failed then + fail + else + Writeln('Passed!'); + + { The virtual method has been overriden by the object in this case } + vmtclass:=theritedvmtclass.constructor_init; + Write('Testing mixed parameter (LOC_CONSTANT) method call w/virtual call...'); + vmtclass.method_normal_call_overriden_params_mixed(RESULT_U8BIT, + RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.destructor_params_done; + + if failed then + fail + else + Writeln('Passed!'); + + clear_globals; + clear_values; + failed := false; + + vmtclass:=theritedvmtclass.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; + vmtclass.method_normal_call_overriden_params_mixed(value_u8bit, + value_u16bit, value_bigstring, value_s32bit, value_s64bit); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.destructor_params_done; + + if failed then + fail + else + Writeln('Passed!'); + + clear_globals; + clear_values; + failed := false; + + vmtclass:=theritedvmtclass.constructor_init; + Write('Testing mixed parameter (LOC_CONSTANT) method call w/normal call...'); + vmtclass.method_normal_call_normal_params_mixed(RESULT_U8BIT, + RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.destructor_params_done; + + if failed then + fail + else + Writeln('Passed!'); + + clear_globals; + clear_values; + failed := false; + + vmtclass:=theritedvmtclass.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; + vmtclass.method_normal_call_normal_params_mixed(value_u8bit, + value_u16bit, value_bigstring, value_s32bit, value_s64bit); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.destructor_params_done; + + if failed then + fail + else + Writeln('Passed!'); + + (* constructor call inside a normal method *) + + clear_globals; + clear_values; + failed := false; + + vmtclass:=theritedvmtclass.constructor_init; + Write('Testing mixed parameter (LOC_CONSTANT) method call w/constructor call...'); + vmtclass.method_normal_call_constructor_params_mixed(RESULT_U8BIT, + RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.destructor_params_done; + + if failed then + fail + else + Writeln('Passed!'); + + clear_globals; + clear_values; + failed := false; + + vmtclass:=theritedvmtclass.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; + vmtclass.method_normal_call_constructor_params_mixed(value_u8bit, + value_u16bit, value_bigstring, value_s32bit, value_s64bit); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.destructor_params_done; + + if failed then + fail + else + Writeln('Passed!'); + + { static method call } + clear_globals; + clear_values; + failed := false; + + vmtclass:=theritedvmtclass.constructor_init; + Write('Testing mixed parameter (LOC_CONSTANT) method call w/static call...'); + vmtclass.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; + vmtclass.destructor_params_done; + + if failed then + fail + else + Writeln('Passed!'); + + clear_globals; + clear_values; + failed := false; + + vmtclass:=theritedvmtclass.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; + vmtclass.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; + vmtclass.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 } + vmtclass:=theritedvmtclass.constructor_init; + Write('Testing mixed parameter (LOC_CONSTANT) method call w/inherited call...'); + vmtclass.method_normal_call_inherited_params_mixed(RESULT_U8BIT, + RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.destructor_params_done; + + if failed then + fail + else + Writeln('Passed!'); + + clear_globals; + clear_values; + failed := false; + + vmtclass:=theritedvmtclass.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; + vmtclass.method_normal_call_inherited_params_mixed(value_u8bit, + value_u16bit, value_bigstring, value_s32bit, value_s64bit); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.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 } + vmtclass:=theritedvmtclass.constructor_init; + Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...'); + vmtclass.method_virtual_call_virtual_params_mixed(RESULT_U8BIT, + RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.destructor_params_done; + + if failed then + fail + else + Writeln('Passed!'); + + clear_globals; + clear_values; + failed := false; + + vmtclass:=theritedvmtclass.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; + vmtclass.method_virtual_call_virtual_params_mixed(value_u8bit, + value_u16bit, value_bigstring, value_s32bit, value_s64bit); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.destructor_params_done; + + if failed then + fail + else + Writeln('Passed!'); + + { The virtual method has been overriden by the object in this case } + vmtclass:=theritedvmtclass.constructor_init; + Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/virtual call...'); + vmtclass.method_virtual_call_overriden_params_mixed(RESULT_U8BIT, + RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.destructor_params_done; + + if failed then + fail + else + Writeln('Passed!'); + + clear_globals; + clear_values; + failed := false; + + vmtclass:=theritedvmtclass.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; + vmtclass.method_virtual_call_overriden_params_mixed(value_u8bit, + value_u16bit, value_bigstring, value_s32bit, value_s64bit); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.destructor_params_done; + + if failed then + fail + else + Writeln('Passed!'); + + clear_globals; + clear_values; + failed := false; + + vmtclass:=theritedvmtclass.constructor_init; + Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/normal call...'); + vmtclass.method_virtual_call_normal_params_mixed(RESULT_U8BIT, + RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.destructor_params_done; + + if failed then + fail + else + Writeln('Passed!'); + + clear_globals; + clear_values; + failed := false; + + vmtclass:=theritedvmtclass.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; + vmtclass.method_virtual_call_normal_params_mixed(value_u8bit, + value_u16bit, value_bigstring, value_s32bit, value_s64bit); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.destructor_params_done; + + if failed then + fail + else + Writeln('Passed!'); + + (* destructor call inside a normal method *) + clear_globals; + clear_values; + failed := false; + + vmtclass:=theritedvmtclass.constructor_params_mixed(RESULT_U8BIT, + RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); + Write('Testing virtual call w/destructor call...'); + vmtclass.method_virtual_call_destructor; + 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; + vmtclass.destructor_params_done; + + if failed then + fail + else + Writeln('Passed!'); + + + (* constructor call inside a normal method *) + + clear_globals; + clear_values; + failed := false; + + vmtclass:=theritedvmtclass.constructor_init; + Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/constructor call...'); + vmtclass.method_virtual_call_constructor_params_mixed(RESULT_U8BIT, + RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.destructor_params_done; + + if failed then + fail + else + Writeln('Passed!'); + + clear_globals; + clear_values; + failed := false; + + vmtclass:=theritedvmtclass.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; + vmtclass.method_virtual_call_constructor_params_mixed(value_u8bit, + value_u16bit, value_bigstring, value_s32bit, value_s64bit); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.destructor_params_done; + + if failed then + fail + else + Writeln('Passed!'); + + (* static virtual call *) + clear_globals; + clear_values; + failed := false; + + vmtclass:=theritedvmtclass.constructor_init; + Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/static call...'); + vmtclass.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; + vmtclass.destructor_params_done; + + if failed then + fail + else + Writeln('Passed!'); + + clear_globals; + clear_values; + failed := false; + + vmtclass:=theritedvmtclass.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; + vmtclass.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; + vmtclass.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 } + vmtclass:=theritedvmtclass.constructor_init; + Write('Testing mixed parameter (LOC_CONSTANT) virtual call w/inherited call...'); + vmtclass.method_virtual_call_inherited_params_mixed(RESULT_U8BIT, + RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.destructor_params_done; + + if failed then + fail + else + Writeln('Passed!'); + + clear_globals; + clear_values; + failed := false; + + vmtclass:=theritedvmtclass.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; + vmtclass.method_virtual_call_inherited_params_mixed(value_u8bit, + value_u16bit, value_bigstring, value_s32bit, value_s64bit); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.destructor_params_done; + + if failed then + fail + else + Writeln('Passed!'); + + (* dynamic call testing *) + clear_globals; + clear_values; + failed := false; + + vmtclass:=theritedvmtclass.constructor_init; + Write('Testing mixed parameter (LOC_CONSTANT) dynamic call w/constructor call...'); + vmtclass.method_dynamic_call_constructor_params_mixed(RESULT_U8BIT, + RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.destructor_params_done; + + if failed then + fail + else + Writeln('Passed!'); + + clear_globals; + clear_values; + failed := false; + + vmtclass:=theritedvmtclass.constructor_init; + Write('Testing mixed parameter (LOC_REFERENCE) dynamic call w/constructor call...'); + value_u8bit := RESULT_U8BIT; + value_u16bit := RESULT_U16BIT; + value_bigstring := RESULT_BIGSTRING; + value_s32bit := RESULT_S32BIT; + value_s64bit := RESULT_S64BIT; + vmtclass.method_dynamic_call_constructor_params_mixed(value_u8bit, + value_u16bit, value_bigstring, value_s32bit, value_s64bit); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.destructor_params_done; + + if failed then + fail + else + Writeln('Passed!'); + + (* static virtual call *) + clear_globals; + clear_values; + failed := false; + + vmtclass:=theritedvmtclass.constructor_init; + Write('Testing mixed parameter (LOC_CONSTANT) dynamic call w/static call...'); + vmtclass.method_dynamic_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; + vmtclass.destructor_params_done; + + if failed then + fail + else + Writeln('Passed!'); + + clear_globals; + clear_values; + failed := false; + + vmtclass:=theritedvmtclass.constructor_init; + Write('Testing mixed parameter (LOC_REFERENCE) dynamic call w/static call...'); + value_u8bit := RESULT_U8BIT; + value_u16bit := RESULT_U16BIT; + value_bigstring := RESULT_BIGSTRING; + value_s32bit := RESULT_S32BIT; + value_s64bit := RESULT_S64BIT; + vmtclass.method_dynamic_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; + vmtclass.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 } + vmtclass:=theritedvmtclass.constructor_init; + Write('Testing mixed parameter (LOC_CONSTANT) dynamic call w/inherited call...'); + vmtclass.method_dynamic_call_inherited_params_mixed(RESULT_U8BIT, + RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.destructor_params_done; + + if failed then + fail + else + Writeln('Passed!'); + + clear_globals; + clear_values; + failed := false; + + vmtclass:=theritedvmtclass.constructor_init; + Write('Testing mixed parameter (LOC_REFERENCE) dynamic call w/inherited call...'); + value_u8bit := RESULT_U8BIT; + value_u16bit := RESULT_U16BIT; + value_bigstring := RESULT_BIGSTRING; + value_s32bit := RESULT_S32BIT; + value_s64bit := RESULT_S64BIT; + vmtclass.method_dynamic_call_inherited_params_mixed(value_u8bit, + value_u16bit, value_bigstring, value_s32bit, value_s64bit); + if vmtclass.object_u8bit <> RESULT_U8BIT then + failed := true; + if vmtclass.object_u16bit <> RESULT_U16BIT then + failed := true; + if vmtclass.object_s32bit <> RESULT_S32BIT then + failed := true; + if vmtclass.object_s64bit <> RESULT_S64BIT then + failed := true; + if vmtclass.object_bigstring <> RESULT_BIGSTRING then + failed := true; + vmtclass.destructor_params_done; + + if failed then + fail + else + Writeln('Passed!'); + end; + +procedure testwith; + var + vmtclass : theritedvmtclass; + failed : boolean; + begin + with vmtclass do + begin + + {********************** CONSTRUCTOR TESTING ************************} + {********************** DESTRUCTOR TESTING ************************} + clear_globals; + clear_values; + failed := false; + + Write('Testing mixed parameter (LOC_CONSTANT) inherited constructor call...'); + vmtclass := theritedvmtclass.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; + vmtclass := theritedvmtclass.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...'); + vmtclass := theritedvmtclass.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; + vmtclass:=theritedvmtclass.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...'); + vmtclass:=theritedvmtclass.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; + vmtclass:=theritedvmtclass.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...'); + vmtclass:=theritedvmtclass.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; + vmtclass:=theritedvmtclass.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...'); + vmtclass:=theritedvmtclass.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; + vmtclass:=theritedvmtclass.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; + + vmtclass:=theritedvmtclass.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; + + vmtclass:=theritedvmtclass.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; + + vmtclass:=theritedvmtclass.constructor_init; + Write('Testing mixed parameter (LOC_CONSTANT) dynamic method call...'); + method_dynamic_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; + + vmtclass:=theritedvmtclass.constructor_init; + Write('Testing mixed parameter (LOC_CONSTANT) dynamic method call...'); + method_dynamic_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; + + vmtclass:=theritedvmtclass.constructor_init; + Write('Testing mixed parameter (LOC_REFERENCE) dynamic method call...'); + value_u8bit := RESULT_U8BIT; + value_u16bit := RESULT_U16BIT; + value_bigstring := RESULT_BIGSTRING; + value_s32bit := RESULT_S32BIT; + value_s64bit := RESULT_S64BIT; + method_dynamic_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; + + vmtclass:=theritedvmtclass.constructor_init; + Write('Testing mixed parameter (LOC_REFERENCE) dynamic method call...'); + value_u8bit := RESULT_U8BIT; + value_u16bit := RESULT_U16BIT; + value_bigstring := RESULT_BIGSTRING; + value_s32bit := RESULT_S32BIT; + value_s64bit := RESULT_S64BIT; + method_dynamic_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; + + vmtclass:=theritedvmtclass.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; + + vmtclass:=theritedvmtclass.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; + + vmtclass:=theritedvmtclass.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; + + vmtclass:=theritedvmtclass.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; + + vmtclass:=theritedvmtclass.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; + + vmtclass:=theritedvmtclass.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 } + vmtclass:=theritedvmtclass.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; + + vmtclass:=theritedvmtclass.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 } + vmtclass:=theritedvmtclass.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; + + vmtclass:=theritedvmtclass.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; + + vmtclass:=theritedvmtclass.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; + + vmtclass:=theritedvmtclass.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; + + vmtclass:=theritedvmtclass.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; + + vmtclass:=theritedvmtclass.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; + + vmtclass:=theritedvmtclass.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; + + vmtclass:=theritedvmtclass.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 } + vmtclass:=theritedvmtclass.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; + + vmtclass:=theritedvmtclass.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 } + vmtclass:=theritedvmtclass.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; + + vmtclass:=theritedvmtclass.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 } + vmtclass:=theritedvmtclass.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; + + vmtclass:=theritedvmtclass.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; + + vmtclass:=theritedvmtclass.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; + + vmtclass:=theritedvmtclass.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!'); + + (* destructor call inside a normal method *) + clear_globals; + clear_values; + failed := false; + + vmtclass:=theritedvmtclass.constructor_params_mixed(RESULT_U8BIT, + RESULT_U16BIT, RESULT_BIGSTRING, RESULT_S32BIT, RESULT_S64BIT); + Write('Testing virtual call w/destructor call...'); + method_virtual_call_destructor; + 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!'); + + + (* constructor call inside a normal method *) + + clear_globals; + clear_values; + failed := false; + + vmtclass:=theritedvmtclass.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; + + vmtclass:=theritedvmtclass.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; + + vmtclass:=theritedvmtclass.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; + + vmtclass:=theritedvmtclass.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 } + vmtclass:=theritedvmtclass.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; + + vmtclass:=theritedvmtclass.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!'); + + (* dynamic call testing *) + clear_globals; + clear_values; + failed := false; + + vmtclass:=theritedvmtclass.constructor_init; + Write('Testing mixed parameter (LOC_CONSTANT) dynamic call w/constructor call...'); + method_dynamic_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; + + vmtclass:=theritedvmtclass.constructor_init; + Write('Testing mixed parameter (LOC_REFERENCE) dynamic 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_dynamic_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; + + vmtclass:=theritedvmtclass.constructor_init; + Write('Testing mixed parameter (LOC_CONSTANT) dynamic call w/static call...'); + method_dynamic_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; + + vmtclass:=theritedvmtclass.constructor_init; + Write('Testing mixed parameter (LOC_REFERENCE) dynamic 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_dynamic_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 } + vmtclass:=theritedvmtclass.constructor_init; + Write('Testing mixed parameter (LOC_CONSTANT) dynamic call w/inherited call...'); + method_dynamic_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; + + vmtclass:=theritedvmtclass.constructor_init; + Write('Testing mixed parameter (LOC_REFERENCE) dynamic 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_dynamic_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('*********************** CLASS TESTS ***********************'); + testnovmtclass; +{ WriteLN('************************ VMT OBJECT FAIL **********************'); + testfailedclass;} + testvmtclass; + testheritedvmtclass; + WriteLN('*******************CLASS TESTS USING WITH ******************'); + testwith; +end. + +{ $Log$ - Revision 1.2 2002-09-07 15:40:49 peter - * old logs removed and tabs fixed - - Revision 1.1 2002/05/05 19:15:52 carl - + complete class method call testing (secondcalln()) - -} + Revision 1.3 2003-04-22 10:24:29 florian + * fixed defines for powerpc + + Revision 1.2 2002/09/07 15:40:49 peter + * old logs removed and tabs fixed + + Revision 1.1 2002/05/05 19:15:52 carl + + complete class method call testing (secondcalln()) + +} diff --git a/tests/test/cg/tcalcst1.pp b/tests/test/cg/tcalcst1.pp index 3a985ee436..91c36392df 100644 --- a/tests/test/cg/tcalcst1.pp +++ b/tests/test/cg/tcalcst1.pp @@ -1,861 +1,863 @@ -{****************************************************************} -{ 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 } -{ (const parameters) } -{****************************************************************} -program tcalcst1; -{$ifdef fpc} -{$mode objfpc} -{$INLINE ON} -{$endif} -{$R+} - -{$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; - {$endif} - {$ifdef cpui386} - 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; - value_u8bit : byte; - value_u16bit : word; - value_s32bit : longint; -{$ifndef tp} - global_class : tclass1; - global_s64bit : int64; - value_s64bit : int64; - value_class : tclass1; -{$endif} - 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; -{$ifndef tp} - global_s64bit := 0; - global_class := nil; -{$endif} - 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; -{$ifndef tp} - value_s64bit := 0; - value_class := nil; -{$endif} - 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; - end; - - - procedure testprocedure; - begin - end; - - function getu8bit : byte; - begin - getu8bit:=RESULT_U8BIT; - end; - - function getu16bit: word; - begin - getu16bit:=RESULT_U16BIT; - end; - - function gets32bit: longint; - begin - gets32bit:=RESULT_S32BIT; - end; - - function gets64bit: int64; - begin - gets64bit:=RESULT_S64BIT; - end; - - - function gets32real: single; - begin - gets32real:=RESULT_S32REAL; - end; - - function gets64real: double; - begin - gets64real:=RESULT_S64REAL; - end; - - {************************************************************************} - { CONST PARAMETERS } - {************************************************************************} - procedure proc_const_s32bit(const v : longint); - begin - global_s32bit := v; - end; - -{$ifndef tp} - procedure proc_const_s64bit(const v: int64); - begin - global_s64bit:= v; - end; - - procedure proc_const_smallarray_const_1(const arr : array of const); - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : global_u8bit := arr[i].vinteger and $ff; - vtBoolean : global_boolean := arr[i].vboolean; - vtChar : global_char := arr[i].vchar; - vtExtended : global_s64real := arr[i].VExtended^; - vtString : global_bigstring := arr[i].VString^; - vtPointer : ; - vtPChar : global_ptr := arr[i].VPchar; - vtObject : ; -{ vtClass : global_class := (arr[i].VClass) as tclass1;} - vtAnsiString : ; - vtInt64 : global_s64bit := arr[i].vInt64^; - else - RunError(255); - end; - end; {endfor} - end; - - - procedure proc_const_smallarray_const_2(const arr : array of const); - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - end; - -{$endif} - - - procedure proc_const_smallrecord(const smallrec : tsmallrecord); - begin - if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_const_largerecord(const largerec : tlargerecord); - begin - if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_const_smallset(const smallset : tsmallset); - begin - if A_D in smallset then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_const_largeset(const largeset : tlargeset); - begin - if 'I' in largeset then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_const_smallstring(const s:tsmallstring); - begin - if s = RESULT_SMALLSTRING then - global_u8bit := RESULT_u8BIT; - end; - - - procedure proc_const_bigstring(const s:shortstring); - begin - if s = RESULT_BIGSTRING then - global_u8bit := RESULT_u8BIT; - end; - - - procedure proc_const_smallarray(const arr : tsmallarray); - begin - if arr[SMALL_INDEX] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_const_smallarray_open(const arr : array of byte); - begin - { form 0 to N-1 indexes in open arrays } - if arr[SMALL_INDEX-1] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - end; - - - - - procedure proc_const_formaldef_array(const buf); - var - p: pchar; - begin - { array is indexed from 1 } - p := @buf; - global_u8bit := byte(p[SMALL_INDEX-1]); - end; - - - {************************************************************************} - { MIXED CONST PARAMETERS } - {************************************************************************} - procedure proc_const_s32bit_mixed(b1: byte; const v : longint; b2: byte); - begin - global_s32bit := v; - value_u8bit := b2; - end; - -{$ifndef tp} - procedure proc_const_s64bit_mixed(b1 : byte; const v: int64; b2: byte); - begin - global_s64bit:= v; - value_u8bit := b2; - end; - - procedure proc_const_smallarray_const_1_mixed(b1 : byte; const arr : array of const; b2: byte); - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : global_u8bit := arr[i].vinteger and $ff; - vtBoolean : global_boolean := arr[i].vboolean; - vtChar : global_char := arr[i].vchar; - vtExtended : global_s64real := arr[i].VExtended^; - vtString : global_bigstring := arr[i].VString^; - vtPointer : ; - vtPChar : global_ptr := arr[i].VPchar; - vtObject : ; -{ vtClass : global_class := (arr[i].VClass) as tclass1;} - vtAnsiString : ; - vtInt64 : global_s64bit := arr[i].vInt64^; - else - RunError(255); - end; - end; {endfor} - value_u8bit := b2; - end; - - - procedure proc_const_smallarray_const_2_mixed(b1: byte; const arr : array of const; b2: byte); - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; -{$endif} - - - procedure proc_const_smallrecord_mixed(b1 : byte; const smallrec : tsmallrecord; b2: byte); - begin - if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - procedure proc_const_largerecord_mixed(b1: byte; const largerec : tlargerecord; b2: byte); - begin - if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - procedure proc_const_smallset_mixed(b1: byte; const smallset : tsmallset; b2: byte); - begin - if A_D in smallset then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - procedure proc_const_largeset_mixed(b1: byte; const largeset : tlargeset; b2: byte); - begin - if 'I' in largeset then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - procedure proc_const_smallstring_mixed(b1: byte; const s:tsmallstring; b2: byte); - begin - if s = RESULT_SMALLSTRING then - global_u8bit := RESULT_u8BIT; - value_u8bit := b2; - end; - - - procedure proc_const_bigstring_mixed(b1: byte; const s:shortstring; b2: byte); - begin - if s = RESULT_BIGSTRING then - global_u8bit := RESULT_u8BIT; - value_u8bit := b2; - end; - - - procedure proc_const_smallarray_mixed(b1: byte; const arr : tsmallarray; b2: byte); - begin - if arr[SMALL_INDEX] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - procedure proc_const_smallarray_open_mixed(b1: byte; const arr : array of byte; b2: byte); - begin - { form 0 to N-1 indexes in open arrays } - if arr[high(arr)] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - - - procedure proc_const_formaldef_array_mixed(b1: byte; const buf; b2: byte); - var - p: pchar; - begin - { array is indexed from 1 } - p := @buf; - global_u8bit := byte(p[SMALL_INDEX-1]); - value_u8bit := b2; - end; - - -var - failed: boolean; - pp : ^pchar; -begin - {***************************** NORMAL TESTS *******************************} - write('Const parameter test (src : LOC_REGISTER (orddef)))...'); - clear_globals; - clear_values; - failed:=false; - - proc_const_s32bit(gets32bit); - if global_s32bit <> RESULT_S32BIT then - failed:=true; -{$ifndef tp} - proc_const_s64bit(gets64bit); - if global_s64bit <> RESULT_S64BIT then - failed:=true; -{$endif} - - if failed then - fail - else - WriteLn('Passed!'); - - write('Const parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallrec.b := RESULT_U8BIT; - value_smallrec.w := RESULT_U16BIT; - proc_const_smallrecord(value_smallrec); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); - proc_const_largerecord(value_largerec); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('const parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallset := [A_A,A_D]; - proc_const_smallset(value_smallset); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_largeset := ['I']; - proc_const_largeset(value_largeset); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - - - write('const parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - value_smallstring := RESULT_SMALLSTRING; - - proc_const_smallstring(value_smallstring); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_bigstring := RESULT_BIGSTRING; - proc_const_bigstring(value_bigstring); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - - write('Const parameter test (src : LOC_REFERENCE (formaldef)))...'); - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_formaldef_array(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Const parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_smallarray(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_smallarray_open(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - -{$ifndef tp} - clear_globals; - clear_values; - - value_u8bit := RESULT_U8BIT; - value_ptr := RESULT_PCHAR; - value_s64bit := RESULT_S64BIT; - value_smallstring := RESULT_SMALLSTRING; - value_class := tclass1.create; - value_boolean := RESULT_BOOLEAN; - value_char := RESULT_CHAR; - value_s64real:=RESULT_S64REAL; - proc_const_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real, - value_boolean,value_class]); - - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if global_char <> RESULT_CHAR then - failed := true; - if global_boolean <> RESULT_BOOLEAN then - failed:=true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed := true; - if global_bigstring <> RESULT_SMALLSTRING then - failed := true; - if global_ptr <> value_ptr then - failed := true; -{ if value_class <> global_class then - failed := true;!!!!!!!!!!!!!!!!!!!!} - if global_s64bit <> RESULT_S64BIT then - failed := true; - if assigned(value_class) then - value_class.destroy; - - global_u8bit := 0; - proc_const_smallarray_const_2([]); - if global_u8bit <> RESULT_U8BIT then - failed := true; -{$endif} - - if failed then - fail - else - WriteLn('Passed!'); - - - {***************************** MIXED TESTS *******************************} - write('Mixed const parameter test (src : LOC_REGISTER (orddef)))...'); - clear_globals; - clear_values; - failed:=false; - - proc_const_s32bit_mixed(RESULT_U8BIT,gets32bit,RESULT_U8BIT); - if global_s32bit <> RESULT_S32BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$ifndef tp} - proc_const_s64bit_mixed(RESULT_U8BIT,gets64bit,RESULT_U8BIT); - if global_s64bit <> RESULT_S64BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$endif} - if failed then - fail - else - WriteLn('Passed!'); - - write('Mixed const parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallrec.b := RESULT_U8BIT; - value_smallrec.w := RESULT_U16BIT; - proc_const_smallrecord_mixed(RESULT_U8BIT,value_smallrec,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); - proc_const_largerecord_mixed(RESULT_U8BIT,value_largerec,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Mixed const parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallset := [A_A,A_D]; - proc_const_smallset_mixed(RESULT_U8BIT,value_smallset,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_largeset := ['I']; - proc_const_largeset_mixed(RESULT_U8BIT,value_largeset,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - write('Mixed const parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - value_smallstring := RESULT_SMALLSTRING; - - proc_const_smallstring_mixed(RESULT_U8BIT,value_smallstring,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_bigstring := RESULT_BIGSTRING; - proc_const_bigstring_mixed(RESULT_U8BIT,value_bigstring,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - write('Mixed const parameter test (src : LOC_REFERENCE (formaldef)))...'); - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_formaldef_array_mixed(RESULT_U8BIT,value_smallarray,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Mixed const parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_smallarray_mixed(RESULT_U8BIt,value_smallarray,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_smallarray_open_mixed(RESULT_U8BIT,value_smallarray,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - -{$ifndef tp} - clear_globals; - clear_values; - - value_u8bit := RESULT_U8BIT; - value_ptr := RESULT_PCHAR; - value_s64bit := RESULT_S64BIT; - value_smallstring := RESULT_SMALLSTRING; - value_class := tclass1.create; - value_boolean := RESULT_BOOLEAN; - value_char := RESULT_CHAR; - value_s64real:=RESULT_S64REAL; - proc_const_smallarray_const_1_mixed(RESULT_U8BIT, [value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring, - value_s64real,value_boolean,value_class],RESULT_U8BIT); - - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if global_char <> RESULT_CHAR then - failed := true; - if global_boolean <> RESULT_BOOLEAN then - failed:=true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed := true; - if global_bigstring <> RESULT_SMALLSTRING then - failed := true; - if global_ptr <> value_ptr then - failed := true; -{ if value_class <> global_class then - failed := true;!!!!!!!!!!!!!!!!!!!!} - if global_s64bit <> RESULT_S64BIT then - failed := true; - if assigned(value_class) then - value_class.destroy; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - global_u8bit := 0; - proc_const_smallarray_const_2_mixed(RESULT_U8BIT,[],RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$endif} - - 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 } +{ (const parameters) } +{****************************************************************} +program tcalcst1; +{$ifdef fpc} +{$mode objfpc} +{$INLINE ON} +{$endif} +{$R+} + +{$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; + value_u8bit : byte; + value_u16bit : word; + value_s32bit : longint; +{$ifndef tp} + global_class : tclass1; + global_s64bit : int64; + value_s64bit : int64; + value_class : tclass1; +{$endif} + 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; +{$ifndef tp} + global_s64bit := 0; + global_class := nil; +{$endif} + 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; +{$ifndef tp} + value_s64bit := 0; + value_class := nil; +{$endif} + 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; + end; + + + procedure testprocedure; + begin + end; + + function getu8bit : byte; + begin + getu8bit:=RESULT_U8BIT; + end; + + function getu16bit: word; + begin + getu16bit:=RESULT_U16BIT; + end; + + function gets32bit: longint; + begin + gets32bit:=RESULT_S32BIT; + end; + + function gets64bit: int64; + begin + gets64bit:=RESULT_S64BIT; + end; + + + function gets32real: single; + begin + gets32real:=RESULT_S32REAL; + end; + + function gets64real: double; + begin + gets64real:=RESULT_S64REAL; + end; + + {************************************************************************} + { CONST PARAMETERS } + {************************************************************************} + procedure proc_const_s32bit(const v : longint); + begin + global_s32bit := v; + end; + +{$ifndef tp} + procedure proc_const_s64bit(const v: int64); + begin + global_s64bit:= v; + end; + + procedure proc_const_smallarray_const_1(const arr : array of const); + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : global_u8bit := arr[i].vinteger and $ff; + vtBoolean : global_boolean := arr[i].vboolean; + vtChar : global_char := arr[i].vchar; + vtExtended : global_s64real := arr[i].VExtended^; + vtString : global_bigstring := arr[i].VString^; + vtPointer : ; + vtPChar : global_ptr := arr[i].VPchar; + vtObject : ; +{ vtClass : global_class := (arr[i].VClass) as tclass1;} + vtAnsiString : ; + vtInt64 : global_s64bit := arr[i].vInt64^; + else + RunError(255); + end; + end; {endfor} + end; + + + procedure proc_const_smallarray_const_2(const arr : array of const); + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + end; + +{$endif} + + + procedure proc_const_smallrecord(const smallrec : tsmallrecord); + begin + if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_const_largerecord(const largerec : tlargerecord); + begin + if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_const_smallset(const smallset : tsmallset); + begin + if A_D in smallset then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_const_largeset(const largeset : tlargeset); + begin + if 'I' in largeset then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_const_smallstring(const s:tsmallstring); + begin + if s = RESULT_SMALLSTRING then + global_u8bit := RESULT_u8BIT; + end; + + + procedure proc_const_bigstring(const s:shortstring); + begin + if s = RESULT_BIGSTRING then + global_u8bit := RESULT_u8BIT; + end; + + + procedure proc_const_smallarray(const arr : tsmallarray); + begin + if arr[SMALL_INDEX] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_const_smallarray_open(const arr : array of byte); + begin + { form 0 to N-1 indexes in open arrays } + if arr[SMALL_INDEX-1] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + end; + + + + + procedure proc_const_formaldef_array(const buf); + var + p: pchar; + begin + { array is indexed from 1 } + p := @buf; + global_u8bit := byte(p[SMALL_INDEX-1]); + end; + + + {************************************************************************} + { MIXED CONST PARAMETERS } + {************************************************************************} + procedure proc_const_s32bit_mixed(b1: byte; const v : longint; b2: byte); + begin + global_s32bit := v; + value_u8bit := b2; + end; + +{$ifndef tp} + procedure proc_const_s64bit_mixed(b1 : byte; const v: int64; b2: byte); + begin + global_s64bit:= v; + value_u8bit := b2; + end; + + procedure proc_const_smallarray_const_1_mixed(b1 : byte; const arr : array of const; b2: byte); + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : global_u8bit := arr[i].vinteger and $ff; + vtBoolean : global_boolean := arr[i].vboolean; + vtChar : global_char := arr[i].vchar; + vtExtended : global_s64real := arr[i].VExtended^; + vtString : global_bigstring := arr[i].VString^; + vtPointer : ; + vtPChar : global_ptr := arr[i].VPchar; + vtObject : ; +{ vtClass : global_class := (arr[i].VClass) as tclass1;} + vtAnsiString : ; + vtInt64 : global_s64bit := arr[i].vInt64^; + else + RunError(255); + end; + end; {endfor} + value_u8bit := b2; + end; + + + procedure proc_const_smallarray_const_2_mixed(b1: byte; const arr : array of const; b2: byte); + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; +{$endif} + + + procedure proc_const_smallrecord_mixed(b1 : byte; const smallrec : tsmallrecord; b2: byte); + begin + if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + procedure proc_const_largerecord_mixed(b1: byte; const largerec : tlargerecord; b2: byte); + begin + if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + procedure proc_const_smallset_mixed(b1: byte; const smallset : tsmallset; b2: byte); + begin + if A_D in smallset then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + procedure proc_const_largeset_mixed(b1: byte; const largeset : tlargeset; b2: byte); + begin + if 'I' in largeset then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + procedure proc_const_smallstring_mixed(b1: byte; const s:tsmallstring; b2: byte); + begin + if s = RESULT_SMALLSTRING then + global_u8bit := RESULT_u8BIT; + value_u8bit := b2; + end; + + + procedure proc_const_bigstring_mixed(b1: byte; const s:shortstring; b2: byte); + begin + if s = RESULT_BIGSTRING then + global_u8bit := RESULT_u8BIT; + value_u8bit := b2; + end; + + + procedure proc_const_smallarray_mixed(b1: byte; const arr : tsmallarray; b2: byte); + begin + if arr[SMALL_INDEX] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + procedure proc_const_smallarray_open_mixed(b1: byte; const arr : array of byte; b2: byte); + begin + { form 0 to N-1 indexes in open arrays } + if arr[high(arr)] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + + + procedure proc_const_formaldef_array_mixed(b1: byte; const buf; b2: byte); + var + p: pchar; + begin + { array is indexed from 1 } + p := @buf; + global_u8bit := byte(p[SMALL_INDEX-1]); + value_u8bit := b2; + end; + + +var + failed: boolean; + pp : ^pchar; +begin + {***************************** NORMAL TESTS *******************************} + write('Const parameter test (src : LOC_REGISTER (orddef)))...'); + clear_globals; + clear_values; + failed:=false; + + proc_const_s32bit(gets32bit); + if global_s32bit <> RESULT_S32BIT then + failed:=true; +{$ifndef tp} + proc_const_s64bit(gets64bit); + if global_s64bit <> RESULT_S64BIT then + failed:=true; +{$endif} + + if failed then + fail + else + WriteLn('Passed!'); + + write('Const parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallrec.b := RESULT_U8BIT; + value_smallrec.w := RESULT_U16BIT; + proc_const_smallrecord(value_smallrec); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); + proc_const_largerecord(value_largerec); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('const parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallset := [A_A,A_D]; + proc_const_smallset(value_smallset); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_largeset := ['I']; + proc_const_largeset(value_largeset); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + + + write('const parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + value_smallstring := RESULT_SMALLSTRING; + + proc_const_smallstring(value_smallstring); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_bigstring := RESULT_BIGSTRING; + proc_const_bigstring(value_bigstring); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + + write('Const parameter test (src : LOC_REFERENCE (formaldef)))...'); + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_formaldef_array(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Const parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_smallarray(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_smallarray_open(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + +{$ifndef tp} + clear_globals; + clear_values; + + value_u8bit := RESULT_U8BIT; + value_ptr := RESULT_PCHAR; + value_s64bit := RESULT_S64BIT; + value_smallstring := RESULT_SMALLSTRING; + value_class := tclass1.create; + value_boolean := RESULT_BOOLEAN; + value_char := RESULT_CHAR; + value_s64real:=RESULT_S64REAL; + proc_const_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real, + value_boolean,value_class]); + + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if global_char <> RESULT_CHAR then + failed := true; + if global_boolean <> RESULT_BOOLEAN then + failed:=true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed := true; + if global_bigstring <> RESULT_SMALLSTRING then + failed := true; + if global_ptr <> value_ptr then + failed := true; +{ if value_class <> global_class then + failed := true;!!!!!!!!!!!!!!!!!!!!} + if global_s64bit <> RESULT_S64BIT then + failed := true; + if assigned(value_class) then + value_class.destroy; + + global_u8bit := 0; + proc_const_smallarray_const_2([]); + if global_u8bit <> RESULT_U8BIT then + failed := true; +{$endif} + + if failed then + fail + else + WriteLn('Passed!'); + + + {***************************** MIXED TESTS *******************************} + write('Mixed const parameter test (src : LOC_REGISTER (orddef)))...'); + clear_globals; + clear_values; + failed:=false; + + proc_const_s32bit_mixed(RESULT_U8BIT,gets32bit,RESULT_U8BIT); + if global_s32bit <> RESULT_S32BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$ifndef tp} + proc_const_s64bit_mixed(RESULT_U8BIT,gets64bit,RESULT_U8BIT); + if global_s64bit <> RESULT_S64BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$endif} + if failed then + fail + else + WriteLn('Passed!'); + + write('Mixed const parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallrec.b := RESULT_U8BIT; + value_smallrec.w := RESULT_U16BIT; + proc_const_smallrecord_mixed(RESULT_U8BIT,value_smallrec,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); + proc_const_largerecord_mixed(RESULT_U8BIT,value_largerec,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Mixed const parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallset := [A_A,A_D]; + proc_const_smallset_mixed(RESULT_U8BIT,value_smallset,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_largeset := ['I']; + proc_const_largeset_mixed(RESULT_U8BIT,value_largeset,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + write('Mixed const parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + value_smallstring := RESULT_SMALLSTRING; + + proc_const_smallstring_mixed(RESULT_U8BIT,value_smallstring,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_bigstring := RESULT_BIGSTRING; + proc_const_bigstring_mixed(RESULT_U8BIT,value_bigstring,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + write('Mixed const parameter test (src : LOC_REFERENCE (formaldef)))...'); + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_formaldef_array_mixed(RESULT_U8BIT,value_smallarray,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Mixed const parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_smallarray_mixed(RESULT_U8BIt,value_smallarray,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_smallarray_open_mixed(RESULT_U8BIT,value_smallarray,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + +{$ifndef tp} + clear_globals; + clear_values; + + value_u8bit := RESULT_U8BIT; + value_ptr := RESULT_PCHAR; + value_s64bit := RESULT_S64BIT; + value_smallstring := RESULT_SMALLSTRING; + value_class := tclass1.create; + value_boolean := RESULT_BOOLEAN; + value_char := RESULT_CHAR; + value_s64real:=RESULT_S64REAL; + proc_const_smallarray_const_1_mixed(RESULT_U8BIT, [value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring, + value_s64real,value_boolean,value_class],RESULT_U8BIT); + + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if global_char <> RESULT_CHAR then + failed := true; + if global_boolean <> RESULT_BOOLEAN then + failed:=true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed := true; + if global_bigstring <> RESULT_SMALLSTRING then + failed := true; + if global_ptr <> value_ptr then + failed := true; +{ if value_class <> global_class then + failed := true;!!!!!!!!!!!!!!!!!!!!} + if global_s64bit <> RESULT_S64BIT then + failed := true; + if assigned(value_class) then + value_class.destroy; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + global_u8bit := 0; + proc_const_smallarray_const_2_mixed(RESULT_U8BIT,[],RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$endif} + + if failed then + fail + else + WriteLn('Passed!'); +end. + +{ $Log$ - Revision 1.4 2002-09-22 09:08:40 carl - * gets64bit was not returning an int64! - - Revision 1.3 2002/09/07 15:40:50 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/10 16:34:30 carl - + first tries at first calln testing - -} + Revision 1.5 2003-04-22 10:24:29 florian + * fixed defines for powerpc + + Revision 1.4 2002/09/22 09:08:40 carl + * gets64bit was not returning an int64! + + Revision 1.3 2002/09/07 15:40:50 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/10 16:34:30 carl + + first tries at first calln testing + +} diff --git a/tests/test/cg/tcalcst2.pp b/tests/test/cg/tcalcst2.pp index c7b9d0b512..43b91f6092 100644 --- a/tests/test/cg/tcalcst2.pp +++ b/tests/test/cg/tcalcst2.pp @@ -1,494 +1,496 @@ -{****************************************************************} -{ 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 } -{ (const parameters) } -{****************************************************************} -program tcalcst2; -{$ifdef fpc} - {$mode objfpc} - {$INLINE ON} -{$endif} -{$R+} - -{$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; - {$endif} - {$ifdef cpui386} - 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 - tclass1 = class - end; - - 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_s64bit : int64; - global_s32real : single; - global_s64real : double; - global_ptr : pchar; - global_proc : tprocedure; - global_class : tclass1; - global_bigstring : shortstring; - global_boolean : boolean; - global_char : char; - value_u8bit : byte; - value_u16bit : word; - value_s32bit : longint; - value_s64bit : int64; - value_s32real : single; - value_s64real : double; - value_proc : tprocedure; - value_ptr : pchar; - value_class : tclass1; - 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_s64bit := 0; - global_s32real := 0.0; - global_s64real := 0.0; - global_ptr := nil; - global_proc := nil; - global_class := nil; - global_bigstring := ''; - global_boolean := false; - global_char := #0; - end; - - - procedure clear_values; - begin - value_u8bit := 0; - value_u16bit := 0; - value_s32bit := 0; - value_s64bit := 0; - value_s32real := 0.0; - value_s64real := 0.0; - value_proc := nil; - value_ptr := nil; - value_class := 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; - end; - - - procedure testprocedure; - begin - end; - - function getu8bit : byte; - begin - getu8bit:=RESULT_U8BIT; - end; - - function getu16bit: word; - begin - getu16bit:=RESULT_U16BIT; - end; - - function gets32bit: longint; - begin - gets32bit:=RESULT_S32BIT; - end; - - function gets64bit: int64; - begin - gets64bit:=RESULT_S64BIT; - end; - - - function gets32real: single; - begin - gets32real:=RESULT_S32REAL; - end; - - function gets64real: double; - begin - gets64real:=RESULT_S64REAL; - end; - - - {************************************************************************} - { CONST PARAMETERS (INLINE) } - {************************************************************************} - - procedure proc_const_smallrecord_inline(const smallrec : tsmallrecord);inline; - begin - if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_const_largerecord_inline(const largerec : tlargerecord);inline; - begin - if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_const_smallset_inline(const smallset : tsmallset);inline; - begin - if A_D in smallset then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_const_largeset_inline(const largeset : tlargeset);inline; - begin - if 'I' in largeset then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_const_smallstring_inline(const s:tsmallstring);inline; - begin - if s = RESULT_SMALLSTRING then - global_u8bit := RESULT_u8BIT; - end; - - - procedure proc_const_bigstring_inline(const s:shortstring);inline; - begin - if s = RESULT_BIGSTRING then - global_u8bit := RESULT_u8BIT; - end; - - - procedure proc_const_smallarray_inline(const arr : tsmallarray);inline; - begin - if arr[SMALL_INDEX] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_const_smallarray_open_inline(const arr : array of byte);inline; - begin - { form 0 to N-1 indexes in open arrays } - if arr[SMALL_INDEX-1] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_const_smallarray_const_1_inline(const arr : array of const);inline; - var - i: integer; - begin - global_u8bit := arr[0].vinteger and $ff; - global_ptr := arr[1].VPchar; - global_s64bit := arr[2].vInt64^; - global_char := arr[3].vchar; - global_bigstring := arr[4].VString^; - global_s64real := arr[5].VExtended^; - - global_boolean := arr[6].vboolean; -(* - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : global_u8bit := arr[i].vinteger and $ff; - vtBoolean : global_boolean := arr[i].vboolean; - vtChar : global_char := arr[i].vchar; - vtExtended : global_s64real := arr[i].VExtended^; - vtString : global_bigstring := arr[i].VString^; - vtPointer : ; - vtPChar : global_ptr := arr[i].VPchar; - vtObject : ; -{ vtClass : global_class := tclass1(arr[i].VClass);} - vtAnsiString : ; - vtInt64 : global_s64bit := arr[i].vInt64^; - else - RunError(255); - end; - end; {endfor} -*) - end; - - - procedure proc_const_smallarray_const_2_inline(const arr : array of const);inline; - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_const_formaldef_array_inline(const buf);inline; - var - p: pchar; - begin - { array is indexed from 1 } - p := @buf; - global_u8bit := byte(p[SMALL_INDEX-1]); - end; - -var - failed: boolean; - pp : ^pchar; -begin - {***************************** INLINE TESTS *******************************} - write('(Inline) const parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallrec.b := RESULT_U8BIT; - value_smallrec.w := RESULT_U16BIT; - proc_const_smallrecord_inline(value_smallrec); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); - proc_const_largerecord_inline(value_largerec); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - write('(Inline) const parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - value_smallset := [A_A,A_D]; - - proc_const_smallset_inline(value_smallset); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_largeset := ['I']; - proc_const_largeset_inline(value_largeset); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - clear_globals; - clear_values; - write('(Inline) const parameter test (src : LOC_REFERENCE (stringdef)))...'); - failed := false; - value_smallstring := RESULT_SMALLSTRING; - - proc_const_smallstring_inline(value_smallstring); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_bigstring := RESULT_BIGSTRING; - proc_const_bigstring_inline(value_bigstring); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - write('(Inline) Const parameter test (src : LOC_REFERENCE (formaldef)))...'); - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_formaldef_array_inline(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - - write('Inline const parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_smallarray_inline(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_smallarray_open_inline(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - value_u8bit := RESULT_U8BIT; - value_ptr := RESULT_PCHAR; - value_s64bit := RESULT_S64BIT; - value_smallstring := RESULT_SMALLSTRING; - value_class := tclass1.create; - value_boolean := RESULT_BOOLEAN; - value_char := RESULT_CHAR; - value_s64real:=RESULT_S64REAL; - proc_const_smallarray_const_1_inline([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,value_boolean,value_class]); - - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if global_char <> RESULT_CHAR then - failed := true; - if global_boolean <> RESULT_BOOLEAN then - failed:=true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed := true; - if global_bigstring <> RESULT_SMALLSTRING then - failed := true; - if global_ptr <> value_ptr then - failed := true; -{ if value_class <> global_class then - failed := true;!!!!!!!!!!!!!!!!!!!!} - if global_s64bit <> RESULT_S64BIT then - failed := true; - if assigned(value_class) then - value_class.destroy; - - global_u8bit := 0; - proc_const_smallarray_const_2_inline([]); - if global_u8bit <> RESULT_U8BIT 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 } +{ (const parameters) } +{****************************************************************} +program tcalcst2; +{$ifdef fpc} + {$mode objfpc} + {$INLINE ON} +{$endif} +{$R+} + +{$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 + tclass1 = class + end; + + 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_s64bit : int64; + global_s32real : single; + global_s64real : double; + global_ptr : pchar; + global_proc : tprocedure; + global_class : tclass1; + global_bigstring : shortstring; + global_boolean : boolean; + global_char : char; + value_u8bit : byte; + value_u16bit : word; + value_s32bit : longint; + value_s64bit : int64; + value_s32real : single; + value_s64real : double; + value_proc : tprocedure; + value_ptr : pchar; + value_class : tclass1; + 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_s64bit := 0; + global_s32real := 0.0; + global_s64real := 0.0; + global_ptr := nil; + global_proc := nil; + global_class := nil; + global_bigstring := ''; + global_boolean := false; + global_char := #0; + end; + + + procedure clear_values; + begin + value_u8bit := 0; + value_u16bit := 0; + value_s32bit := 0; + value_s64bit := 0; + value_s32real := 0.0; + value_s64real := 0.0; + value_proc := nil; + value_ptr := nil; + value_class := 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; + end; + + + procedure testprocedure; + begin + end; + + function getu8bit : byte; + begin + getu8bit:=RESULT_U8BIT; + end; + + function getu16bit: word; + begin + getu16bit:=RESULT_U16BIT; + end; + + function gets32bit: longint; + begin + gets32bit:=RESULT_S32BIT; + end; + + function gets64bit: int64; + begin + gets64bit:=RESULT_S64BIT; + end; + + + function gets32real: single; + begin + gets32real:=RESULT_S32REAL; + end; + + function gets64real: double; + begin + gets64real:=RESULT_S64REAL; + end; + + + {************************************************************************} + { CONST PARAMETERS (INLINE) } + {************************************************************************} + + procedure proc_const_smallrecord_inline(const smallrec : tsmallrecord);inline; + begin + if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_const_largerecord_inline(const largerec : tlargerecord);inline; + begin + if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_const_smallset_inline(const smallset : tsmallset);inline; + begin + if A_D in smallset then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_const_largeset_inline(const largeset : tlargeset);inline; + begin + if 'I' in largeset then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_const_smallstring_inline(const s:tsmallstring);inline; + begin + if s = RESULT_SMALLSTRING then + global_u8bit := RESULT_u8BIT; + end; + + + procedure proc_const_bigstring_inline(const s:shortstring);inline; + begin + if s = RESULT_BIGSTRING then + global_u8bit := RESULT_u8BIT; + end; + + + procedure proc_const_smallarray_inline(const arr : tsmallarray);inline; + begin + if arr[SMALL_INDEX] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_const_smallarray_open_inline(const arr : array of byte);inline; + begin + { form 0 to N-1 indexes in open arrays } + if arr[SMALL_INDEX-1] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_const_smallarray_const_1_inline(const arr : array of const);inline; + var + i: integer; + begin + global_u8bit := arr[0].vinteger and $ff; + global_ptr := arr[1].VPchar; + global_s64bit := arr[2].vInt64^; + global_char := arr[3].vchar; + global_bigstring := arr[4].VString^; + global_s64real := arr[5].VExtended^; + + global_boolean := arr[6].vboolean; +(* + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : global_u8bit := arr[i].vinteger and $ff; + vtBoolean : global_boolean := arr[i].vboolean; + vtChar : global_char := arr[i].vchar; + vtExtended : global_s64real := arr[i].VExtended^; + vtString : global_bigstring := arr[i].VString^; + vtPointer : ; + vtPChar : global_ptr := arr[i].VPchar; + vtObject : ; +{ vtClass : global_class := tclass1(arr[i].VClass);} + vtAnsiString : ; + vtInt64 : global_s64bit := arr[i].vInt64^; + else + RunError(255); + end; + end; {endfor} +*) + end; + + + procedure proc_const_smallarray_const_2_inline(const arr : array of const);inline; + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_const_formaldef_array_inline(const buf);inline; + var + p: pchar; + begin + { array is indexed from 1 } + p := @buf; + global_u8bit := byte(p[SMALL_INDEX-1]); + end; + +var + failed: boolean; + pp : ^pchar; +begin + {***************************** INLINE TESTS *******************************} + write('(Inline) const parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallrec.b := RESULT_U8BIT; + value_smallrec.w := RESULT_U16BIT; + proc_const_smallrecord_inline(value_smallrec); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); + proc_const_largerecord_inline(value_largerec); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + write('(Inline) const parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + value_smallset := [A_A,A_D]; + + proc_const_smallset_inline(value_smallset); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_largeset := ['I']; + proc_const_largeset_inline(value_largeset); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + clear_globals; + clear_values; + write('(Inline) const parameter test (src : LOC_REFERENCE (stringdef)))...'); + failed := false; + value_smallstring := RESULT_SMALLSTRING; + + proc_const_smallstring_inline(value_smallstring); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_bigstring := RESULT_BIGSTRING; + proc_const_bigstring_inline(value_bigstring); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + write('(Inline) Const parameter test (src : LOC_REFERENCE (formaldef)))...'); + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_formaldef_array_inline(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + + write('Inline const parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_smallarray_inline(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_smallarray_open_inline(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + value_u8bit := RESULT_U8BIT; + value_ptr := RESULT_PCHAR; + value_s64bit := RESULT_S64BIT; + value_smallstring := RESULT_SMALLSTRING; + value_class := tclass1.create; + value_boolean := RESULT_BOOLEAN; + value_char := RESULT_CHAR; + value_s64real:=RESULT_S64REAL; + proc_const_smallarray_const_1_inline([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,value_boolean,value_class]); + + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if global_char <> RESULT_CHAR then + failed := true; + if global_boolean <> RESULT_BOOLEAN then + failed:=true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed := true; + if global_bigstring <> RESULT_SMALLSTRING then + failed := true; + if global_ptr <> value_ptr then + failed := true; +{ if value_class <> global_class then + failed := true;!!!!!!!!!!!!!!!!!!!!} + if global_s64bit <> RESULT_S64BIT then + failed := true; + if assigned(value_class) then + value_class.destroy; + + global_u8bit := 0; + proc_const_smallarray_const_2_inline([]); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + +end. + +{ $Log$ - Revision 1.4 2002-09-22 09:08:40 carl - * gets64bit was not returning an int64! - - Revision 1.3 2002/09/07 15:40:50 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/10 16:34:30 carl - + first tries at first calln testing - - Revision 1.1 2002/04/01 18:05:39 carl - + const parameter passing tests (currently crashes) - -} + Revision 1.5 2003-04-22 10:24:29 florian + * fixed defines for powerpc + + Revision 1.4 2002/09/22 09:08:40 carl + * gets64bit was not returning an int64! + + Revision 1.3 2002/09/07 15:40:50 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/10 16:34:30 carl + + first tries at first calln testing + + Revision 1.1 2002/04/01 18:05:39 carl + + const parameter passing tests (currently crashes) + +} diff --git a/tests/test/cg/tcalcst3.pp b/tests/test/cg/tcalcst3.pp index 4d845eeff7..1af3df3595 100644 --- a/tests/test/cg/tcalcst3.pp +++ b/tests/test/cg/tcalcst3.pp @@ -1,862 +1,864 @@ -{****************************************************************} -{ 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 } -{ (const parameters with pascal calling convention) } -{****************************************************************} -program tcalcst3; -{$ifdef fpc} - {$mode objfpc} - {$INLINE ON} -{$endif} -{$R+} - -{$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; - {$endif} - {$ifdef cpui386} - 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; - value_u8bit : byte; - value_u16bit : word; - value_s32bit : longint; -{$ifndef tp} - global_class : tclass1; - global_s64bit : int64; - value_s64bit : int64; - value_class : tclass1; -{$endif} - 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; -{$ifndef tp} - global_s64bit := 0; - global_class := nil; -{$endif} - 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; -{$ifndef tp} - value_s64bit := 0; - value_class := nil; -{$endif} - 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; - end; - - - procedure testprocedure; - begin - end; - - function getu8bit : byte; - begin - getu8bit:=RESULT_U8BIT; - end; - - function getu16bit: word; - begin - getu16bit:=RESULT_U16BIT; - end; - - function gets32bit: longint; - begin - gets32bit:=RESULT_S32BIT; - end; - - function gets64bit: int64; - begin - gets64bit:=RESULT_S64BIT; - end; - - - function gets32real: single; - begin - gets32real:=RESULT_S32REAL; - end; - - function gets64real: double; - begin - gets64real:=RESULT_S64REAL; - end; - - {************************************************************************} - { CONST PARAMETERS } - {************************************************************************} - procedure proc_const_s32bit(const v : longint);pascal; - begin - global_s32bit := v; - end; - -{$ifndef tp} - procedure proc_const_s64bit(const v: int64);pascal; - begin - global_s64bit:= v; - end; - - procedure proc_const_smallarray_const_1(const arr : array of const);pascal; - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : global_u8bit := arr[i].vinteger and $ff; - vtBoolean : global_boolean := arr[i].vboolean; - vtChar : global_char := arr[i].vchar; - vtExtended : global_s64real := arr[i].VExtended^; - vtString : global_bigstring := arr[i].VString^; - vtPointer : ; - vtPChar : global_ptr := arr[i].VPchar; - vtObject : ; -{ vtClass : global_class := (arr[i].VClass) as tclass1;} - vtAnsiString : ; - vtInt64 : global_s64bit := arr[i].vInt64^; - else - RunError(255); - end; - end; {endfor} - end; - - - procedure proc_const_smallarray_const_2(const arr : array of const);pascal; - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - end; - -{$endif} - - - procedure proc_const_smallrecord(const smallrec : tsmallrecord);pascal; - begin - if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_const_largerecord(const largerec : tlargerecord);pascal; - begin - if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_const_smallset(const smallset : tsmallset);pascal; - begin - if A_D in smallset then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_const_largeset(const largeset : tlargeset);pascal; - begin - if 'I' in largeset then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_const_smallstring(const s:tsmallstring);pascal; - begin - if s = RESULT_SMALLSTRING then - global_u8bit := RESULT_u8BIT; - end; - - - procedure proc_const_bigstring(const s:shortstring);pascal; - begin - if s = RESULT_BIGSTRING then - global_u8bit := RESULT_u8BIT; - end; - - - procedure proc_const_smallarray(const arr : tsmallarray);pascal; - begin - if arr[SMALL_INDEX] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_const_smallarray_open(const arr : array of byte);pascal; - begin - { form 0 to N-1 indexes in open arrays } - if arr[SMALL_INDEX-1] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - end; - - - - - procedure proc_const_formaldef_array(const buf);pascal; - var - p: pchar; - begin - { array is indexed from 1 } - p := @buf; - global_u8bit := byte(p[SMALL_INDEX-1]); - end; - - - {************************************************************************} - { MIXED CONST PARAMETERS } - {************************************************************************} - procedure proc_const_s32bit_mixed(b1: byte; const v : longint; b2: byte);pascal; - begin - global_s32bit := v; - value_u8bit := b2; - end; - -{$ifndef tp} - procedure proc_const_s64bit_mixed(b1 : byte; const v: int64; b2: byte);pascal; - begin - global_s64bit:= v; - value_u8bit := b2; - end; - - procedure proc_const_smallarray_const_1_mixed(b1 : byte; const arr : array of const; b2: byte);pascal; - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : global_u8bit := arr[i].vinteger and $ff; - vtBoolean : global_boolean := arr[i].vboolean; - vtChar : global_char := arr[i].vchar; - vtExtended : global_s64real := arr[i].VExtended^; - vtString : global_bigstring := arr[i].VString^; - vtPointer : ; - vtPChar : global_ptr := arr[i].VPchar; - vtObject : ; -{ vtClass : global_class := (arr[i].VClass) as tclass1;} - vtAnsiString : ; - vtInt64 : global_s64bit := arr[i].vInt64^; - else - RunError(255); - end; - end; {endfor} - value_u8bit := b2; - end; - - - procedure proc_const_smallarray_const_2_mixed(b1: byte; const arr : array of const; b2: byte);pascal; - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; -{$endif} - - - procedure proc_const_smallrecord_mixed(b1 : byte; const smallrec : tsmallrecord; b2: byte);pascal; - begin - if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - procedure proc_const_largerecord_mixed(b1: byte; const largerec : tlargerecord; b2: byte);pascal; - begin - if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - procedure proc_const_smallset_mixed(b1: byte; const smallset : tsmallset; b2: byte);pascal; - begin - if A_D in smallset then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - procedure proc_const_largeset_mixed(b1: byte; const largeset : tlargeset; b2: byte);pascal; - begin - if 'I' in largeset then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - procedure proc_const_smallstring_mixed(b1: byte; const s:tsmallstring; b2: byte);pascal; - begin - if s = RESULT_SMALLSTRING then - global_u8bit := RESULT_u8BIT; - value_u8bit := b2; - end; - - - procedure proc_const_bigstring_mixed(b1: byte; const s:shortstring; b2: byte);pascal; - begin - if s = RESULT_BIGSTRING then - global_u8bit := RESULT_u8BIT; - value_u8bit := b2; - end; - - - procedure proc_const_smallarray_mixed(b1: byte; const arr : tsmallarray; b2: byte); - begin - if arr[SMALL_INDEX] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - procedure proc_const_smallarray_open_mixed(b1: byte; const arr : array of byte; b2: byte);pascal; - begin - { form 0 to N-1 indexes in open arrays } - if arr[high(arr)] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - - - procedure proc_const_formaldef_array_mixed(b1: byte; const buf; b2: byte);pascal; - var - p: pchar; - begin - { array is indexed from 1 } - p := @buf; - global_u8bit := byte(p[SMALL_INDEX-1]); - value_u8bit := b2; - end; - - -var - failed: boolean; - pp : ^pchar; -begin - {***************************** NORMAL TESTS *******************************} - write('Const parameter test (src : LOC_REGISTER (orddef)))...'); - clear_globals; - clear_values; - failed:=false; - - proc_const_s32bit(gets32bit); - if global_s32bit <> RESULT_S32BIT then - failed:=true; -{$ifndef tp} - proc_const_s64bit(gets64bit); - if global_s64bit <> RESULT_S64BIT then - failed:=true; -{$endif} - - if failed then - fail - else - WriteLn('Passed!'); - - write('Const parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallrec.b := RESULT_U8BIT; - value_smallrec.w := RESULT_U16BIT; - proc_const_smallrecord(value_smallrec); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); - proc_const_largerecord(value_largerec); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('const parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallset := [A_A,A_D]; - proc_const_smallset(value_smallset); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_largeset := ['I']; - proc_const_largeset(value_largeset); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - - - write('const parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - value_smallstring := RESULT_SMALLSTRING; - - proc_const_smallstring(value_smallstring); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_bigstring := RESULT_BIGSTRING; - proc_const_bigstring(value_bigstring); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - - write('Const parameter test (src : LOC_REFERENCE (formaldef)))...'); - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_formaldef_array(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Const parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_smallarray(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_smallarray_open(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - -{$ifndef tp} - clear_globals; - clear_values; - - value_u8bit := RESULT_U8BIT; - value_ptr := RESULT_PCHAR; - value_s64bit := RESULT_S64BIT; - value_smallstring := RESULT_SMALLSTRING; - value_class := tclass1.create; - value_boolean := RESULT_BOOLEAN; - value_char := RESULT_CHAR; - value_s64real:=RESULT_S64REAL; - proc_const_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real, - value_boolean,value_class]); - - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if global_char <> RESULT_CHAR then - failed := true; - if global_boolean <> RESULT_BOOLEAN then - failed:=true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed := true; - if global_bigstring <> RESULT_SMALLSTRING then - failed := true; - if global_ptr <> value_ptr then - failed := true; -{ if value_class <> global_class then - failed := true;!!!!!!!!!!!!!!!!!!!!} - if global_s64bit <> RESULT_S64BIT then - failed := true; - if assigned(value_class) then - value_class.destroy; - - global_u8bit := 0; - proc_const_smallarray_const_2([]); - if global_u8bit <> RESULT_U8BIT then - failed := true; -{$endif} - - if failed then - fail - else - WriteLn('Passed!'); - - - {***************************** MIXED TESTS *******************************} - write('Mixed const parameter test (src : LOC_REGISTER (orddef)))...'); - clear_globals; - clear_values; - failed:=false; - - proc_const_s32bit_mixed(RESULT_U8BIT,gets32bit,RESULT_U8BIT); - if global_s32bit <> RESULT_S32BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$ifndef tp} - proc_const_s64bit_mixed(RESULT_U8BIT,gets64bit,RESULT_U8BIT); - if global_s64bit <> RESULT_S64BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$endif} - if failed then - fail - else - WriteLn('Passed!'); - - write('Mixed const parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallrec.b := RESULT_U8BIT; - value_smallrec.w := RESULT_U16BIT; - proc_const_smallrecord_mixed(RESULT_U8BIT,value_smallrec,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); - proc_const_largerecord_mixed(RESULT_U8BIT,value_largerec,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Mixed const parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallset := [A_A,A_D]; - proc_const_smallset_mixed(RESULT_U8BIT,value_smallset,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_largeset := ['I']; - proc_const_largeset_mixed(RESULT_U8BIT,value_largeset,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - write('Mixed const parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - value_smallstring := RESULT_SMALLSTRING; - - proc_const_smallstring_mixed(RESULT_U8BIT,value_smallstring,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_bigstring := RESULT_BIGSTRING; - proc_const_bigstring_mixed(RESULT_U8BIT,value_bigstring,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - write('Mixed const parameter test (src : LOC_REFERENCE (formaldef)))...'); - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_formaldef_array_mixed(RESULT_U8BIT,value_smallarray,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Mixed const parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_smallarray_mixed(RESULT_U8BIt,value_smallarray,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_smallarray_open_mixed(RESULT_U8BIT,value_smallarray,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - -{$ifndef tp} - clear_globals; - clear_values; - - value_u8bit := RESULT_U8BIT; - value_ptr := RESULT_PCHAR; - value_s64bit := RESULT_S64BIT; - value_smallstring := RESULT_SMALLSTRING; - value_class := tclass1.create; - value_boolean := RESULT_BOOLEAN; - value_char := RESULT_CHAR; - value_s64real:=RESULT_S64REAL; - proc_const_smallarray_const_1_mixed(RESULT_U8BIT, [value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring, - value_s64real,value_boolean,value_class],RESULT_U8BIT); - - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if global_char <> RESULT_CHAR then - failed := true; - if global_boolean <> RESULT_BOOLEAN then - failed:=true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed := true; - if global_bigstring <> RESULT_SMALLSTRING then - failed := true; - if global_ptr <> value_ptr then - failed := true; -{ if value_class <> global_class then - failed := true;!!!!!!!!!!!!!!!!!!!!} - if global_s64bit <> RESULT_S64BIT then - failed := true; - if assigned(value_class) then - value_class.destroy; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - global_u8bit := 0; - proc_const_smallarray_const_2_mixed(RESULT_U8BIT,[],RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$endif} - - 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 } +{ (const parameters with pascal calling convention) } +{****************************************************************} +program tcalcst3; +{$ifdef fpc} + {$mode objfpc} + {$INLINE ON} +{$endif} +{$R+} + +{$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; + value_u8bit : byte; + value_u16bit : word; + value_s32bit : longint; +{$ifndef tp} + global_class : tclass1; + global_s64bit : int64; + value_s64bit : int64; + value_class : tclass1; +{$endif} + 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; +{$ifndef tp} + global_s64bit := 0; + global_class := nil; +{$endif} + 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; +{$ifndef tp} + value_s64bit := 0; + value_class := nil; +{$endif} + 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; + end; + + + procedure testprocedure; + begin + end; + + function getu8bit : byte; + begin + getu8bit:=RESULT_U8BIT; + end; + + function getu16bit: word; + begin + getu16bit:=RESULT_U16BIT; + end; + + function gets32bit: longint; + begin + gets32bit:=RESULT_S32BIT; + end; + + function gets64bit: int64; + begin + gets64bit:=RESULT_S64BIT; + end; + + + function gets32real: single; + begin + gets32real:=RESULT_S32REAL; + end; + + function gets64real: double; + begin + gets64real:=RESULT_S64REAL; + end; + + {************************************************************************} + { CONST PARAMETERS } + {************************************************************************} + procedure proc_const_s32bit(const v : longint);pascal; + begin + global_s32bit := v; + end; + +{$ifndef tp} + procedure proc_const_s64bit(const v: int64);pascal; + begin + global_s64bit:= v; + end; + + procedure proc_const_smallarray_const_1(const arr : array of const);pascal; + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : global_u8bit := arr[i].vinteger and $ff; + vtBoolean : global_boolean := arr[i].vboolean; + vtChar : global_char := arr[i].vchar; + vtExtended : global_s64real := arr[i].VExtended^; + vtString : global_bigstring := arr[i].VString^; + vtPointer : ; + vtPChar : global_ptr := arr[i].VPchar; + vtObject : ; +{ vtClass : global_class := (arr[i].VClass) as tclass1;} + vtAnsiString : ; + vtInt64 : global_s64bit := arr[i].vInt64^; + else + RunError(255); + end; + end; {endfor} + end; + + + procedure proc_const_smallarray_const_2(const arr : array of const);pascal; + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + end; + +{$endif} + + + procedure proc_const_smallrecord(const smallrec : tsmallrecord);pascal; + begin + if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_const_largerecord(const largerec : tlargerecord);pascal; + begin + if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_const_smallset(const smallset : tsmallset);pascal; + begin + if A_D in smallset then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_const_largeset(const largeset : tlargeset);pascal; + begin + if 'I' in largeset then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_const_smallstring(const s:tsmallstring);pascal; + begin + if s = RESULT_SMALLSTRING then + global_u8bit := RESULT_u8BIT; + end; + + + procedure proc_const_bigstring(const s:shortstring);pascal; + begin + if s = RESULT_BIGSTRING then + global_u8bit := RESULT_u8BIT; + end; + + + procedure proc_const_smallarray(const arr : tsmallarray);pascal; + begin + if arr[SMALL_INDEX] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_const_smallarray_open(const arr : array of byte);pascal; + begin + { form 0 to N-1 indexes in open arrays } + if arr[SMALL_INDEX-1] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + end; + + + + + procedure proc_const_formaldef_array(const buf);pascal; + var + p: pchar; + begin + { array is indexed from 1 } + p := @buf; + global_u8bit := byte(p[SMALL_INDEX-1]); + end; + + + {************************************************************************} + { MIXED CONST PARAMETERS } + {************************************************************************} + procedure proc_const_s32bit_mixed(b1: byte; const v : longint; b2: byte);pascal; + begin + global_s32bit := v; + value_u8bit := b2; + end; + +{$ifndef tp} + procedure proc_const_s64bit_mixed(b1 : byte; const v: int64; b2: byte);pascal; + begin + global_s64bit:= v; + value_u8bit := b2; + end; + + procedure proc_const_smallarray_const_1_mixed(b1 : byte; const arr : array of const; b2: byte);pascal; + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : global_u8bit := arr[i].vinteger and $ff; + vtBoolean : global_boolean := arr[i].vboolean; + vtChar : global_char := arr[i].vchar; + vtExtended : global_s64real := arr[i].VExtended^; + vtString : global_bigstring := arr[i].VString^; + vtPointer : ; + vtPChar : global_ptr := arr[i].VPchar; + vtObject : ; +{ vtClass : global_class := (arr[i].VClass) as tclass1;} + vtAnsiString : ; + vtInt64 : global_s64bit := arr[i].vInt64^; + else + RunError(255); + end; + end; {endfor} + value_u8bit := b2; + end; + + + procedure proc_const_smallarray_const_2_mixed(b1: byte; const arr : array of const; b2: byte);pascal; + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; +{$endif} + + + procedure proc_const_smallrecord_mixed(b1 : byte; const smallrec : tsmallrecord; b2: byte);pascal; + begin + if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + procedure proc_const_largerecord_mixed(b1: byte; const largerec : tlargerecord; b2: byte);pascal; + begin + if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + procedure proc_const_smallset_mixed(b1: byte; const smallset : tsmallset; b2: byte);pascal; + begin + if A_D in smallset then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + procedure proc_const_largeset_mixed(b1: byte; const largeset : tlargeset; b2: byte);pascal; + begin + if 'I' in largeset then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + procedure proc_const_smallstring_mixed(b1: byte; const s:tsmallstring; b2: byte);pascal; + begin + if s = RESULT_SMALLSTRING then + global_u8bit := RESULT_u8BIT; + value_u8bit := b2; + end; + + + procedure proc_const_bigstring_mixed(b1: byte; const s:shortstring; b2: byte);pascal; + begin + if s = RESULT_BIGSTRING then + global_u8bit := RESULT_u8BIT; + value_u8bit := b2; + end; + + + procedure proc_const_smallarray_mixed(b1: byte; const arr : tsmallarray; b2: byte); + begin + if arr[SMALL_INDEX] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + procedure proc_const_smallarray_open_mixed(b1: byte; const arr : array of byte; b2: byte);pascal; + begin + { form 0 to N-1 indexes in open arrays } + if arr[high(arr)] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + + + procedure proc_const_formaldef_array_mixed(b1: byte; const buf; b2: byte);pascal; + var + p: pchar; + begin + { array is indexed from 1 } + p := @buf; + global_u8bit := byte(p[SMALL_INDEX-1]); + value_u8bit := b2; + end; + + +var + failed: boolean; + pp : ^pchar; +begin + {***************************** NORMAL TESTS *******************************} + write('Const parameter test (src : LOC_REGISTER (orddef)))...'); + clear_globals; + clear_values; + failed:=false; + + proc_const_s32bit(gets32bit); + if global_s32bit <> RESULT_S32BIT then + failed:=true; +{$ifndef tp} + proc_const_s64bit(gets64bit); + if global_s64bit <> RESULT_S64BIT then + failed:=true; +{$endif} + + if failed then + fail + else + WriteLn('Passed!'); + + write('Const parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallrec.b := RESULT_U8BIT; + value_smallrec.w := RESULT_U16BIT; + proc_const_smallrecord(value_smallrec); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); + proc_const_largerecord(value_largerec); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('const parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallset := [A_A,A_D]; + proc_const_smallset(value_smallset); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_largeset := ['I']; + proc_const_largeset(value_largeset); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + + + write('const parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + value_smallstring := RESULT_SMALLSTRING; + + proc_const_smallstring(value_smallstring); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_bigstring := RESULT_BIGSTRING; + proc_const_bigstring(value_bigstring); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + + write('Const parameter test (src : LOC_REFERENCE (formaldef)))...'); + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_formaldef_array(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Const parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_smallarray(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_smallarray_open(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + +{$ifndef tp} + clear_globals; + clear_values; + + value_u8bit := RESULT_U8BIT; + value_ptr := RESULT_PCHAR; + value_s64bit := RESULT_S64BIT; + value_smallstring := RESULT_SMALLSTRING; + value_class := tclass1.create; + value_boolean := RESULT_BOOLEAN; + value_char := RESULT_CHAR; + value_s64real:=RESULT_S64REAL; + proc_const_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real, + value_boolean,value_class]); + + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if global_char <> RESULT_CHAR then + failed := true; + if global_boolean <> RESULT_BOOLEAN then + failed:=true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed := true; + if global_bigstring <> RESULT_SMALLSTRING then + failed := true; + if global_ptr <> value_ptr then + failed := true; +{ if value_class <> global_class then + failed := true;!!!!!!!!!!!!!!!!!!!!} + if global_s64bit <> RESULT_S64BIT then + failed := true; + if assigned(value_class) then + value_class.destroy; + + global_u8bit := 0; + proc_const_smallarray_const_2([]); + if global_u8bit <> RESULT_U8BIT then + failed := true; +{$endif} + + if failed then + fail + else + WriteLn('Passed!'); + + + {***************************** MIXED TESTS *******************************} + write('Mixed const parameter test (src : LOC_REGISTER (orddef)))...'); + clear_globals; + clear_values; + failed:=false; + + proc_const_s32bit_mixed(RESULT_U8BIT,gets32bit,RESULT_U8BIT); + if global_s32bit <> RESULT_S32BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$ifndef tp} + proc_const_s64bit_mixed(RESULT_U8BIT,gets64bit,RESULT_U8BIT); + if global_s64bit <> RESULT_S64BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$endif} + if failed then + fail + else + WriteLn('Passed!'); + + write('Mixed const parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallrec.b := RESULT_U8BIT; + value_smallrec.w := RESULT_U16BIT; + proc_const_smallrecord_mixed(RESULT_U8BIT,value_smallrec,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); + proc_const_largerecord_mixed(RESULT_U8BIT,value_largerec,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Mixed const parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallset := [A_A,A_D]; + proc_const_smallset_mixed(RESULT_U8BIT,value_smallset,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_largeset := ['I']; + proc_const_largeset_mixed(RESULT_U8BIT,value_largeset,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + write('Mixed const parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + value_smallstring := RESULT_SMALLSTRING; + + proc_const_smallstring_mixed(RESULT_U8BIT,value_smallstring,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_bigstring := RESULT_BIGSTRING; + proc_const_bigstring_mixed(RESULT_U8BIT,value_bigstring,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + write('Mixed const parameter test (src : LOC_REFERENCE (formaldef)))...'); + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_formaldef_array_mixed(RESULT_U8BIT,value_smallarray,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Mixed const parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_smallarray_mixed(RESULT_U8BIt,value_smallarray,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_smallarray_open_mixed(RESULT_U8BIT,value_smallarray,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + +{$ifndef tp} + clear_globals; + clear_values; + + value_u8bit := RESULT_U8BIT; + value_ptr := RESULT_PCHAR; + value_s64bit := RESULT_S64BIT; + value_smallstring := RESULT_SMALLSTRING; + value_class := tclass1.create; + value_boolean := RESULT_BOOLEAN; + value_char := RESULT_CHAR; + value_s64real:=RESULT_S64REAL; + proc_const_smallarray_const_1_mixed(RESULT_U8BIT, [value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring, + value_s64real,value_boolean,value_class],RESULT_U8BIT); + + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if global_char <> RESULT_CHAR then + failed := true; + if global_boolean <> RESULT_BOOLEAN then + failed:=true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed := true; + if global_bigstring <> RESULT_SMALLSTRING then + failed := true; + if global_ptr <> value_ptr then + failed := true; +{ if value_class <> global_class then + failed := true;!!!!!!!!!!!!!!!!!!!!} + if global_s64bit <> RESULT_S64BIT then + failed := true; + if assigned(value_class) then + value_class.destroy; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + global_u8bit := 0; + proc_const_smallarray_const_2_mixed(RESULT_U8BIT,[],RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$endif} + + if failed then + fail + else + WriteLn('Passed!'); +end. + +{ $Log$ - Revision 1.4 2002-09-22 09:08:40 carl - * gets64bit was not returning an int64! - - Revision 1.3 2002/09/07 15:40:50 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 17:47:06 carl - + constant parameter passing for different calling conventions - -} + Revision 1.5 2003-04-22 10:24:29 florian + * fixed defines for powerpc + + Revision 1.4 2002/09/22 09:08:40 carl + * gets64bit was not returning an int64! + + Revision 1.3 2002/09/07 15:40:50 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 17:47:06 carl + + constant parameter passing for different calling conventions + +} diff --git a/tests/test/cg/tcalcst4.pp b/tests/test/cg/tcalcst4.pp index 6f44a9e8aa..fc2fe066e6 100644 --- a/tests/test/cg/tcalcst4.pp +++ b/tests/test/cg/tcalcst4.pp @@ -1,702 +1,704 @@ -{****************************************************************} -{ 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 } -{ (const parameters with cdecl calling convention) } -{****************************************************************} -program tcalcst4; -{$ifdef fpc} - {$mode objfpc} - {$INLINE ON} -{$endif} -{$R+} - -{$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; - {$endif} - {$ifdef cpui386} - 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; - value_u8bit : byte; - value_u16bit : word; - value_s32bit : longint; -{$ifndef tp} - global_class : tclass1; - global_s64bit : int64; - value_s64bit : int64; - value_class : tclass1; -{$endif} - 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; -{$ifndef tp} - global_s64bit := 0; - global_class := nil; -{$endif} - 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; -{$ifndef tp} - value_s64bit := 0; - value_class := nil; -{$endif} - 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; - end; - - - procedure testprocedure; - begin - end; - - function getu8bit : byte; - begin - getu8bit:=RESULT_U8BIT; - end; - - function getu16bit: word; - begin - getu16bit:=RESULT_U16BIT; - end; - - function gets32bit: longint; - begin - gets32bit:=RESULT_S32BIT; - end; - - function gets64bit: int64; - begin - gets64bit:=RESULT_S64BIT; - end; - - - function gets32real: single; - begin - gets32real:=RESULT_S32REAL; - end; - - function gets64real: double; - begin - gets64real:=RESULT_S64REAL; - end; - - {************************************************************************} - { CONST PARAMETERS } - {************************************************************************} - procedure proc_const_s32bit(const v : longint);cdecl; - begin - global_s32bit := v; - end; - -{$ifndef tp} - procedure proc_const_s64bit(const v: int64);cdecl; - begin - global_s64bit:= v; - end; - -{$endif} - - - procedure proc_const_smallrecord(const smallrec : tsmallrecord);cdecl; - begin - if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_const_largerecord(const largerec : tlargerecord);cdecl; - begin - if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_const_smallset(const smallset : tsmallset);cdecl; - begin - if A_D in smallset then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_const_largeset(const largeset : tlargeset);cdecl; - begin - if 'I' in largeset then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_const_smallstring(const s:tsmallstring);cdecl; - begin - if s = RESULT_SMALLSTRING then - global_u8bit := RESULT_u8BIT; - end; - - - procedure proc_const_bigstring(const s:shortstring);cdecl; - begin - if s = RESULT_BIGSTRING then - global_u8bit := RESULT_u8BIT; - end; - - - procedure proc_const_smallarray(const arr : tsmallarray);cdecl; - begin - if arr[SMALL_INDEX] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_const_smallarray_open(const arr : array of byte);cdecl; - begin - { form 0 to N-1 indexes in open arrays } - if arr[SMALL_INDEX-1] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - end; - - - - - procedure proc_const_formaldef_array(const buf);cdecl; - var - p: pchar; - begin - { array is indexed from 1 } - p := @buf; - global_u8bit := byte(p[SMALL_INDEX-1]); - end; - - - {************************************************************************} - { MIXED CONST PARAMETERS } - {************************************************************************} - procedure proc_const_s32bit_mixed(b1: byte; const v : longint; b2: byte);cdecl; - begin - global_s32bit := v; - value_u8bit := b2; - end; - -{$ifndef tp} - procedure proc_const_s64bit_mixed(b1 : byte; const v: int64; b2: byte);cdecl; - begin - global_s64bit:= v; - value_u8bit := b2; - end; - -{$endif} - - - procedure proc_const_smallrecord_mixed(b1 : byte; const smallrec : tsmallrecord; b2: byte);cdecl; - begin - if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - procedure proc_const_largerecord_mixed(b1: byte; const largerec : tlargerecord; b2: byte);cdecl; - begin - if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - procedure proc_const_smallset_mixed(b1: byte; const smallset : tsmallset; b2: byte);cdecl; - begin - if A_D in smallset then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - procedure proc_const_largeset_mixed(b1: byte; const largeset : tlargeset; b2: byte);cdecl; - begin - if 'I' in largeset then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - procedure proc_const_smallstring_mixed(b1: byte; const s:tsmallstring; b2: byte);cdecl; - begin - if s = RESULT_SMALLSTRING then - global_u8bit := RESULT_u8BIT; - value_u8bit := b2; - end; - - - procedure proc_const_bigstring_mixed(b1: byte; const s:shortstring; b2: byte);cdecl; - begin - if s = RESULT_BIGSTRING then - global_u8bit := RESULT_u8BIT; - value_u8bit := b2; - end; - - - procedure proc_const_smallarray_mixed(b1: byte; const arr : tsmallarray; b2: byte);cdecl; - begin - if arr[SMALL_INDEX] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - - - - procedure proc_const_formaldef_array_mixed(b1: byte; const buf; b2: byte);cdecl; - var - p: pchar; - begin - { array is indexed from 1 } - p := @buf; - global_u8bit := byte(p[SMALL_INDEX-1]); - value_u8bit := b2; - end; - - -var - failed: boolean; - pp : ^pchar; -begin - {***************************** NORMAL TESTS *******************************} - write('Const parameter test (src : LOC_REGISTER (orddef)))...'); - clear_globals; - clear_values; - failed:=false; - - proc_const_s32bit(gets32bit); - if global_s32bit <> RESULT_S32BIT then - failed:=true; -{$ifndef tp} - proc_const_s64bit(gets64bit); - if global_s64bit <> RESULT_S64BIT then - failed:=true; -{$endif} - - if failed then - fail - else - WriteLn('Passed!'); - - write('Const parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallrec.b := RESULT_U8BIT; - value_smallrec.w := RESULT_U16BIT; - proc_const_smallrecord(value_smallrec); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); - proc_const_largerecord(value_largerec); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('const parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallset := [A_A,A_D]; - proc_const_smallset(value_smallset); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_largeset := ['I']; - proc_const_largeset(value_largeset); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - - - write('const parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - value_smallstring := RESULT_SMALLSTRING; - - proc_const_smallstring(value_smallstring); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_bigstring := RESULT_BIGSTRING; - proc_const_bigstring(value_bigstring); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - - write('Const parameter test (src : LOC_REFERENCE (formaldef)))...'); - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_formaldef_array(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Const parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_smallarray(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_smallarray_open(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - {***************************** MIXED TESTS *******************************} - write('Mixed const parameter test (src : LOC_REGISTER (orddef)))...'); - clear_globals; - clear_values; - failed:=false; - - proc_const_s32bit_mixed(RESULT_U8BIT,gets32bit,RESULT_U8BIT); - if global_s32bit <> RESULT_S32BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$ifndef tp} - proc_const_s64bit_mixed(RESULT_U8BIT,gets64bit,RESULT_U8BIT); - if global_s64bit <> RESULT_S64BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$endif} - if failed then - fail - else - WriteLn('Passed!'); - - write('Mixed const parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallrec.b := RESULT_U8BIT; - value_smallrec.w := RESULT_U16BIT; - proc_const_smallrecord_mixed(RESULT_U8BIT,value_smallrec,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); - proc_const_largerecord_mixed(RESULT_U8BIT,value_largerec,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Mixed const parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallset := [A_A,A_D]; - proc_const_smallset_mixed(RESULT_U8BIT,value_smallset,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_largeset := ['I']; - proc_const_largeset_mixed(RESULT_U8BIT,value_largeset,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - write('Mixed const parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - value_smallstring := RESULT_SMALLSTRING; - - proc_const_smallstring_mixed(RESULT_U8BIT,value_smallstring,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_bigstring := RESULT_BIGSTRING; - proc_const_bigstring_mixed(RESULT_U8BIT,value_bigstring,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - write('Mixed const parameter test (src : LOC_REFERENCE (formaldef)))...'); - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_formaldef_array_mixed(RESULT_U8BIT,value_smallarray,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Mixed const parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_smallarray_mixed(RESULT_U8BIt,value_smallarray,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT 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 } +{ (const parameters with cdecl calling convention) } +{****************************************************************} +program tcalcst4; +{$ifdef fpc} + {$mode objfpc} + {$INLINE ON} +{$endif} +{$R+} + +{$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; + value_u8bit : byte; + value_u16bit : word; + value_s32bit : longint; +{$ifndef tp} + global_class : tclass1; + global_s64bit : int64; + value_s64bit : int64; + value_class : tclass1; +{$endif} + 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; +{$ifndef tp} + global_s64bit := 0; + global_class := nil; +{$endif} + 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; +{$ifndef tp} + value_s64bit := 0; + value_class := nil; +{$endif} + 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; + end; + + + procedure testprocedure; + begin + end; + + function getu8bit : byte; + begin + getu8bit:=RESULT_U8BIT; + end; + + function getu16bit: word; + begin + getu16bit:=RESULT_U16BIT; + end; + + function gets32bit: longint; + begin + gets32bit:=RESULT_S32BIT; + end; + + function gets64bit: int64; + begin + gets64bit:=RESULT_S64BIT; + end; + + + function gets32real: single; + begin + gets32real:=RESULT_S32REAL; + end; + + function gets64real: double; + begin + gets64real:=RESULT_S64REAL; + end; + + {************************************************************************} + { CONST PARAMETERS } + {************************************************************************} + procedure proc_const_s32bit(const v : longint);cdecl; + begin + global_s32bit := v; + end; + +{$ifndef tp} + procedure proc_const_s64bit(const v: int64);cdecl; + begin + global_s64bit:= v; + end; + +{$endif} + + + procedure proc_const_smallrecord(const smallrec : tsmallrecord);cdecl; + begin + if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_const_largerecord(const largerec : tlargerecord);cdecl; + begin + if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_const_smallset(const smallset : tsmallset);cdecl; + begin + if A_D in smallset then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_const_largeset(const largeset : tlargeset);cdecl; + begin + if 'I' in largeset then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_const_smallstring(const s:tsmallstring);cdecl; + begin + if s = RESULT_SMALLSTRING then + global_u8bit := RESULT_u8BIT; + end; + + + procedure proc_const_bigstring(const s:shortstring);cdecl; + begin + if s = RESULT_BIGSTRING then + global_u8bit := RESULT_u8BIT; + end; + + + procedure proc_const_smallarray(const arr : tsmallarray);cdecl; + begin + if arr[SMALL_INDEX] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_const_smallarray_open(const arr : array of byte);cdecl; + begin + { form 0 to N-1 indexes in open arrays } + if arr[SMALL_INDEX-1] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + end; + + + + + procedure proc_const_formaldef_array(const buf);cdecl; + var + p: pchar; + begin + { array is indexed from 1 } + p := @buf; + global_u8bit := byte(p[SMALL_INDEX-1]); + end; + + + {************************************************************************} + { MIXED CONST PARAMETERS } + {************************************************************************} + procedure proc_const_s32bit_mixed(b1: byte; const v : longint; b2: byte);cdecl; + begin + global_s32bit := v; + value_u8bit := b2; + end; + +{$ifndef tp} + procedure proc_const_s64bit_mixed(b1 : byte; const v: int64; b2: byte);cdecl; + begin + global_s64bit:= v; + value_u8bit := b2; + end; + +{$endif} + + + procedure proc_const_smallrecord_mixed(b1 : byte; const smallrec : tsmallrecord; b2: byte);cdecl; + begin + if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + procedure proc_const_largerecord_mixed(b1: byte; const largerec : tlargerecord; b2: byte);cdecl; + begin + if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + procedure proc_const_smallset_mixed(b1: byte; const smallset : tsmallset; b2: byte);cdecl; + begin + if A_D in smallset then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + procedure proc_const_largeset_mixed(b1: byte; const largeset : tlargeset; b2: byte);cdecl; + begin + if 'I' in largeset then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + procedure proc_const_smallstring_mixed(b1: byte; const s:tsmallstring; b2: byte);cdecl; + begin + if s = RESULT_SMALLSTRING then + global_u8bit := RESULT_u8BIT; + value_u8bit := b2; + end; + + + procedure proc_const_bigstring_mixed(b1: byte; const s:shortstring; b2: byte);cdecl; + begin + if s = RESULT_BIGSTRING then + global_u8bit := RESULT_u8BIT; + value_u8bit := b2; + end; + + + procedure proc_const_smallarray_mixed(b1: byte; const arr : tsmallarray; b2: byte);cdecl; + begin + if arr[SMALL_INDEX] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + + + + procedure proc_const_formaldef_array_mixed(b1: byte; const buf; b2: byte);cdecl; + var + p: pchar; + begin + { array is indexed from 1 } + p := @buf; + global_u8bit := byte(p[SMALL_INDEX-1]); + value_u8bit := b2; + end; + + +var + failed: boolean; + pp : ^pchar; +begin + {***************************** NORMAL TESTS *******************************} + write('Const parameter test (src : LOC_REGISTER (orddef)))...'); + clear_globals; + clear_values; + failed:=false; + + proc_const_s32bit(gets32bit); + if global_s32bit <> RESULT_S32BIT then + failed:=true; +{$ifndef tp} + proc_const_s64bit(gets64bit); + if global_s64bit <> RESULT_S64BIT then + failed:=true; +{$endif} + + if failed then + fail + else + WriteLn('Passed!'); + + write('Const parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallrec.b := RESULT_U8BIT; + value_smallrec.w := RESULT_U16BIT; + proc_const_smallrecord(value_smallrec); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); + proc_const_largerecord(value_largerec); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('const parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallset := [A_A,A_D]; + proc_const_smallset(value_smallset); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_largeset := ['I']; + proc_const_largeset(value_largeset); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + + + write('const parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + value_smallstring := RESULT_SMALLSTRING; + + proc_const_smallstring(value_smallstring); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_bigstring := RESULT_BIGSTRING; + proc_const_bigstring(value_bigstring); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + + write('Const parameter test (src : LOC_REFERENCE (formaldef)))...'); + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_formaldef_array(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Const parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_smallarray(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_smallarray_open(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + {***************************** MIXED TESTS *******************************} + write('Mixed const parameter test (src : LOC_REGISTER (orddef)))...'); + clear_globals; + clear_values; + failed:=false; + + proc_const_s32bit_mixed(RESULT_U8BIT,gets32bit,RESULT_U8BIT); + if global_s32bit <> RESULT_S32BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$ifndef tp} + proc_const_s64bit_mixed(RESULT_U8BIT,gets64bit,RESULT_U8BIT); + if global_s64bit <> RESULT_S64BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$endif} + if failed then + fail + else + WriteLn('Passed!'); + + write('Mixed const parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallrec.b := RESULT_U8BIT; + value_smallrec.w := RESULT_U16BIT; + proc_const_smallrecord_mixed(RESULT_U8BIT,value_smallrec,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); + proc_const_largerecord_mixed(RESULT_U8BIT,value_largerec,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Mixed const parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallset := [A_A,A_D]; + proc_const_smallset_mixed(RESULT_U8BIT,value_smallset,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_largeset := ['I']; + proc_const_largeset_mixed(RESULT_U8BIT,value_largeset,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + write('Mixed const parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + value_smallstring := RESULT_SMALLSTRING; + + proc_const_smallstring_mixed(RESULT_U8BIT,value_smallstring,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_bigstring := RESULT_BIGSTRING; + proc_const_bigstring_mixed(RESULT_U8BIT,value_bigstring,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + write('Mixed const parameter test (src : LOC_REFERENCE (formaldef)))...'); + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_formaldef_array_mixed(RESULT_U8BIT,value_smallarray,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Mixed const parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_smallarray_mixed(RESULT_U8BIt,value_smallarray,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); +end. + +{ $Log$ - Revision 1.7 2002-11-20 19:39:21 carl - - high() cannot be used in cdecle'd routines - - Revision 1.6 2002/11/09 21:47:36 carl - + updated tests for correct parsing (array of const now allowed with high!) - - Revision 1.5 2002/09/22 14:16:12 carl - * fix small typo - - Revision 1.4 2002/09/22 09:08:40 carl - * gets64bit was not returning an int64! - - Revision 1.3 2002/09/07 15:40:50 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 17:47:06 carl - + constant parameter passing for different calling conventions - -} + Revision 1.8 2003-04-22 10:24:29 florian + * fixed defines for powerpc + + Revision 1.7 2002/11/20 19:39:21 carl + - high() cannot be used in cdecle'd routines + + Revision 1.6 2002/11/09 21:47:36 carl + + updated tests for correct parsing (array of const now allowed with high!) + + Revision 1.5 2002/09/22 14:16:12 carl + * fix small typo + + Revision 1.4 2002/09/22 09:08:40 carl + * gets64bit was not returning an int64! + + Revision 1.3 2002/09/07 15:40:50 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 17:47:06 carl + + constant parameter passing for different calling conventions + +} diff --git a/tests/test/cg/tcalcst5.pp b/tests/test/cg/tcalcst5.pp index 8a782bdcb3..cbe460f5de 100644 --- a/tests/test/cg/tcalcst5.pp +++ b/tests/test/cg/tcalcst5.pp @@ -1,862 +1,864 @@ -{****************************************************************} -{ 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 } -{ (const parameters with popstack calling convention) } -{****************************************************************} -program tcalcst5; -{$ifdef fpc} - {$mode objfpc} - {$INLINE ON} -{$endif} -{$R+} - -{$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; - {$endif} - {$ifdef cpui386} - 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; - value_u8bit : byte; - value_u16bit : word; - value_s32bit : longint; -{$ifndef tp} - global_class : tclass1; - global_s64bit : int64; - value_s64bit : int64; - value_class : tclass1; -{$endif} - 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; -{$ifndef tp} - global_s64bit := 0; - global_class := nil; -{$endif} - 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; -{$ifndef tp} - value_s64bit := 0; - value_class := nil; -{$endif} - 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; - end; - - - procedure testprocedure; - begin - end; - - function getu8bit : byte; - begin - getu8bit:=RESULT_U8BIT; - end; - - function getu16bit: word; - begin - getu16bit:=RESULT_U16BIT; - end; - - function gets32bit: longint; - begin - gets32bit:=RESULT_S32BIT; - end; - - function gets64bit: int64; - begin - gets64bit:=RESULT_S64BIT; - end; - - - function gets32real: single; - begin - gets32real:=RESULT_S32REAL; - end; - - function gets64real: double; - begin - gets64real:=RESULT_S64REAL; - end; - - {************************************************************************} - { CONST PARAMETERS } - {************************************************************************} - procedure proc_const_s32bit(const v : longint);popstack; - begin - global_s32bit := v; - end; - -{$ifndef tp} - procedure proc_const_s64bit(const v: int64);popstack; - begin - global_s64bit:= v; - end; - - procedure proc_const_smallarray_const_1(const arr : array of const);popstack; - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : global_u8bit := arr[i].vinteger and $ff; - vtBoolean : global_boolean := arr[i].vboolean; - vtChar : global_char := arr[i].vchar; - vtExtended : global_s64real := arr[i].VExtended^; - vtString : global_bigstring := arr[i].VString^; - vtPointer : ; - vtPChar : global_ptr := arr[i].VPchar; - vtObject : ; -{ vtClass : global_class := (arr[i].VClass) as tclass1;} - vtAnsiString : ; - vtInt64 : global_s64bit := arr[i].vInt64^; - else - RunError(255); - end; - end; {endfor} - end; - - - procedure proc_const_smallarray_const_2(const arr : array of const);popstack; - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - end; - -{$endif} - - - procedure proc_const_smallrecord(const smallrec : tsmallrecord);popstack; - begin - if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_const_largerecord(const largerec : tlargerecord);popstack; - begin - if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_const_smallset(const smallset : tsmallset);popstack; - begin - if A_D in smallset then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_const_largeset(const largeset : tlargeset);popstack; - begin - if 'I' in largeset then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_const_smallstring(const s:tsmallstring);popstack; - begin - if s = RESULT_SMALLSTRING then - global_u8bit := RESULT_u8BIT; - end; - - - procedure proc_const_bigstring(const s:shortstring);popstack; - begin - if s = RESULT_BIGSTRING then - global_u8bit := RESULT_u8BIT; - end; - - - procedure proc_const_smallarray(const arr : tsmallarray);popstack; - begin - if arr[SMALL_INDEX] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_const_smallarray_open(const arr : array of byte);popstack; - begin - { form 0 to N-1 indexes in open arrays } - if arr[SMALL_INDEX-1] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - end; - - - - - procedure proc_const_formaldef_array(const buf);popstack; - var - p: pchar; - begin - { array is indexed from 1 } - p := @buf; - global_u8bit := byte(p[SMALL_INDEX-1]); - end; - - - {************************************************************************} - { MIXED CONST PARAMETERS } - {************************************************************************} - procedure proc_const_s32bit_mixed(b1: byte; const v : longint; b2: byte);popstack; - begin - global_s32bit := v; - value_u8bit := b2; - end; - -{$ifndef tp} - procedure proc_const_s64bit_mixed(b1 : byte; const v: int64; b2: byte);popstack; - begin - global_s64bit:= v; - value_u8bit := b2; - end; - - procedure proc_const_smallarray_const_1_mixed(b1 : byte; const arr : array of const; b2: byte);popstack; - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : global_u8bit := arr[i].vinteger and $ff; - vtBoolean : global_boolean := arr[i].vboolean; - vtChar : global_char := arr[i].vchar; - vtExtended : global_s64real := arr[i].VExtended^; - vtString : global_bigstring := arr[i].VString^; - vtPointer : ; - vtPChar : global_ptr := arr[i].VPchar; - vtObject : ; -{ vtClass : global_class := (arr[i].VClass) as tclass1;} - vtAnsiString : ; - vtInt64 : global_s64bit := arr[i].vInt64^; - else - RunError(255); - end; - end; {endfor} - value_u8bit := b2; - end; - - - procedure proc_const_smallarray_const_2_mixed(b1: byte; const arr : array of const; b2: byte);popstack; - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; -{$endif} - - - procedure proc_const_smallrecord_mixed(b1 : byte; const smallrec : tsmallrecord; b2: byte);popstack; - begin - if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - procedure proc_const_largerecord_mixed(b1: byte; const largerec : tlargerecord; b2: byte);popstack; - begin - if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - procedure proc_const_smallset_mixed(b1: byte; const smallset : tsmallset; b2: byte);popstack; - begin - if A_D in smallset then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - procedure proc_const_largeset_mixed(b1: byte; const largeset : tlargeset; b2: byte);popstack; - begin - if 'I' in largeset then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - procedure proc_const_smallstring_mixed(b1: byte; const s:tsmallstring; b2: byte);popstack; - begin - if s = RESULT_SMALLSTRING then - global_u8bit := RESULT_u8BIT; - value_u8bit := b2; - end; - - - procedure proc_const_bigstring_mixed(b1: byte; const s:shortstring; b2: byte);popstack; - begin - if s = RESULT_BIGSTRING then - global_u8bit := RESULT_u8BIT; - value_u8bit := b2; - end; - - - procedure proc_const_smallarray_mixed(b1: byte; const arr : tsmallarray; b2: byte);popstack; - begin - if arr[SMALL_INDEX] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - procedure proc_const_smallarray_open_mixed(b1: byte; const arr : array of byte; b2: byte);popstack; - begin - { form 0 to N-1 indexes in open arrays } - if arr[high(arr)] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - - - procedure proc_const_formaldef_array_mixed(b1: byte; const buf; b2: byte);popstack; - var - p: pchar; - begin - { array is indexed from 1 } - p := @buf; - global_u8bit := byte(p[SMALL_INDEX-1]); - value_u8bit := b2; - end; - - -var - failed: boolean; - pp : ^pchar; -begin - {***************************** NORMAL TESTS *******************************} - write('Const parameter test (src : LOC_REGISTER (orddef)))...'); - clear_globals; - clear_values; - failed:=false; - - proc_const_s32bit(gets32bit); - if global_s32bit <> RESULT_S32BIT then - failed:=true; -{$ifndef tp} - proc_const_s64bit(gets64bit); - if global_s64bit <> RESULT_S64BIT then - failed:=true; -{$endif} - - if failed then - fail - else - WriteLn('Passed!'); - - write('Const parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallrec.b := RESULT_U8BIT; - value_smallrec.w := RESULT_U16BIT; - proc_const_smallrecord(value_smallrec); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); - proc_const_largerecord(value_largerec); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('const parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallset := [A_A,A_D]; - proc_const_smallset(value_smallset); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_largeset := ['I']; - proc_const_largeset(value_largeset); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - - - write('const parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - value_smallstring := RESULT_SMALLSTRING; - - proc_const_smallstring(value_smallstring); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_bigstring := RESULT_BIGSTRING; - proc_const_bigstring(value_bigstring); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - - write('Const parameter test (src : LOC_REFERENCE (formaldef)))...'); - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_formaldef_array(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Const parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_smallarray(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_smallarray_open(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - -{$ifndef tp} - clear_globals; - clear_values; - - value_u8bit := RESULT_U8BIT; - value_ptr := RESULT_PCHAR; - value_s64bit := RESULT_S64BIT; - value_smallstring := RESULT_SMALLSTRING; - value_class := tclass1.create; - value_boolean := RESULT_BOOLEAN; - value_char := RESULT_CHAR; - value_s64real:=RESULT_S64REAL; - proc_const_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real, - value_boolean,value_class]); - - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if global_char <> RESULT_CHAR then - failed := true; - if global_boolean <> RESULT_BOOLEAN then - failed:=true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed := true; - if global_bigstring <> RESULT_SMALLSTRING then - failed := true; - if global_ptr <> value_ptr then - failed := true; -{ if value_class <> global_class then - failed := true;!!!!!!!!!!!!!!!!!!!!} - if global_s64bit <> RESULT_S64BIT then - failed := true; - if assigned(value_class) then - value_class.destroy; - - global_u8bit := 0; - proc_const_smallarray_const_2([]); - if global_u8bit <> RESULT_U8BIT then - failed := true; -{$endif} - - if failed then - fail - else - WriteLn('Passed!'); - - - {***************************** MIXED TESTS *******************************} - write('Mixed const parameter test (src : LOC_REGISTER (orddef)))...'); - clear_globals; - clear_values; - failed:=false; - - proc_const_s32bit_mixed(RESULT_U8BIT,gets32bit,RESULT_U8BIT); - if global_s32bit <> RESULT_S32BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$ifndef tp} - proc_const_s64bit_mixed(RESULT_U8BIT,gets64bit,RESULT_U8BIT); - if global_s64bit <> RESULT_S64BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$endif} - if failed then - fail - else - WriteLn('Passed!'); - - write('Mixed const parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallrec.b := RESULT_U8BIT; - value_smallrec.w := RESULT_U16BIT; - proc_const_smallrecord_mixed(RESULT_U8BIT,value_smallrec,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); - proc_const_largerecord_mixed(RESULT_U8BIT,value_largerec,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Mixed const parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallset := [A_A,A_D]; - proc_const_smallset_mixed(RESULT_U8BIT,value_smallset,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_largeset := ['I']; - proc_const_largeset_mixed(RESULT_U8BIT,value_largeset,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - write('Mixed const parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - value_smallstring := RESULT_SMALLSTRING; - - proc_const_smallstring_mixed(RESULT_U8BIT,value_smallstring,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_bigstring := RESULT_BIGSTRING; - proc_const_bigstring_mixed(RESULT_U8BIT,value_bigstring,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - write('Mixed const parameter test (src : LOC_REFERENCE (formaldef)))...'); - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_formaldef_array_mixed(RESULT_U8BIT,value_smallarray,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Mixed const parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_smallarray_mixed(RESULT_U8BIt,value_smallarray,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_smallarray_open_mixed(RESULT_U8BIT,value_smallarray,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - -{$ifndef tp} - clear_globals; - clear_values; - - value_u8bit := RESULT_U8BIT; - value_ptr := RESULT_PCHAR; - value_s64bit := RESULT_S64BIT; - value_smallstring := RESULT_SMALLSTRING; - value_class := tclass1.create; - value_boolean := RESULT_BOOLEAN; - value_char := RESULT_CHAR; - value_s64real:=RESULT_S64REAL; - proc_const_smallarray_const_1_mixed(RESULT_U8BIT, [value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring, - value_s64real,value_boolean,value_class],RESULT_U8BIT); - - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if global_char <> RESULT_CHAR then - failed := true; - if global_boolean <> RESULT_BOOLEAN then - failed:=true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed := true; - if global_bigstring <> RESULT_SMALLSTRING then - failed := true; - if global_ptr <> value_ptr then - failed := true; -{ if value_class <> global_class then - failed := true;!!!!!!!!!!!!!!!!!!!!} - if global_s64bit <> RESULT_S64BIT then - failed := true; - if assigned(value_class) then - value_class.destroy; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - global_u8bit := 0; - proc_const_smallarray_const_2_mixed(RESULT_U8BIT,[],RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$endif} - - 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 } +{ (const parameters with popstack calling convention) } +{****************************************************************} +program tcalcst5; +{$ifdef fpc} + {$mode objfpc} + {$INLINE ON} +{$endif} +{$R+} + +{$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; + value_u8bit : byte; + value_u16bit : word; + value_s32bit : longint; +{$ifndef tp} + global_class : tclass1; + global_s64bit : int64; + value_s64bit : int64; + value_class : tclass1; +{$endif} + 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; +{$ifndef tp} + global_s64bit := 0; + global_class := nil; +{$endif} + 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; +{$ifndef tp} + value_s64bit := 0; + value_class := nil; +{$endif} + 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; + end; + + + procedure testprocedure; + begin + end; + + function getu8bit : byte; + begin + getu8bit:=RESULT_U8BIT; + end; + + function getu16bit: word; + begin + getu16bit:=RESULT_U16BIT; + end; + + function gets32bit: longint; + begin + gets32bit:=RESULT_S32BIT; + end; + + function gets64bit: int64; + begin + gets64bit:=RESULT_S64BIT; + end; + + + function gets32real: single; + begin + gets32real:=RESULT_S32REAL; + end; + + function gets64real: double; + begin + gets64real:=RESULT_S64REAL; + end; + + {************************************************************************} + { CONST PARAMETERS } + {************************************************************************} + procedure proc_const_s32bit(const v : longint);popstack; + begin + global_s32bit := v; + end; + +{$ifndef tp} + procedure proc_const_s64bit(const v: int64);popstack; + begin + global_s64bit:= v; + end; + + procedure proc_const_smallarray_const_1(const arr : array of const);popstack; + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : global_u8bit := arr[i].vinteger and $ff; + vtBoolean : global_boolean := arr[i].vboolean; + vtChar : global_char := arr[i].vchar; + vtExtended : global_s64real := arr[i].VExtended^; + vtString : global_bigstring := arr[i].VString^; + vtPointer : ; + vtPChar : global_ptr := arr[i].VPchar; + vtObject : ; +{ vtClass : global_class := (arr[i].VClass) as tclass1;} + vtAnsiString : ; + vtInt64 : global_s64bit := arr[i].vInt64^; + else + RunError(255); + end; + end; {endfor} + end; + + + procedure proc_const_smallarray_const_2(const arr : array of const);popstack; + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + end; + +{$endif} + + + procedure proc_const_smallrecord(const smallrec : tsmallrecord);popstack; + begin + if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_const_largerecord(const largerec : tlargerecord);popstack; + begin + if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_const_smallset(const smallset : tsmallset);popstack; + begin + if A_D in smallset then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_const_largeset(const largeset : tlargeset);popstack; + begin + if 'I' in largeset then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_const_smallstring(const s:tsmallstring);popstack; + begin + if s = RESULT_SMALLSTRING then + global_u8bit := RESULT_u8BIT; + end; + + + procedure proc_const_bigstring(const s:shortstring);popstack; + begin + if s = RESULT_BIGSTRING then + global_u8bit := RESULT_u8BIT; + end; + + + procedure proc_const_smallarray(const arr : tsmallarray);popstack; + begin + if arr[SMALL_INDEX] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_const_smallarray_open(const arr : array of byte);popstack; + begin + { form 0 to N-1 indexes in open arrays } + if arr[SMALL_INDEX-1] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + end; + + + + + procedure proc_const_formaldef_array(const buf);popstack; + var + p: pchar; + begin + { array is indexed from 1 } + p := @buf; + global_u8bit := byte(p[SMALL_INDEX-1]); + end; + + + {************************************************************************} + { MIXED CONST PARAMETERS } + {************************************************************************} + procedure proc_const_s32bit_mixed(b1: byte; const v : longint; b2: byte);popstack; + begin + global_s32bit := v; + value_u8bit := b2; + end; + +{$ifndef tp} + procedure proc_const_s64bit_mixed(b1 : byte; const v: int64; b2: byte);popstack; + begin + global_s64bit:= v; + value_u8bit := b2; + end; + + procedure proc_const_smallarray_const_1_mixed(b1 : byte; const arr : array of const; b2: byte);popstack; + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : global_u8bit := arr[i].vinteger and $ff; + vtBoolean : global_boolean := arr[i].vboolean; + vtChar : global_char := arr[i].vchar; + vtExtended : global_s64real := arr[i].VExtended^; + vtString : global_bigstring := arr[i].VString^; + vtPointer : ; + vtPChar : global_ptr := arr[i].VPchar; + vtObject : ; +{ vtClass : global_class := (arr[i].VClass) as tclass1;} + vtAnsiString : ; + vtInt64 : global_s64bit := arr[i].vInt64^; + else + RunError(255); + end; + end; {endfor} + value_u8bit := b2; + end; + + + procedure proc_const_smallarray_const_2_mixed(b1: byte; const arr : array of const; b2: byte);popstack; + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; +{$endif} + + + procedure proc_const_smallrecord_mixed(b1 : byte; const smallrec : tsmallrecord; b2: byte);popstack; + begin + if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + procedure proc_const_largerecord_mixed(b1: byte; const largerec : tlargerecord; b2: byte);popstack; + begin + if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + procedure proc_const_smallset_mixed(b1: byte; const smallset : tsmallset; b2: byte);popstack; + begin + if A_D in smallset then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + procedure proc_const_largeset_mixed(b1: byte; const largeset : tlargeset; b2: byte);popstack; + begin + if 'I' in largeset then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + procedure proc_const_smallstring_mixed(b1: byte; const s:tsmallstring; b2: byte);popstack; + begin + if s = RESULT_SMALLSTRING then + global_u8bit := RESULT_u8BIT; + value_u8bit := b2; + end; + + + procedure proc_const_bigstring_mixed(b1: byte; const s:shortstring; b2: byte);popstack; + begin + if s = RESULT_BIGSTRING then + global_u8bit := RESULT_u8BIT; + value_u8bit := b2; + end; + + + procedure proc_const_smallarray_mixed(b1: byte; const arr : tsmallarray; b2: byte);popstack; + begin + if arr[SMALL_INDEX] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + procedure proc_const_smallarray_open_mixed(b1: byte; const arr : array of byte; b2: byte);popstack; + begin + { form 0 to N-1 indexes in open arrays } + if arr[high(arr)] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + + + procedure proc_const_formaldef_array_mixed(b1: byte; const buf; b2: byte);popstack; + var + p: pchar; + begin + { array is indexed from 1 } + p := @buf; + global_u8bit := byte(p[SMALL_INDEX-1]); + value_u8bit := b2; + end; + + +var + failed: boolean; + pp : ^pchar; +begin + {***************************** NORMAL TESTS *******************************} + write('Const parameter test (src : LOC_REGISTER (orddef)))...'); + clear_globals; + clear_values; + failed:=false; + + proc_const_s32bit(gets32bit); + if global_s32bit <> RESULT_S32BIT then + failed:=true; +{$ifndef tp} + proc_const_s64bit(gets64bit); + if global_s64bit <> RESULT_S64BIT then + failed:=true; +{$endif} + + if failed then + fail + else + WriteLn('Passed!'); + + write('Const parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallrec.b := RESULT_U8BIT; + value_smallrec.w := RESULT_U16BIT; + proc_const_smallrecord(value_smallrec); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); + proc_const_largerecord(value_largerec); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('const parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallset := [A_A,A_D]; + proc_const_smallset(value_smallset); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_largeset := ['I']; + proc_const_largeset(value_largeset); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + + + write('const parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + value_smallstring := RESULT_SMALLSTRING; + + proc_const_smallstring(value_smallstring); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_bigstring := RESULT_BIGSTRING; + proc_const_bigstring(value_bigstring); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + + write('Const parameter test (src : LOC_REFERENCE (formaldef)))...'); + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_formaldef_array(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Const parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_smallarray(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_smallarray_open(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + +{$ifndef tp} + clear_globals; + clear_values; + + value_u8bit := RESULT_U8BIT; + value_ptr := RESULT_PCHAR; + value_s64bit := RESULT_S64BIT; + value_smallstring := RESULT_SMALLSTRING; + value_class := tclass1.create; + value_boolean := RESULT_BOOLEAN; + value_char := RESULT_CHAR; + value_s64real:=RESULT_S64REAL; + proc_const_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real, + value_boolean,value_class]); + + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if global_char <> RESULT_CHAR then + failed := true; + if global_boolean <> RESULT_BOOLEAN then + failed:=true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed := true; + if global_bigstring <> RESULT_SMALLSTRING then + failed := true; + if global_ptr <> value_ptr then + failed := true; +{ if value_class <> global_class then + failed := true;!!!!!!!!!!!!!!!!!!!!} + if global_s64bit <> RESULT_S64BIT then + failed := true; + if assigned(value_class) then + value_class.destroy; + + global_u8bit := 0; + proc_const_smallarray_const_2([]); + if global_u8bit <> RESULT_U8BIT then + failed := true; +{$endif} + + if failed then + fail + else + WriteLn('Passed!'); + + + {***************************** MIXED TESTS *******************************} + write('Mixed const parameter test (src : LOC_REGISTER (orddef)))...'); + clear_globals; + clear_values; + failed:=false; + + proc_const_s32bit_mixed(RESULT_U8BIT,gets32bit,RESULT_U8BIT); + if global_s32bit <> RESULT_S32BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$ifndef tp} + proc_const_s64bit_mixed(RESULT_U8BIT,gets64bit,RESULT_U8BIT); + if global_s64bit <> RESULT_S64BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$endif} + if failed then + fail + else + WriteLn('Passed!'); + + write('Mixed const parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallrec.b := RESULT_U8BIT; + value_smallrec.w := RESULT_U16BIT; + proc_const_smallrecord_mixed(RESULT_U8BIT,value_smallrec,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); + proc_const_largerecord_mixed(RESULT_U8BIT,value_largerec,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Mixed const parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallset := [A_A,A_D]; + proc_const_smallset_mixed(RESULT_U8BIT,value_smallset,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_largeset := ['I']; + proc_const_largeset_mixed(RESULT_U8BIT,value_largeset,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + write('Mixed const parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + value_smallstring := RESULT_SMALLSTRING; + + proc_const_smallstring_mixed(RESULT_U8BIT,value_smallstring,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_bigstring := RESULT_BIGSTRING; + proc_const_bigstring_mixed(RESULT_U8BIT,value_bigstring,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + write('Mixed const parameter test (src : LOC_REFERENCE (formaldef)))...'); + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_formaldef_array_mixed(RESULT_U8BIT,value_smallarray,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Mixed const parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_smallarray_mixed(RESULT_U8BIt,value_smallarray,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_smallarray_open_mixed(RESULT_U8BIT,value_smallarray,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + +{$ifndef tp} + clear_globals; + clear_values; + + value_u8bit := RESULT_U8BIT; + value_ptr := RESULT_PCHAR; + value_s64bit := RESULT_S64BIT; + value_smallstring := RESULT_SMALLSTRING; + value_class := tclass1.create; + value_boolean := RESULT_BOOLEAN; + value_char := RESULT_CHAR; + value_s64real:=RESULT_S64REAL; + proc_const_smallarray_const_1_mixed(RESULT_U8BIT, [value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring, + value_s64real,value_boolean,value_class],RESULT_U8BIT); + + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if global_char <> RESULT_CHAR then + failed := true; + if global_boolean <> RESULT_BOOLEAN then + failed:=true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed := true; + if global_bigstring <> RESULT_SMALLSTRING then + failed := true; + if global_ptr <> value_ptr then + failed := true; +{ if value_class <> global_class then + failed := true;!!!!!!!!!!!!!!!!!!!!} + if global_s64bit <> RESULT_S64BIT then + failed := true; + if assigned(value_class) then + value_class.destroy; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + global_u8bit := 0; + proc_const_smallarray_const_2_mixed(RESULT_U8BIT,[],RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$endif} + + if failed then + fail + else + WriteLn('Passed!'); +end. + +{ $Log$ - Revision 1.4 2002-09-22 09:08:40 carl - * gets64bit was not returning an int64! - - Revision 1.3 2002/09/07 15:40:50 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 17:47:06 carl - + constant parameter passing for different calling conventions - -} + Revision 1.5 2003-04-22 10:24:29 florian + * fixed defines for powerpc + + Revision 1.4 2002/09/22 09:08:40 carl + * gets64bit was not returning an int64! + + Revision 1.3 2002/09/07 15:40:50 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 17:47:06 carl + + constant parameter passing for different calling conventions + +} diff --git a/tests/test/cg/tcalcst6.pp b/tests/test/cg/tcalcst6.pp index 7f2113f270..7939db7b30 100644 --- a/tests/test/cg/tcalcst6.pp +++ b/tests/test/cg/tcalcst6.pp @@ -1,862 +1,864 @@ -{****************************************************************} -{ 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 } -{ (const parameters with safecall calling convention) } -{****************************************************************} -program tcalcst6; -{$ifdef fpc} - {$mode objfpc} - {$INLINE ON} -{$endif} -{$R+} - -{$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; - {$endif} - {$ifdef cpui386} - 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; - value_u8bit : byte; - value_u16bit : word; - value_s32bit : longint; -{$ifndef tp} - global_class : tclass1; - global_s64bit : int64; - value_s64bit : int64; - value_class : tclass1; -{$endif} - 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; -{$ifndef tp} - global_s64bit := 0; - global_class := nil; -{$endif} - 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; -{$ifndef tp} - value_s64bit := 0; - value_class := nil; -{$endif} - 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; - end; - - - procedure testprocedure; - begin - end; - - function getu8bit : byte; - begin - getu8bit:=RESULT_U8BIT; - end; - - function getu16bit: word; - begin - getu16bit:=RESULT_U16BIT; - end; - - function gets32bit: longint; - begin - gets32bit:=RESULT_S32BIT; - end; - - function gets64bit: int64; - begin - gets64bit:=RESULT_S64BIT; - end; - - - function gets32real: single; - begin - gets32real:=RESULT_S32REAL; - end; - - function gets64real: double; - begin - gets64real:=RESULT_S64REAL; - end; - - {************************************************************************} - { CONST PARAMETERS } - {************************************************************************} - procedure proc_const_s32bit(const v : longint);safecall; - begin - global_s32bit := v; - end; - -{$ifndef tp} - procedure proc_const_s64bit(const v: int64);safecall; - begin - global_s64bit:= v; - end; - - procedure proc_const_smallarray_const_1(const arr : array of const);safecall; - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : global_u8bit := arr[i].vinteger and $ff; - vtBoolean : global_boolean := arr[i].vboolean; - vtChar : global_char := arr[i].vchar; - vtExtended : global_s64real := arr[i].VExtended^; - vtString : global_bigstring := arr[i].VString^; - vtPointer : ; - vtPChar : global_ptr := arr[i].VPchar; - vtObject : ; -{ vtClass : global_class := (arr[i].VClass) as tclass1;} - vtAnsiString : ; - vtInt64 : global_s64bit := arr[i].vInt64^; - else - RunError(255); - end; - end; {endfor} - end; - - - procedure proc_const_smallarray_const_2(const arr : array of const);safecall; - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - end; - -{$endif} - - - procedure proc_const_smallrecord(const smallrec : tsmallrecord);safecall; - begin - if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_const_largerecord(const largerec : tlargerecord);safecall; - begin - if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_const_smallset(const smallset : tsmallset);safecall; - begin - if A_D in smallset then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_const_largeset(const largeset : tlargeset);safecall; - begin - if 'I' in largeset then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_const_smallstring(const s:tsmallstring);safecall; - begin - if s = RESULT_SMALLSTRING then - global_u8bit := RESULT_u8BIT; - end; - - - procedure proc_const_bigstring(const s:shortstring);safecall; - begin - if s = RESULT_BIGSTRING then - global_u8bit := RESULT_u8BIT; - end; - - - procedure proc_const_smallarray(const arr : tsmallarray);safecall; - begin - if arr[SMALL_INDEX] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_const_smallarray_open(const arr : array of byte);safecall; - begin - { form 0 to N-1 indexes in open arrays } - if arr[SMALL_INDEX-1] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - end; - - - - - procedure proc_const_formaldef_array(const buf);safecall; - var - p: pchar; - begin - { array is indexed from 1 } - p := @buf; - global_u8bit := byte(p[SMALL_INDEX-1]); - end; - - - {************************************************************************} - { MIXED CONST PARAMETERS } - {************************************************************************} - procedure proc_const_s32bit_mixed(b1: byte; const v : longint; b2: byte);safecall; - begin - global_s32bit := v; - value_u8bit := b2; - end; - -{$ifndef tp} - procedure proc_const_s64bit_mixed(b1 : byte; const v: int64; b2: byte);safecall; - begin - global_s64bit:= v; - value_u8bit := b2; - end; - - procedure proc_const_smallarray_const_1_mixed(b1 : byte; const arr : array of const; b2: byte);safecall; - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : global_u8bit := arr[i].vinteger and $ff; - vtBoolean : global_boolean := arr[i].vboolean; - vtChar : global_char := arr[i].vchar; - vtExtended : global_s64real := arr[i].VExtended^; - vtString : global_bigstring := arr[i].VString^; - vtPointer : ; - vtPChar : global_ptr := arr[i].VPchar; - vtObject : ; -{ vtClass : global_class := (arr[i].VClass) as tclass1;} - vtAnsiString : ; - vtInt64 : global_s64bit := arr[i].vInt64^; - else - RunError(255); - end; - end; {endfor} - value_u8bit := b2; - end; - - - procedure proc_const_smallarray_const_2_mixed(b1: byte; const arr : array of const; b2: byte);safecall; - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; -{$endif} - - - procedure proc_const_smallrecord_mixed(b1 : byte; const smallrec : tsmallrecord; b2: byte);safecall; - begin - if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - procedure proc_const_largerecord_mixed(b1: byte; const largerec : tlargerecord; b2: byte);safecall; - begin - if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - procedure proc_const_smallset_mixed(b1: byte; const smallset : tsmallset; b2: byte);safecall; - begin - if A_D in smallset then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - procedure proc_const_largeset_mixed(b1: byte; const largeset : tlargeset; b2: byte);safecall; - begin - if 'I' in largeset then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - procedure proc_const_smallstring_mixed(b1: byte; const s:tsmallstring; b2: byte);safecall; - begin - if s = RESULT_SMALLSTRING then - global_u8bit := RESULT_u8BIT; - value_u8bit := b2; - end; - - - procedure proc_const_bigstring_mixed(b1: byte; const s:shortstring; b2: byte);safecall; - begin - if s = RESULT_BIGSTRING then - global_u8bit := RESULT_u8BIT; - value_u8bit := b2; - end; - - - procedure proc_const_smallarray_mixed(b1: byte; const arr : tsmallarray; b2: byte);safecall; - begin - if arr[SMALL_INDEX] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - procedure proc_const_smallarray_open_mixed(b1: byte; const arr : array of byte; b2: byte);safecall; - begin - { form 0 to N-1 indexes in open arrays } - if arr[high(arr)] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - - - procedure proc_const_formaldef_array_mixed(b1: byte; const buf; b2: byte);safecall; - var - p: pchar; - begin - { array is indexed from 1 } - p := @buf; - global_u8bit := byte(p[SMALL_INDEX-1]); - value_u8bit := b2; - end; - - -var - failed: boolean; - pp : ^pchar; -begin - {***************************** NORMAL TESTS *******************************} - write('Const parameter test (src : LOC_REGISTER (orddef)))...'); - clear_globals; - clear_values; - failed:=false; - - proc_const_s32bit(gets32bit); - if global_s32bit <> RESULT_S32BIT then - failed:=true; -{$ifndef tp} - proc_const_s64bit(gets64bit); - if global_s64bit <> RESULT_S64BIT then - failed:=true; -{$endif} - - if failed then - fail - else - WriteLn('Passed!'); - - write('Const parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallrec.b := RESULT_U8BIT; - value_smallrec.w := RESULT_U16BIT; - proc_const_smallrecord(value_smallrec); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); - proc_const_largerecord(value_largerec); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('const parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallset := [A_A,A_D]; - proc_const_smallset(value_smallset); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_largeset := ['I']; - proc_const_largeset(value_largeset); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - - - write('const parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - value_smallstring := RESULT_SMALLSTRING; - - proc_const_smallstring(value_smallstring); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_bigstring := RESULT_BIGSTRING; - proc_const_bigstring(value_bigstring); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - - write('Const parameter test (src : LOC_REFERENCE (formaldef)))...'); - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_formaldef_array(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Const parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_smallarray(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_smallarray_open(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - -{$ifndef tp} - clear_globals; - clear_values; - - value_u8bit := RESULT_U8BIT; - value_ptr := RESULT_PCHAR; - value_s64bit := RESULT_S64BIT; - value_smallstring := RESULT_SMALLSTRING; - value_class := tclass1.create; - value_boolean := RESULT_BOOLEAN; - value_char := RESULT_CHAR; - value_s64real:=RESULT_S64REAL; - proc_const_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real, - value_boolean,value_class]); - - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if global_char <> RESULT_CHAR then - failed := true; - if global_boolean <> RESULT_BOOLEAN then - failed:=true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed := true; - if global_bigstring <> RESULT_SMALLSTRING then - failed := true; - if global_ptr <> value_ptr then - failed := true; -{ if value_class <> global_class then - failed := true;!!!!!!!!!!!!!!!!!!!!} - if global_s64bit <> RESULT_S64BIT then - failed := true; - if assigned(value_class) then - value_class.destroy; - - global_u8bit := 0; - proc_const_smallarray_const_2([]); - if global_u8bit <> RESULT_U8BIT then - failed := true; -{$endif} - - if failed then - fail - else - WriteLn('Passed!'); - - - {***************************** MIXED TESTS *******************************} - write('Mixed const parameter test (src : LOC_REGISTER (orddef)))...'); - clear_globals; - clear_values; - failed:=false; - - proc_const_s32bit_mixed(RESULT_U8BIT,gets32bit,RESULT_U8BIT); - if global_s32bit <> RESULT_S32BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$ifndef tp} - proc_const_s64bit_mixed(RESULT_U8BIT,gets64bit,RESULT_U8BIT); - if global_s64bit <> RESULT_S64BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$endif} - if failed then - fail - else - WriteLn('Passed!'); - - write('Mixed const parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallrec.b := RESULT_U8BIT; - value_smallrec.w := RESULT_U16BIT; - proc_const_smallrecord_mixed(RESULT_U8BIT,value_smallrec,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); - proc_const_largerecord_mixed(RESULT_U8BIT,value_largerec,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Mixed const parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallset := [A_A,A_D]; - proc_const_smallset_mixed(RESULT_U8BIT,value_smallset,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_largeset := ['I']; - proc_const_largeset_mixed(RESULT_U8BIT,value_largeset,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - write('Mixed const parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - value_smallstring := RESULT_SMALLSTRING; - - proc_const_smallstring_mixed(RESULT_U8BIT,value_smallstring,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_bigstring := RESULT_BIGSTRING; - proc_const_bigstring_mixed(RESULT_U8BIT,value_bigstring,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - write('Mixed const parameter test (src : LOC_REFERENCE (formaldef)))...'); - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_formaldef_array_mixed(RESULT_U8BIT,value_smallarray,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Mixed const parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_smallarray_mixed(RESULT_U8BIt,value_smallarray,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_smallarray_open_mixed(RESULT_U8BIT,value_smallarray,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - -{$ifndef tp} - clear_globals; - clear_values; - - value_u8bit := RESULT_U8BIT; - value_ptr := RESULT_PCHAR; - value_s64bit := RESULT_S64BIT; - value_smallstring := RESULT_SMALLSTRING; - value_class := tclass1.create; - value_boolean := RESULT_BOOLEAN; - value_char := RESULT_CHAR; - value_s64real:=RESULT_S64REAL; - proc_const_smallarray_const_1_mixed(RESULT_U8BIT, [value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring, - value_s64real,value_boolean,value_class],RESULT_U8BIT); - - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if global_char <> RESULT_CHAR then - failed := true; - if global_boolean <> RESULT_BOOLEAN then - failed:=true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed := true; - if global_bigstring <> RESULT_SMALLSTRING then - failed := true; - if global_ptr <> value_ptr then - failed := true; -{ if value_class <> global_class then - failed := true;!!!!!!!!!!!!!!!!!!!!} - if global_s64bit <> RESULT_S64BIT then - failed := true; - if assigned(value_class) then - value_class.destroy; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - global_u8bit := 0; - proc_const_smallarray_const_2_mixed(RESULT_U8BIT,[],RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$endif} - - 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 } +{ (const parameters with safecall calling convention) } +{****************************************************************} +program tcalcst6; +{$ifdef fpc} + {$mode objfpc} + {$INLINE ON} +{$endif} +{$R+} + +{$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; + value_u8bit : byte; + value_u16bit : word; + value_s32bit : longint; +{$ifndef tp} + global_class : tclass1; + global_s64bit : int64; + value_s64bit : int64; + value_class : tclass1; +{$endif} + 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; +{$ifndef tp} + global_s64bit := 0; + global_class := nil; +{$endif} + 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; +{$ifndef tp} + value_s64bit := 0; + value_class := nil; +{$endif} + 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; + end; + + + procedure testprocedure; + begin + end; + + function getu8bit : byte; + begin + getu8bit:=RESULT_U8BIT; + end; + + function getu16bit: word; + begin + getu16bit:=RESULT_U16BIT; + end; + + function gets32bit: longint; + begin + gets32bit:=RESULT_S32BIT; + end; + + function gets64bit: int64; + begin + gets64bit:=RESULT_S64BIT; + end; + + + function gets32real: single; + begin + gets32real:=RESULT_S32REAL; + end; + + function gets64real: double; + begin + gets64real:=RESULT_S64REAL; + end; + + {************************************************************************} + { CONST PARAMETERS } + {************************************************************************} + procedure proc_const_s32bit(const v : longint);safecall; + begin + global_s32bit := v; + end; + +{$ifndef tp} + procedure proc_const_s64bit(const v: int64);safecall; + begin + global_s64bit:= v; + end; + + procedure proc_const_smallarray_const_1(const arr : array of const);safecall; + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : global_u8bit := arr[i].vinteger and $ff; + vtBoolean : global_boolean := arr[i].vboolean; + vtChar : global_char := arr[i].vchar; + vtExtended : global_s64real := arr[i].VExtended^; + vtString : global_bigstring := arr[i].VString^; + vtPointer : ; + vtPChar : global_ptr := arr[i].VPchar; + vtObject : ; +{ vtClass : global_class := (arr[i].VClass) as tclass1;} + vtAnsiString : ; + vtInt64 : global_s64bit := arr[i].vInt64^; + else + RunError(255); + end; + end; {endfor} + end; + + + procedure proc_const_smallarray_const_2(const arr : array of const);safecall; + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + end; + +{$endif} + + + procedure proc_const_smallrecord(const smallrec : tsmallrecord);safecall; + begin + if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_const_largerecord(const largerec : tlargerecord);safecall; + begin + if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_const_smallset(const smallset : tsmallset);safecall; + begin + if A_D in smallset then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_const_largeset(const largeset : tlargeset);safecall; + begin + if 'I' in largeset then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_const_smallstring(const s:tsmallstring);safecall; + begin + if s = RESULT_SMALLSTRING then + global_u8bit := RESULT_u8BIT; + end; + + + procedure proc_const_bigstring(const s:shortstring);safecall; + begin + if s = RESULT_BIGSTRING then + global_u8bit := RESULT_u8BIT; + end; + + + procedure proc_const_smallarray(const arr : tsmallarray);safecall; + begin + if arr[SMALL_INDEX] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_const_smallarray_open(const arr : array of byte);safecall; + begin + { form 0 to N-1 indexes in open arrays } + if arr[SMALL_INDEX-1] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + end; + + + + + procedure proc_const_formaldef_array(const buf);safecall; + var + p: pchar; + begin + { array is indexed from 1 } + p := @buf; + global_u8bit := byte(p[SMALL_INDEX-1]); + end; + + + {************************************************************************} + { MIXED CONST PARAMETERS } + {************************************************************************} + procedure proc_const_s32bit_mixed(b1: byte; const v : longint; b2: byte);safecall; + begin + global_s32bit := v; + value_u8bit := b2; + end; + +{$ifndef tp} + procedure proc_const_s64bit_mixed(b1 : byte; const v: int64; b2: byte);safecall; + begin + global_s64bit:= v; + value_u8bit := b2; + end; + + procedure proc_const_smallarray_const_1_mixed(b1 : byte; const arr : array of const; b2: byte);safecall; + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : global_u8bit := arr[i].vinteger and $ff; + vtBoolean : global_boolean := arr[i].vboolean; + vtChar : global_char := arr[i].vchar; + vtExtended : global_s64real := arr[i].VExtended^; + vtString : global_bigstring := arr[i].VString^; + vtPointer : ; + vtPChar : global_ptr := arr[i].VPchar; + vtObject : ; +{ vtClass : global_class := (arr[i].VClass) as tclass1;} + vtAnsiString : ; + vtInt64 : global_s64bit := arr[i].vInt64^; + else + RunError(255); + end; + end; {endfor} + value_u8bit := b2; + end; + + + procedure proc_const_smallarray_const_2_mixed(b1: byte; const arr : array of const; b2: byte);safecall; + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; +{$endif} + + + procedure proc_const_smallrecord_mixed(b1 : byte; const smallrec : tsmallrecord; b2: byte);safecall; + begin + if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + procedure proc_const_largerecord_mixed(b1: byte; const largerec : tlargerecord; b2: byte);safecall; + begin + if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + procedure proc_const_smallset_mixed(b1: byte; const smallset : tsmallset; b2: byte);safecall; + begin + if A_D in smallset then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + procedure proc_const_largeset_mixed(b1: byte; const largeset : tlargeset; b2: byte);safecall; + begin + if 'I' in largeset then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + procedure proc_const_smallstring_mixed(b1: byte; const s:tsmallstring; b2: byte);safecall; + begin + if s = RESULT_SMALLSTRING then + global_u8bit := RESULT_u8BIT; + value_u8bit := b2; + end; + + + procedure proc_const_bigstring_mixed(b1: byte; const s:shortstring; b2: byte);safecall; + begin + if s = RESULT_BIGSTRING then + global_u8bit := RESULT_u8BIT; + value_u8bit := b2; + end; + + + procedure proc_const_smallarray_mixed(b1: byte; const arr : tsmallarray; b2: byte);safecall; + begin + if arr[SMALL_INDEX] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + procedure proc_const_smallarray_open_mixed(b1: byte; const arr : array of byte; b2: byte);safecall; + begin + { form 0 to N-1 indexes in open arrays } + if arr[high(arr)] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + + + procedure proc_const_formaldef_array_mixed(b1: byte; const buf; b2: byte);safecall; + var + p: pchar; + begin + { array is indexed from 1 } + p := @buf; + global_u8bit := byte(p[SMALL_INDEX-1]); + value_u8bit := b2; + end; + + +var + failed: boolean; + pp : ^pchar; +begin + {***************************** NORMAL TESTS *******************************} + write('Const parameter test (src : LOC_REGISTER (orddef)))...'); + clear_globals; + clear_values; + failed:=false; + + proc_const_s32bit(gets32bit); + if global_s32bit <> RESULT_S32BIT then + failed:=true; +{$ifndef tp} + proc_const_s64bit(gets64bit); + if global_s64bit <> RESULT_S64BIT then + failed:=true; +{$endif} + + if failed then + fail + else + WriteLn('Passed!'); + + write('Const parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallrec.b := RESULT_U8BIT; + value_smallrec.w := RESULT_U16BIT; + proc_const_smallrecord(value_smallrec); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); + proc_const_largerecord(value_largerec); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('const parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallset := [A_A,A_D]; + proc_const_smallset(value_smallset); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_largeset := ['I']; + proc_const_largeset(value_largeset); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + + + write('const parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + value_smallstring := RESULT_SMALLSTRING; + + proc_const_smallstring(value_smallstring); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_bigstring := RESULT_BIGSTRING; + proc_const_bigstring(value_bigstring); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + + write('Const parameter test (src : LOC_REFERENCE (formaldef)))...'); + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_formaldef_array(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Const parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_smallarray(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_smallarray_open(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + +{$ifndef tp} + clear_globals; + clear_values; + + value_u8bit := RESULT_U8BIT; + value_ptr := RESULT_PCHAR; + value_s64bit := RESULT_S64BIT; + value_smallstring := RESULT_SMALLSTRING; + value_class := tclass1.create; + value_boolean := RESULT_BOOLEAN; + value_char := RESULT_CHAR; + value_s64real:=RESULT_S64REAL; + proc_const_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real, + value_boolean,value_class]); + + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if global_char <> RESULT_CHAR then + failed := true; + if global_boolean <> RESULT_BOOLEAN then + failed:=true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed := true; + if global_bigstring <> RESULT_SMALLSTRING then + failed := true; + if global_ptr <> value_ptr then + failed := true; +{ if value_class <> global_class then + failed := true;!!!!!!!!!!!!!!!!!!!!} + if global_s64bit <> RESULT_S64BIT then + failed := true; + if assigned(value_class) then + value_class.destroy; + + global_u8bit := 0; + proc_const_smallarray_const_2([]); + if global_u8bit <> RESULT_U8BIT then + failed := true; +{$endif} + + if failed then + fail + else + WriteLn('Passed!'); + + + {***************************** MIXED TESTS *******************************} + write('Mixed const parameter test (src : LOC_REGISTER (orddef)))...'); + clear_globals; + clear_values; + failed:=false; + + proc_const_s32bit_mixed(RESULT_U8BIT,gets32bit,RESULT_U8BIT); + if global_s32bit <> RESULT_S32BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$ifndef tp} + proc_const_s64bit_mixed(RESULT_U8BIT,gets64bit,RESULT_U8BIT); + if global_s64bit <> RESULT_S64BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$endif} + if failed then + fail + else + WriteLn('Passed!'); + + write('Mixed const parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallrec.b := RESULT_U8BIT; + value_smallrec.w := RESULT_U16BIT; + proc_const_smallrecord_mixed(RESULT_U8BIT,value_smallrec,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); + proc_const_largerecord_mixed(RESULT_U8BIT,value_largerec,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Mixed const parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallset := [A_A,A_D]; + proc_const_smallset_mixed(RESULT_U8BIT,value_smallset,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_largeset := ['I']; + proc_const_largeset_mixed(RESULT_U8BIT,value_largeset,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + write('Mixed const parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + value_smallstring := RESULT_SMALLSTRING; + + proc_const_smallstring_mixed(RESULT_U8BIT,value_smallstring,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_bigstring := RESULT_BIGSTRING; + proc_const_bigstring_mixed(RESULT_U8BIT,value_bigstring,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + write('Mixed const parameter test (src : LOC_REFERENCE (formaldef)))...'); + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_formaldef_array_mixed(RESULT_U8BIT,value_smallarray,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Mixed const parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_smallarray_mixed(RESULT_U8BIt,value_smallarray,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_smallarray_open_mixed(RESULT_U8BIT,value_smallarray,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + +{$ifndef tp} + clear_globals; + clear_values; + + value_u8bit := RESULT_U8BIT; + value_ptr := RESULT_PCHAR; + value_s64bit := RESULT_S64BIT; + value_smallstring := RESULT_SMALLSTRING; + value_class := tclass1.create; + value_boolean := RESULT_BOOLEAN; + value_char := RESULT_CHAR; + value_s64real:=RESULT_S64REAL; + proc_const_smallarray_const_1_mixed(RESULT_U8BIT, [value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring, + value_s64real,value_boolean,value_class],RESULT_U8BIT); + + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if global_char <> RESULT_CHAR then + failed := true; + if global_boolean <> RESULT_BOOLEAN then + failed:=true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed := true; + if global_bigstring <> RESULT_SMALLSTRING then + failed := true; + if global_ptr <> value_ptr then + failed := true; +{ if value_class <> global_class then + failed := true;!!!!!!!!!!!!!!!!!!!!} + if global_s64bit <> RESULT_S64BIT then + failed := true; + if assigned(value_class) then + value_class.destroy; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + global_u8bit := 0; + proc_const_smallarray_const_2_mixed(RESULT_U8BIT,[],RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$endif} + + if failed then + fail + else + WriteLn('Passed!'); +end. + +{ $Log$ - Revision 1.4 2002-09-22 09:08:41 carl - * gets64bit was not returning an int64! - - Revision 1.3 2002/09/07 15:40:50 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 17:47:06 carl - + constant parameter passing for different calling conventions - -} + Revision 1.5 2003-04-22 10:24:29 florian + * fixed defines for powerpc + + Revision 1.4 2002/09/22 09:08:41 carl + * gets64bit was not returning an int64! + + Revision 1.3 2002/09/07 15:40:50 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 17:47:06 carl + + constant parameter passing for different calling conventions + +} diff --git a/tests/test/cg/tcalcst7.pp b/tests/test/cg/tcalcst7.pp index b9480e2a47..6b25e877cc 100644 --- a/tests/test/cg/tcalcst7.pp +++ b/tests/test/cg/tcalcst7.pp @@ -1,862 +1,864 @@ -{****************************************************************} -{ 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 } -{ (const parameters with register calling convention) } -{****************************************************************} -program tcalcst7; -{$ifdef fpc} - {$mode objfpc} - {$INLINE ON} -{$endif} -{$R+} - -{$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; - {$endif} - {$ifdef cpui386} - 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; - value_u8bit : byte; - value_u16bit : word; - value_s32bit : longint; -{$ifndef tp} - global_class : tclass1; - global_s64bit : int64; - value_s64bit : int64; - value_class : tclass1; -{$endif} - 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; -{$ifndef tp} - global_s64bit := 0; - global_class := nil; -{$endif} - 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; -{$ifndef tp} - value_s64bit := 0; - value_class := nil; -{$endif} - 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; - end; - - - procedure testprocedure; - begin - end; - - function getu8bit : byte; - begin - getu8bit:=RESULT_U8BIT; - end; - - function getu16bit: word; - begin - getu16bit:=RESULT_U16BIT; - end; - - function gets32bit: longint; - begin - gets32bit:=RESULT_S32BIT; - end; - - function gets64bit: int64; - begin - gets64bit:=RESULT_S64BIT; - end; - - - function gets32real: single; - begin - gets32real:=RESULT_S32REAL; - end; - - function gets64real: double; - begin - gets64real:=RESULT_S64REAL; - end; - - {************************************************************************} - { CONST PARAMETERS } - {************************************************************************} - procedure proc_const_s32bit(const v : longint);register; - begin - global_s32bit := v; - end; - -{$ifndef tp} - procedure proc_const_s64bit(const v: int64);register; - begin - global_s64bit:= v; - end; - - procedure proc_const_smallarray_const_1(const arr : array of const);register; - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : global_u8bit := arr[i].vinteger and $ff; - vtBoolean : global_boolean := arr[i].vboolean; - vtChar : global_char := arr[i].vchar; - vtExtended : global_s64real := arr[i].VExtended^; - vtString : global_bigstring := arr[i].VString^; - vtPointer : ; - vtPChar : global_ptr := arr[i].VPchar; - vtObject : ; -{ vtClass : global_class := (arr[i].VClass) as tclass1;} - vtAnsiString : ; - vtInt64 : global_s64bit := arr[i].vInt64^; - else - RunError(255); - end; - end; {endfor} - end; - - - procedure proc_const_smallarray_const_2(const arr : array of const);register; - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - end; - -{$endif} - - - procedure proc_const_smallrecord(const smallrec : tsmallrecord);register; - begin - if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_const_largerecord(const largerec : tlargerecord);register; - begin - if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_const_smallset(const smallset : tsmallset);register; - begin - if A_D in smallset then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_const_largeset(const largeset : tlargeset);register; - begin - if 'I' in largeset then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_const_smallstring(const s:tsmallstring);register; - begin - if s = RESULT_SMALLSTRING then - global_u8bit := RESULT_u8BIT; - end; - - - procedure proc_const_bigstring(const s:shortstring);register; - begin - if s = RESULT_BIGSTRING then - global_u8bit := RESULT_u8BIT; - end; - - - procedure proc_const_smallarray(const arr : tsmallarray);register; - begin - if arr[SMALL_INDEX] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_const_smallarray_open(const arr : array of byte);register; - begin - { form 0 to N-1 indexes in open arrays } - if arr[SMALL_INDEX-1] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - end; - - - - - procedure proc_const_formaldef_array(const buf);register; - var - p: pchar; - begin - { array is indexed from 1 } - p := @buf; - global_u8bit := byte(p[SMALL_INDEX-1]); - end; - - - {************************************************************************} - { MIXED CONST PARAMETERS } - {************************************************************************} - procedure proc_const_s32bit_mixed(b1: byte; const v : longint; b2: byte);register; - begin - global_s32bit := v; - value_u8bit := b2; - end; - -{$ifndef tp} - procedure proc_const_s64bit_mixed(b1 : byte; const v: int64; b2: byte);register; - begin - global_s64bit:= v; - value_u8bit := b2; - end; - - procedure proc_const_smallarray_const_1_mixed(b1 : byte; const arr : array of const; b2: byte);register; - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : global_u8bit := arr[i].vinteger and $ff; - vtBoolean : global_boolean := arr[i].vboolean; - vtChar : global_char := arr[i].vchar; - vtExtended : global_s64real := arr[i].VExtended^; - vtString : global_bigstring := arr[i].VString^; - vtPointer : ; - vtPChar : global_ptr := arr[i].VPchar; - vtObject : ; -{ vtClass : global_class := (arr[i].VClass) as tclass1;} - vtAnsiString : ; - vtInt64 : global_s64bit := arr[i].vInt64^; - else - RunError(255); - end; - end; {endfor} - value_u8bit := b2; - end; - - - procedure proc_const_smallarray_const_2_mixed(b1: byte; const arr : array of const; b2: byte);register; - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; -{$endif} - - - procedure proc_const_smallrecord_mixed(b1 : byte; const smallrec : tsmallrecord; b2: byte);register; - begin - if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - procedure proc_const_largerecord_mixed(b1: byte; const largerec : tlargerecord; b2: byte);register; - begin - if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - procedure proc_const_smallset_mixed(b1: byte; const smallset : tsmallset; b2: byte);register; - begin - if A_D in smallset then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - procedure proc_const_largeset_mixed(b1: byte; const largeset : tlargeset; b2: byte);register; - begin - if 'I' in largeset then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - procedure proc_const_smallstring_mixed(b1: byte; const s:tsmallstring; b2: byte);register; - begin - if s = RESULT_SMALLSTRING then - global_u8bit := RESULT_u8BIT; - value_u8bit := b2; - end; - - - procedure proc_const_bigstring_mixed(b1: byte; const s:shortstring; b2: byte);register; - begin - if s = RESULT_BIGSTRING then - global_u8bit := RESULT_u8BIT; - value_u8bit := b2; - end; - - - procedure proc_const_smallarray_mixed(b1: byte; const arr : tsmallarray; b2: byte);register; - begin - if arr[SMALL_INDEX] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - procedure proc_const_smallarray_open_mixed(b1: byte; const arr : array of byte; b2: byte);register; - begin - { form 0 to N-1 indexes in open arrays } - if arr[high(arr)] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - - - procedure proc_const_formaldef_array_mixed(b1: byte; const buf; b2: byte);register; - var - p: pchar; - begin - { array is indexed from 1 } - p := @buf; - global_u8bit := byte(p[SMALL_INDEX-1]); - value_u8bit := b2; - end; - - -var - failed: boolean; - pp : ^pchar; -begin - {***************************** NORMAL TESTS *******************************} - write('Const parameter test (src : LOC_REGISTER (orddef)))...'); - clear_globals; - clear_values; - failed:=false; - - proc_const_s32bit(gets32bit); - if global_s32bit <> RESULT_S32BIT then - failed:=true; -{$ifndef tp} - proc_const_s64bit(gets64bit); - if global_s64bit <> RESULT_S64BIT then - failed:=true; -{$endif} - - if failed then - fail - else - WriteLn('Passed!'); - - write('Const parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallrec.b := RESULT_U8BIT; - value_smallrec.w := RESULT_U16BIT; - proc_const_smallrecord(value_smallrec); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); - proc_const_largerecord(value_largerec); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('const parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallset := [A_A,A_D]; - proc_const_smallset(value_smallset); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_largeset := ['I']; - proc_const_largeset(value_largeset); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - - - write('const parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - value_smallstring := RESULT_SMALLSTRING; - - proc_const_smallstring(value_smallstring); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_bigstring := RESULT_BIGSTRING; - proc_const_bigstring(value_bigstring); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - - write('Const parameter test (src : LOC_REFERENCE (formaldef)))...'); - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_formaldef_array(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Const parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_smallarray(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_smallarray_open(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - -{$ifndef tp} - clear_globals; - clear_values; - - value_u8bit := RESULT_U8BIT; - value_ptr := RESULT_PCHAR; - value_s64bit := RESULT_S64BIT; - value_smallstring := RESULT_SMALLSTRING; - value_class := tclass1.create; - value_boolean := RESULT_BOOLEAN; - value_char := RESULT_CHAR; - value_s64real:=RESULT_S64REAL; - proc_const_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real, - value_boolean,value_class]); - - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if global_char <> RESULT_CHAR then - failed := true; - if global_boolean <> RESULT_BOOLEAN then - failed:=true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed := true; - if global_bigstring <> RESULT_SMALLSTRING then - failed := true; - if global_ptr <> value_ptr then - failed := true; -{ if value_class <> global_class then - failed := true;!!!!!!!!!!!!!!!!!!!!} - if global_s64bit <> RESULT_S64BIT then - failed := true; - if assigned(value_class) then - value_class.destroy; - - global_u8bit := 0; - proc_const_smallarray_const_2([]); - if global_u8bit <> RESULT_U8BIT then - failed := true; -{$endif} - - if failed then - fail - else - WriteLn('Passed!'); - - - {***************************** MIXED TESTS *******************************} - write('Mixed const parameter test (src : LOC_REGISTER (orddef)))...'); - clear_globals; - clear_values; - failed:=false; - - proc_const_s32bit_mixed(RESULT_U8BIT,gets32bit,RESULT_U8BIT); - if global_s32bit <> RESULT_S32BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$ifndef tp} - proc_const_s64bit_mixed(RESULT_U8BIT,gets64bit,RESULT_U8BIT); - if global_s64bit <> RESULT_S64BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$endif} - if failed then - fail - else - WriteLn('Passed!'); - - write('Mixed const parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallrec.b := RESULT_U8BIT; - value_smallrec.w := RESULT_U16BIT; - proc_const_smallrecord_mixed(RESULT_U8BIT,value_smallrec,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); - proc_const_largerecord_mixed(RESULT_U8BIT,value_largerec,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Mixed const parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallset := [A_A,A_D]; - proc_const_smallset_mixed(RESULT_U8BIT,value_smallset,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_largeset := ['I']; - proc_const_largeset_mixed(RESULT_U8BIT,value_largeset,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - write('Mixed const parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - value_smallstring := RESULT_SMALLSTRING; - - proc_const_smallstring_mixed(RESULT_U8BIT,value_smallstring,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_bigstring := RESULT_BIGSTRING; - proc_const_bigstring_mixed(RESULT_U8BIT,value_bigstring,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - write('Mixed const parameter test (src : LOC_REFERENCE (formaldef)))...'); - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_formaldef_array_mixed(RESULT_U8BIT,value_smallarray,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Mixed const parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_smallarray_mixed(RESULT_U8BIt,value_smallarray,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_smallarray_open_mixed(RESULT_U8BIT,value_smallarray,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - -{$ifndef tp} - clear_globals; - clear_values; - - value_u8bit := RESULT_U8BIT; - value_ptr := RESULT_PCHAR; - value_s64bit := RESULT_S64BIT; - value_smallstring := RESULT_SMALLSTRING; - value_class := tclass1.create; - value_boolean := RESULT_BOOLEAN; - value_char := RESULT_CHAR; - value_s64real:=RESULT_S64REAL; - proc_const_smallarray_const_1_mixed(RESULT_U8BIT, [value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring, - value_s64real,value_boolean,value_class],RESULT_U8BIT); - - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if global_char <> RESULT_CHAR then - failed := true; - if global_boolean <> RESULT_BOOLEAN then - failed:=true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed := true; - if global_bigstring <> RESULT_SMALLSTRING then - failed := true; - if global_ptr <> value_ptr then - failed := true; -{ if value_class <> global_class then - failed := true;!!!!!!!!!!!!!!!!!!!!} - if global_s64bit <> RESULT_S64BIT then - failed := true; - if assigned(value_class) then - value_class.destroy; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - global_u8bit := 0; - proc_const_smallarray_const_2_mixed(RESULT_U8BIT,[],RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$endif} - - 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 } +{ (const parameters with register calling convention) } +{****************************************************************} +program tcalcst7; +{$ifdef fpc} + {$mode objfpc} + {$INLINE ON} +{$endif} +{$R+} + +{$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; + value_u8bit : byte; + value_u16bit : word; + value_s32bit : longint; +{$ifndef tp} + global_class : tclass1; + global_s64bit : int64; + value_s64bit : int64; + value_class : tclass1; +{$endif} + 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; +{$ifndef tp} + global_s64bit := 0; + global_class := nil; +{$endif} + 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; +{$ifndef tp} + value_s64bit := 0; + value_class := nil; +{$endif} + 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; + end; + + + procedure testprocedure; + begin + end; + + function getu8bit : byte; + begin + getu8bit:=RESULT_U8BIT; + end; + + function getu16bit: word; + begin + getu16bit:=RESULT_U16BIT; + end; + + function gets32bit: longint; + begin + gets32bit:=RESULT_S32BIT; + end; + + function gets64bit: int64; + begin + gets64bit:=RESULT_S64BIT; + end; + + + function gets32real: single; + begin + gets32real:=RESULT_S32REAL; + end; + + function gets64real: double; + begin + gets64real:=RESULT_S64REAL; + end; + + {************************************************************************} + { CONST PARAMETERS } + {************************************************************************} + procedure proc_const_s32bit(const v : longint);register; + begin + global_s32bit := v; + end; + +{$ifndef tp} + procedure proc_const_s64bit(const v: int64);register; + begin + global_s64bit:= v; + end; + + procedure proc_const_smallarray_const_1(const arr : array of const);register; + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : global_u8bit := arr[i].vinteger and $ff; + vtBoolean : global_boolean := arr[i].vboolean; + vtChar : global_char := arr[i].vchar; + vtExtended : global_s64real := arr[i].VExtended^; + vtString : global_bigstring := arr[i].VString^; + vtPointer : ; + vtPChar : global_ptr := arr[i].VPchar; + vtObject : ; +{ vtClass : global_class := (arr[i].VClass) as tclass1;} + vtAnsiString : ; + vtInt64 : global_s64bit := arr[i].vInt64^; + else + RunError(255); + end; + end; {endfor} + end; + + + procedure proc_const_smallarray_const_2(const arr : array of const);register; + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + end; + +{$endif} + + + procedure proc_const_smallrecord(const smallrec : tsmallrecord);register; + begin + if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_const_largerecord(const largerec : tlargerecord);register; + begin + if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_const_smallset(const smallset : tsmallset);register; + begin + if A_D in smallset then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_const_largeset(const largeset : tlargeset);register; + begin + if 'I' in largeset then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_const_smallstring(const s:tsmallstring);register; + begin + if s = RESULT_SMALLSTRING then + global_u8bit := RESULT_u8BIT; + end; + + + procedure proc_const_bigstring(const s:shortstring);register; + begin + if s = RESULT_BIGSTRING then + global_u8bit := RESULT_u8BIT; + end; + + + procedure proc_const_smallarray(const arr : tsmallarray);register; + begin + if arr[SMALL_INDEX] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_const_smallarray_open(const arr : array of byte);register; + begin + { form 0 to N-1 indexes in open arrays } + if arr[SMALL_INDEX-1] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + end; + + + + + procedure proc_const_formaldef_array(const buf);register; + var + p: pchar; + begin + { array is indexed from 1 } + p := @buf; + global_u8bit := byte(p[SMALL_INDEX-1]); + end; + + + {************************************************************************} + { MIXED CONST PARAMETERS } + {************************************************************************} + procedure proc_const_s32bit_mixed(b1: byte; const v : longint; b2: byte);register; + begin + global_s32bit := v; + value_u8bit := b2; + end; + +{$ifndef tp} + procedure proc_const_s64bit_mixed(b1 : byte; const v: int64; b2: byte);register; + begin + global_s64bit:= v; + value_u8bit := b2; + end; + + procedure proc_const_smallarray_const_1_mixed(b1 : byte; const arr : array of const; b2: byte);register; + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : global_u8bit := arr[i].vinteger and $ff; + vtBoolean : global_boolean := arr[i].vboolean; + vtChar : global_char := arr[i].vchar; + vtExtended : global_s64real := arr[i].VExtended^; + vtString : global_bigstring := arr[i].VString^; + vtPointer : ; + vtPChar : global_ptr := arr[i].VPchar; + vtObject : ; +{ vtClass : global_class := (arr[i].VClass) as tclass1;} + vtAnsiString : ; + vtInt64 : global_s64bit := arr[i].vInt64^; + else + RunError(255); + end; + end; {endfor} + value_u8bit := b2; + end; + + + procedure proc_const_smallarray_const_2_mixed(b1: byte; const arr : array of const; b2: byte);register; + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; +{$endif} + + + procedure proc_const_smallrecord_mixed(b1 : byte; const smallrec : tsmallrecord; b2: byte);register; + begin + if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + procedure proc_const_largerecord_mixed(b1: byte; const largerec : tlargerecord; b2: byte);register; + begin + if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + procedure proc_const_smallset_mixed(b1: byte; const smallset : tsmallset; b2: byte);register; + begin + if A_D in smallset then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + procedure proc_const_largeset_mixed(b1: byte; const largeset : tlargeset; b2: byte);register; + begin + if 'I' in largeset then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + procedure proc_const_smallstring_mixed(b1: byte; const s:tsmallstring; b2: byte);register; + begin + if s = RESULT_SMALLSTRING then + global_u8bit := RESULT_u8BIT; + value_u8bit := b2; + end; + + + procedure proc_const_bigstring_mixed(b1: byte; const s:shortstring; b2: byte);register; + begin + if s = RESULT_BIGSTRING then + global_u8bit := RESULT_u8BIT; + value_u8bit := b2; + end; + + + procedure proc_const_smallarray_mixed(b1: byte; const arr : tsmallarray; b2: byte);register; + begin + if arr[SMALL_INDEX] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + procedure proc_const_smallarray_open_mixed(b1: byte; const arr : array of byte; b2: byte);register; + begin + { form 0 to N-1 indexes in open arrays } + if arr[high(arr)] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + + + procedure proc_const_formaldef_array_mixed(b1: byte; const buf; b2: byte);register; + var + p: pchar; + begin + { array is indexed from 1 } + p := @buf; + global_u8bit := byte(p[SMALL_INDEX-1]); + value_u8bit := b2; + end; + + +var + failed: boolean; + pp : ^pchar; +begin + {***************************** NORMAL TESTS *******************************} + write('Const parameter test (src : LOC_REGISTER (orddef)))...'); + clear_globals; + clear_values; + failed:=false; + + proc_const_s32bit(gets32bit); + if global_s32bit <> RESULT_S32BIT then + failed:=true; +{$ifndef tp} + proc_const_s64bit(gets64bit); + if global_s64bit <> RESULT_S64BIT then + failed:=true; +{$endif} + + if failed then + fail + else + WriteLn('Passed!'); + + write('Const parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallrec.b := RESULT_U8BIT; + value_smallrec.w := RESULT_U16BIT; + proc_const_smallrecord(value_smallrec); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); + proc_const_largerecord(value_largerec); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('const parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallset := [A_A,A_D]; + proc_const_smallset(value_smallset); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_largeset := ['I']; + proc_const_largeset(value_largeset); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + + + write('const parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + value_smallstring := RESULT_SMALLSTRING; + + proc_const_smallstring(value_smallstring); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_bigstring := RESULT_BIGSTRING; + proc_const_bigstring(value_bigstring); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + + write('Const parameter test (src : LOC_REFERENCE (formaldef)))...'); + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_formaldef_array(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Const parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_smallarray(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_smallarray_open(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + +{$ifndef tp} + clear_globals; + clear_values; + + value_u8bit := RESULT_U8BIT; + value_ptr := RESULT_PCHAR; + value_s64bit := RESULT_S64BIT; + value_smallstring := RESULT_SMALLSTRING; + value_class := tclass1.create; + value_boolean := RESULT_BOOLEAN; + value_char := RESULT_CHAR; + value_s64real:=RESULT_S64REAL; + proc_const_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real, + value_boolean,value_class]); + + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if global_char <> RESULT_CHAR then + failed := true; + if global_boolean <> RESULT_BOOLEAN then + failed:=true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed := true; + if global_bigstring <> RESULT_SMALLSTRING then + failed := true; + if global_ptr <> value_ptr then + failed := true; +{ if value_class <> global_class then + failed := true;!!!!!!!!!!!!!!!!!!!!} + if global_s64bit <> RESULT_S64BIT then + failed := true; + if assigned(value_class) then + value_class.destroy; + + global_u8bit := 0; + proc_const_smallarray_const_2([]); + if global_u8bit <> RESULT_U8BIT then + failed := true; +{$endif} + + if failed then + fail + else + WriteLn('Passed!'); + + + {***************************** MIXED TESTS *******************************} + write('Mixed const parameter test (src : LOC_REGISTER (orddef)))...'); + clear_globals; + clear_values; + failed:=false; + + proc_const_s32bit_mixed(RESULT_U8BIT,gets32bit,RESULT_U8BIT); + if global_s32bit <> RESULT_S32BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$ifndef tp} + proc_const_s64bit_mixed(RESULT_U8BIT,gets64bit,RESULT_U8BIT); + if global_s64bit <> RESULT_S64BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$endif} + if failed then + fail + else + WriteLn('Passed!'); + + write('Mixed const parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallrec.b := RESULT_U8BIT; + value_smallrec.w := RESULT_U16BIT; + proc_const_smallrecord_mixed(RESULT_U8BIT,value_smallrec,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); + proc_const_largerecord_mixed(RESULT_U8BIT,value_largerec,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Mixed const parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallset := [A_A,A_D]; + proc_const_smallset_mixed(RESULT_U8BIT,value_smallset,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_largeset := ['I']; + proc_const_largeset_mixed(RESULT_U8BIT,value_largeset,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + write('Mixed const parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + value_smallstring := RESULT_SMALLSTRING; + + proc_const_smallstring_mixed(RESULT_U8BIT,value_smallstring,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_bigstring := RESULT_BIGSTRING; + proc_const_bigstring_mixed(RESULT_U8BIT,value_bigstring,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + write('Mixed const parameter test (src : LOC_REFERENCE (formaldef)))...'); + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_formaldef_array_mixed(RESULT_U8BIT,value_smallarray,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Mixed const parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_smallarray_mixed(RESULT_U8BIt,value_smallarray,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_smallarray_open_mixed(RESULT_U8BIT,value_smallarray,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + +{$ifndef tp} + clear_globals; + clear_values; + + value_u8bit := RESULT_U8BIT; + value_ptr := RESULT_PCHAR; + value_s64bit := RESULT_S64BIT; + value_smallstring := RESULT_SMALLSTRING; + value_class := tclass1.create; + value_boolean := RESULT_BOOLEAN; + value_char := RESULT_CHAR; + value_s64real:=RESULT_S64REAL; + proc_const_smallarray_const_1_mixed(RESULT_U8BIT, [value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring, + value_s64real,value_boolean,value_class],RESULT_U8BIT); + + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if global_char <> RESULT_CHAR then + failed := true; + if global_boolean <> RESULT_BOOLEAN then + failed:=true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed := true; + if global_bigstring <> RESULT_SMALLSTRING then + failed := true; + if global_ptr <> value_ptr then + failed := true; +{ if value_class <> global_class then + failed := true;!!!!!!!!!!!!!!!!!!!!} + if global_s64bit <> RESULT_S64BIT then + failed := true; + if assigned(value_class) then + value_class.destroy; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + global_u8bit := 0; + proc_const_smallarray_const_2_mixed(RESULT_U8BIT,[],RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$endif} + + if failed then + fail + else + WriteLn('Passed!'); +end. + +{ $Log$ - Revision 1.4 2002-09-22 09:08:41 carl - * gets64bit was not returning an int64! - - Revision 1.3 2002/09/07 15:40:50 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 17:47:06 carl - + constant parameter passing for different calling conventions - -} + Revision 1.5 2003-04-22 10:24:29 florian + * fixed defines for powerpc + + Revision 1.4 2002/09/22 09:08:41 carl + * gets64bit was not returning an int64! + + Revision 1.3 2002/09/07 15:40:50 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 17:47:06 carl + + constant parameter passing for different calling conventions + +} diff --git a/tests/test/cg/tcalcst8.pp b/tests/test/cg/tcalcst8.pp index 475349dbf4..d68b214475 100644 --- a/tests/test/cg/tcalcst8.pp +++ b/tests/test/cg/tcalcst8.pp @@ -1,873 +1,875 @@ -{****************************************************************} -{ 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 } -{ (const parameters with stdcall calling convention) } -{****************************************************************} -program tcalcst8; -{$ifdef fpc} - {$mode objfpc} - {$INLINE ON} -{$endif} -{$R+} - -{$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; - {$endif} - {$ifdef cpui386} - 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; - value_u8bit : byte; - value_u16bit : word; - value_s32bit : longint; -{$ifndef tp} - global_class : tclass1; - global_s64bit : int64; - value_s64bit : int64; - value_class : tclass1; -{$endif} - 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; -{$ifndef tp} - global_s64bit := 0; - global_class := nil; -{$endif} - 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; -{$ifndef tp} - value_s64bit := 0; - value_class := nil; -{$endif} - 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; - end; - - - procedure testprocedure; - begin - end; - - function getu8bit : byte; - begin - getu8bit:=RESULT_U8BIT; - end; - - function getu16bit: word; - begin - getu16bit:=RESULT_U16BIT; - end; - - function gets32bit: longint; - begin - gets32bit:=RESULT_S32BIT; - end; - - function gets64bit: int64; - begin - gets64bit:=RESULT_S64BIT; - end; - - - function gets32real: single; - begin - gets32real:=RESULT_S32REAL; - end; - - function gets64real: double; - begin - gets64real:=RESULT_S64REAL; - end; - - {************************************************************************} - { CONST PARAMETERS } - {************************************************************************} - procedure proc_const_s32bit(const v : longint);stdcall; - begin - global_s32bit := v; - end; - -{$ifndef tp} - procedure proc_const_s64bit(const v: int64);stdcall; - begin - global_s64bit:= v; - end; - - procedure proc_const_smallarray_const_1(const arr : array of const);stdcall; - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : global_u8bit := arr[i].vinteger and $ff; - vtBoolean : global_boolean := arr[i].vboolean; - vtChar : global_char := arr[i].vchar; - vtExtended : global_s64real := arr[i].VExtended^; - vtString : global_bigstring := arr[i].VString^; - vtPointer : ; - vtPChar : global_ptr := arr[i].VPchar; - vtObject : ; -{ vtClass : global_class := (arr[i].VClass) as tclass1;} - vtAnsiString : ; - vtInt64 : global_s64bit := arr[i].vInt64^; - else - RunError(255); - end; - end; {endfor} - end; - - - procedure proc_const_smallarray_const_2(const arr : array of const);stdcall; - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - end; - -{$endif} - - - procedure proc_const_smallrecord(const smallrec : tsmallrecord);stdcall; - begin - if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_const_largerecord(const largerec : tlargerecord);stdcall; - begin - if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_const_smallset(const smallset : tsmallset);stdcall; - begin - if A_D in smallset then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_const_largeset(const largeset : tlargeset);stdcall; - begin - if 'I' in largeset then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_const_smallstring(const s:tsmallstring);stdcall; - begin - if s = RESULT_SMALLSTRING then - global_u8bit := RESULT_u8BIT; - end; - - - procedure proc_const_bigstring(const s:shortstring);stdcall; - begin - if s = RESULT_BIGSTRING then - global_u8bit := RESULT_u8BIT; - end; - - - procedure proc_const_smallarray(const arr : tsmallarray);stdcall; - begin - if arr[SMALL_INDEX] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_const_smallarray_open(const arr : array of byte);stdcall; - begin - { form 0 to N-1 indexes in open arrays } - if arr[SMALL_INDEX-1] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - end; - - - - - procedure proc_const_formaldef_array(const buf);stdcall; - var - p: pchar; - begin - { array is indexed from 1 } - p := @buf; - global_u8bit := byte(p[SMALL_INDEX-1]); - end; - - - {************************************************************************} - { MIXED CONST PARAMETERS } - {************************************************************************} - procedure proc_const_s32bit_mixed(b1: byte; const v : longint; b2: byte);stdcall; - begin - global_s32bit := v; - value_u8bit := b2; - end; - -{$ifndef tp} - procedure proc_const_s64bit_mixed(b1 : byte; const v: int64; b2: byte);stdcall; - begin - global_s64bit:= v; - value_u8bit := b2; - end; - - procedure proc_const_smallarray_const_1_mixed(b1 : byte; const arr : array of const; b2: byte);stdcall; - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : global_u8bit := arr[i].vinteger and $ff; - vtBoolean : global_boolean := arr[i].vboolean; - vtChar : global_char := arr[i].vchar; - vtExtended : global_s64real := arr[i].VExtended^; - vtString : global_bigstring := arr[i].VString^; - vtPointer : ; - vtPChar : global_ptr := arr[i].VPchar; - vtObject : ; -{ vtClass : global_class := (arr[i].VClass) as tclass1;} - vtAnsiString : ; - vtInt64 : global_s64bit := arr[i].vInt64^; - else - RunError(255); - end; - end; {endfor} - value_u8bit := b2; - end; - - - procedure proc_const_smallarray_const_2_mixed(b1: byte; const arr : array of const; b2: byte);stdcall; - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; -{$endif} - - - procedure proc_const_smallrecord_mixed(b1 : byte; const smallrec : tsmallrecord; b2: byte);stdcall; - begin - if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - procedure proc_const_largerecord_mixed(b1: byte; const largerec : tlargerecord; b2: byte);stdcall; - begin - if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - procedure proc_const_smallset_mixed(b1: byte; const smallset : tsmallset; b2: byte);stdcall; - begin - if A_D in smallset then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - procedure proc_const_largeset_mixed(b1: byte; const largeset : tlargeset; b2: byte);stdcall; - begin - if 'I' in largeset then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - procedure proc_const_smallstring_mixed(b1: byte; const s:tsmallstring; b2: byte);stdcall; - begin - if s = RESULT_SMALLSTRING then - global_u8bit := RESULT_u8BIT; - value_u8bit := b2; - end; - - - procedure proc_const_bigstring_mixed(b1: byte; const s:shortstring; b2: byte);stdcall; - begin - if s = RESULT_BIGSTRING then - global_u8bit := RESULT_u8BIT; - value_u8bit := b2; - end; - - - procedure proc_const_smallarray_mixed(b1: byte; const arr : tsmallarray; b2: byte);stdcall; - begin - if arr[SMALL_INDEX] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - procedure proc_const_smallarray_open_mixed(b1: byte; const arr : array of byte; b2: byte);stdcall; - begin - { form 0 to N-1 indexes in open arrays } - if arr[high(arr)] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - - - procedure proc_const_formaldef_array_mixed(b1: byte; const buf; b2: byte);stdcall; - var - p: pchar; - begin - { array is indexed from 1 } - p := @buf; - global_u8bit := byte(p[SMALL_INDEX-1]); - value_u8bit := b2; - end; - - -var - failed: boolean; - pp : ^pchar; -begin - {***************************** NORMAL TESTS *******************************} - write('Const parameter test (src : LOC_REGISTER (orddef)))...'); - clear_globals; - clear_values; - failed:=false; - - proc_const_s32bit(gets32bit); - if global_s32bit <> RESULT_S32BIT then - failed:=true; -{$ifndef tp} - proc_const_s64bit(gets64bit); - if global_s64bit <> RESULT_S64BIT then - failed:=true; -{$endif} - - if failed then - fail - else - WriteLn('Passed!'); - - write('Const parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallrec.b := RESULT_U8BIT; - value_smallrec.w := RESULT_U16BIT; - proc_const_smallrecord(value_smallrec); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); - proc_const_largerecord(value_largerec); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('const parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallset := [A_A,A_D]; - proc_const_smallset(value_smallset); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_largeset := ['I']; - proc_const_largeset(value_largeset); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - - - write('const parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - value_smallstring := RESULT_SMALLSTRING; - - proc_const_smallstring(value_smallstring); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_bigstring := RESULT_BIGSTRING; - proc_const_bigstring(value_bigstring); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - - write('Const parameter test (src : LOC_REFERENCE (formaldef)))...'); - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_formaldef_array(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Const parameter test (src : LOC_REFERENCE (arraydef)))...'); - - - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_smallarray(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_smallarray_open(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - -{$ifndef tp} - write('Const parameter test (src : LOC_REFERENCE (const arraydef)))...'); - - clear_globals; - clear_values; - - value_u8bit := RESULT_U8BIT; - value_ptr := RESULT_PCHAR; - value_s64bit := RESULT_S64BIT; - value_smallstring := RESULT_SMALLSTRING; - value_class := tclass1.create; - value_boolean := RESULT_BOOLEAN; - value_char := RESULT_CHAR; - value_s64real:=RESULT_S64REAL; - proc_const_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real, - value_boolean,value_class]); - - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if global_char <> RESULT_CHAR then - failed := true; - if global_boolean <> RESULT_BOOLEAN then - failed:=true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed := true; - if global_bigstring <> RESULT_SMALLSTRING then - failed := true; - if global_ptr <> value_ptr then - failed := true; -{ if value_class <> global_class then - failed := true;!!!!!!!!!!!!!!!!!!!!} - if global_s64bit <> RESULT_S64BIT then - failed := true; - if assigned(value_class) then - value_class.destroy; - - global_u8bit := 0; - proc_const_smallarray_const_2([]); - if global_u8bit <> RESULT_U8BIT then - failed := true; -{$endif} - - if failed then - fail - else - WriteLn('Passed!'); - - - {***************************** MIXED TESTS *******************************} - write('Mixed const parameter test (src : LOC_REGISTER (orddef)))...'); - clear_globals; - clear_values; - failed:=false; - - proc_const_s32bit_mixed(RESULT_U8BIT,gets32bit,RESULT_U8BIT); - if global_s32bit <> RESULT_S32BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$ifndef tp} - proc_const_s64bit_mixed(RESULT_U8BIT,gets64bit,RESULT_U8BIT); - if global_s64bit <> RESULT_S64BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$endif} - if failed then - fail - else - WriteLn('Passed!'); - - write('Mixed const parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallrec.b := RESULT_U8BIT; - value_smallrec.w := RESULT_U16BIT; - proc_const_smallrecord_mixed(RESULT_U8BIT,value_smallrec,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); - proc_const_largerecord_mixed(RESULT_U8BIT,value_largerec,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Mixed const parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallset := [A_A,A_D]; - proc_const_smallset_mixed(RESULT_U8BIT,value_smallset,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_largeset := ['I']; - proc_const_largeset_mixed(RESULT_U8BIT,value_largeset,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - write('Mixed const parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - value_smallstring := RESULT_SMALLSTRING; - - proc_const_smallstring_mixed(RESULT_U8BIT,value_smallstring,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_bigstring := RESULT_BIGSTRING; - proc_const_bigstring_mixed(RESULT_U8BIT,value_bigstring,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - write('Mixed const parameter test (src : LOC_REFERENCE (formaldef)))...'); - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_formaldef_array_mixed(RESULT_U8BIT,value_smallarray,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Mixed const parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_smallarray_mixed(RESULT_U8BIt,value_smallarray,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_smallarray_open_mixed(RESULT_U8BIT,value_smallarray,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - -{$ifndef tp} - clear_globals; - clear_values; - - value_u8bit := RESULT_U8BIT; - value_ptr := RESULT_PCHAR; - value_s64bit := RESULT_S64BIT; - value_smallstring := RESULT_SMALLSTRING; - value_class := tclass1.create; - value_boolean := RESULT_BOOLEAN; - value_char := RESULT_CHAR; - value_s64real:=RESULT_S64REAL; - proc_const_smallarray_const_1_mixed(RESULT_U8BIT, [value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring, - value_s64real,value_boolean,value_class],RESULT_U8BIT); - - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if global_char <> RESULT_CHAR then - failed := true; - if global_boolean <> RESULT_BOOLEAN then - failed:=true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed := true; - if global_bigstring <> RESULT_SMALLSTRING then - failed := true; - if global_ptr <> value_ptr then - failed := true; -{ if value_class <> global_class then - failed := true;!!!!!!!!!!!!!!!!!!!!} - if global_s64bit <> RESULT_S64BIT then - failed := true; - if assigned(value_class) then - value_class.destroy; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - global_u8bit := 0; - proc_const_smallarray_const_2_mixed(RESULT_U8BIT,[],RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$endif} - - 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 } +{ (const parameters with stdcall calling convention) } +{****************************************************************} +program tcalcst8; +{$ifdef fpc} + {$mode objfpc} + {$INLINE ON} +{$endif} +{$R+} + +{$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; + value_u8bit : byte; + value_u16bit : word; + value_s32bit : longint; +{$ifndef tp} + global_class : tclass1; + global_s64bit : int64; + value_s64bit : int64; + value_class : tclass1; +{$endif} + 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; +{$ifndef tp} + global_s64bit := 0; + global_class := nil; +{$endif} + 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; +{$ifndef tp} + value_s64bit := 0; + value_class := nil; +{$endif} + 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; + end; + + + procedure testprocedure; + begin + end; + + function getu8bit : byte; + begin + getu8bit:=RESULT_U8BIT; + end; + + function getu16bit: word; + begin + getu16bit:=RESULT_U16BIT; + end; + + function gets32bit: longint; + begin + gets32bit:=RESULT_S32BIT; + end; + + function gets64bit: int64; + begin + gets64bit:=RESULT_S64BIT; + end; + + + function gets32real: single; + begin + gets32real:=RESULT_S32REAL; + end; + + function gets64real: double; + begin + gets64real:=RESULT_S64REAL; + end; + + {************************************************************************} + { CONST PARAMETERS } + {************************************************************************} + procedure proc_const_s32bit(const v : longint);stdcall; + begin + global_s32bit := v; + end; + +{$ifndef tp} + procedure proc_const_s64bit(const v: int64);stdcall; + begin + global_s64bit:= v; + end; + + procedure proc_const_smallarray_const_1(const arr : array of const);stdcall; + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : global_u8bit := arr[i].vinteger and $ff; + vtBoolean : global_boolean := arr[i].vboolean; + vtChar : global_char := arr[i].vchar; + vtExtended : global_s64real := arr[i].VExtended^; + vtString : global_bigstring := arr[i].VString^; + vtPointer : ; + vtPChar : global_ptr := arr[i].VPchar; + vtObject : ; +{ vtClass : global_class := (arr[i].VClass) as tclass1;} + vtAnsiString : ; + vtInt64 : global_s64bit := arr[i].vInt64^; + else + RunError(255); + end; + end; {endfor} + end; + + + procedure proc_const_smallarray_const_2(const arr : array of const);stdcall; + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + end; + +{$endif} + + + procedure proc_const_smallrecord(const smallrec : tsmallrecord);stdcall; + begin + if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_const_largerecord(const largerec : tlargerecord);stdcall; + begin + if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_const_smallset(const smallset : tsmallset);stdcall; + begin + if A_D in smallset then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_const_largeset(const largeset : tlargeset);stdcall; + begin + if 'I' in largeset then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_const_smallstring(const s:tsmallstring);stdcall; + begin + if s = RESULT_SMALLSTRING then + global_u8bit := RESULT_u8BIT; + end; + + + procedure proc_const_bigstring(const s:shortstring);stdcall; + begin + if s = RESULT_BIGSTRING then + global_u8bit := RESULT_u8BIT; + end; + + + procedure proc_const_smallarray(const arr : tsmallarray);stdcall; + begin + if arr[SMALL_INDEX] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_const_smallarray_open(const arr : array of byte);stdcall; + begin + { form 0 to N-1 indexes in open arrays } + if arr[SMALL_INDEX-1] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + end; + + + + + procedure proc_const_formaldef_array(const buf);stdcall; + var + p: pchar; + begin + { array is indexed from 1 } + p := @buf; + global_u8bit := byte(p[SMALL_INDEX-1]); + end; + + + {************************************************************************} + { MIXED CONST PARAMETERS } + {************************************************************************} + procedure proc_const_s32bit_mixed(b1: byte; const v : longint; b2: byte);stdcall; + begin + global_s32bit := v; + value_u8bit := b2; + end; + +{$ifndef tp} + procedure proc_const_s64bit_mixed(b1 : byte; const v: int64; b2: byte);stdcall; + begin + global_s64bit:= v; + value_u8bit := b2; + end; + + procedure proc_const_smallarray_const_1_mixed(b1 : byte; const arr : array of const; b2: byte);stdcall; + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : global_u8bit := arr[i].vinteger and $ff; + vtBoolean : global_boolean := arr[i].vboolean; + vtChar : global_char := arr[i].vchar; + vtExtended : global_s64real := arr[i].VExtended^; + vtString : global_bigstring := arr[i].VString^; + vtPointer : ; + vtPChar : global_ptr := arr[i].VPchar; + vtObject : ; +{ vtClass : global_class := (arr[i].VClass) as tclass1;} + vtAnsiString : ; + vtInt64 : global_s64bit := arr[i].vInt64^; + else + RunError(255); + end; + end; {endfor} + value_u8bit := b2; + end; + + + procedure proc_const_smallarray_const_2_mixed(b1: byte; const arr : array of const; b2: byte);stdcall; + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; +{$endif} + + + procedure proc_const_smallrecord_mixed(b1 : byte; const smallrec : tsmallrecord; b2: byte);stdcall; + begin + if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + procedure proc_const_largerecord_mixed(b1: byte; const largerec : tlargerecord; b2: byte);stdcall; + begin + if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + procedure proc_const_smallset_mixed(b1: byte; const smallset : tsmallset; b2: byte);stdcall; + begin + if A_D in smallset then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + procedure proc_const_largeset_mixed(b1: byte; const largeset : tlargeset; b2: byte);stdcall; + begin + if 'I' in largeset then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + procedure proc_const_smallstring_mixed(b1: byte; const s:tsmallstring; b2: byte);stdcall; + begin + if s = RESULT_SMALLSTRING then + global_u8bit := RESULT_u8BIT; + value_u8bit := b2; + end; + + + procedure proc_const_bigstring_mixed(b1: byte; const s:shortstring; b2: byte);stdcall; + begin + if s = RESULT_BIGSTRING then + global_u8bit := RESULT_u8BIT; + value_u8bit := b2; + end; + + + procedure proc_const_smallarray_mixed(b1: byte; const arr : tsmallarray; b2: byte);stdcall; + begin + if arr[SMALL_INDEX] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + procedure proc_const_smallarray_open_mixed(b1: byte; const arr : array of byte; b2: byte);stdcall; + begin + { form 0 to N-1 indexes in open arrays } + if arr[high(arr)] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + + + procedure proc_const_formaldef_array_mixed(b1: byte; const buf; b2: byte);stdcall; + var + p: pchar; + begin + { array is indexed from 1 } + p := @buf; + global_u8bit := byte(p[SMALL_INDEX-1]); + value_u8bit := b2; + end; + + +var + failed: boolean; + pp : ^pchar; +begin + {***************************** NORMAL TESTS *******************************} + write('Const parameter test (src : LOC_REGISTER (orddef)))...'); + clear_globals; + clear_values; + failed:=false; + + proc_const_s32bit(gets32bit); + if global_s32bit <> RESULT_S32BIT then + failed:=true; +{$ifndef tp} + proc_const_s64bit(gets64bit); + if global_s64bit <> RESULT_S64BIT then + failed:=true; +{$endif} + + if failed then + fail + else + WriteLn('Passed!'); + + write('Const parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallrec.b := RESULT_U8BIT; + value_smallrec.w := RESULT_U16BIT; + proc_const_smallrecord(value_smallrec); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); + proc_const_largerecord(value_largerec); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('const parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallset := [A_A,A_D]; + proc_const_smallset(value_smallset); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_largeset := ['I']; + proc_const_largeset(value_largeset); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + + + write('const parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + value_smallstring := RESULT_SMALLSTRING; + + proc_const_smallstring(value_smallstring); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_bigstring := RESULT_BIGSTRING; + proc_const_bigstring(value_bigstring); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + + write('Const parameter test (src : LOC_REFERENCE (formaldef)))...'); + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_formaldef_array(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Const parameter test (src : LOC_REFERENCE (arraydef)))...'); + + + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_smallarray(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_smallarray_open(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + +{$ifndef tp} + write('Const parameter test (src : LOC_REFERENCE (const arraydef)))...'); + + clear_globals; + clear_values; + + value_u8bit := RESULT_U8BIT; + value_ptr := RESULT_PCHAR; + value_s64bit := RESULT_S64BIT; + value_smallstring := RESULT_SMALLSTRING; + value_class := tclass1.create; + value_boolean := RESULT_BOOLEAN; + value_char := RESULT_CHAR; + value_s64real:=RESULT_S64REAL; + proc_const_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real, + value_boolean,value_class]); + + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if global_char <> RESULT_CHAR then + failed := true; + if global_boolean <> RESULT_BOOLEAN then + failed:=true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed := true; + if global_bigstring <> RESULT_SMALLSTRING then + failed := true; + if global_ptr <> value_ptr then + failed := true; +{ if value_class <> global_class then + failed := true;!!!!!!!!!!!!!!!!!!!!} + if global_s64bit <> RESULT_S64BIT then + failed := true; + if assigned(value_class) then + value_class.destroy; + + global_u8bit := 0; + proc_const_smallarray_const_2([]); + if global_u8bit <> RESULT_U8BIT then + failed := true; +{$endif} + + if failed then + fail + else + WriteLn('Passed!'); + + + {***************************** MIXED TESTS *******************************} + write('Mixed const parameter test (src : LOC_REGISTER (orddef)))...'); + clear_globals; + clear_values; + failed:=false; + + proc_const_s32bit_mixed(RESULT_U8BIT,gets32bit,RESULT_U8BIT); + if global_s32bit <> RESULT_S32BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$ifndef tp} + proc_const_s64bit_mixed(RESULT_U8BIT,gets64bit,RESULT_U8BIT); + if global_s64bit <> RESULT_S64BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$endif} + if failed then + fail + else + WriteLn('Passed!'); + + write('Mixed const parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallrec.b := RESULT_U8BIT; + value_smallrec.w := RESULT_U16BIT; + proc_const_smallrecord_mixed(RESULT_U8BIT,value_smallrec,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); + proc_const_largerecord_mixed(RESULT_U8BIT,value_largerec,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Mixed const parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallset := [A_A,A_D]; + proc_const_smallset_mixed(RESULT_U8BIT,value_smallset,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_largeset := ['I']; + proc_const_largeset_mixed(RESULT_U8BIT,value_largeset,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + write('Mixed const parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + value_smallstring := RESULT_SMALLSTRING; + + proc_const_smallstring_mixed(RESULT_U8BIT,value_smallstring,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_bigstring := RESULT_BIGSTRING; + proc_const_bigstring_mixed(RESULT_U8BIT,value_bigstring,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + write('Mixed const parameter test (src : LOC_REFERENCE (formaldef)))...'); + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_formaldef_array_mixed(RESULT_U8BIT,value_smallarray,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Mixed const parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_smallarray_mixed(RESULT_U8BIt,value_smallarray,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_smallarray_open_mixed(RESULT_U8BIT,value_smallarray,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + +{$ifndef tp} + clear_globals; + clear_values; + + value_u8bit := RESULT_U8BIT; + value_ptr := RESULT_PCHAR; + value_s64bit := RESULT_S64BIT; + value_smallstring := RESULT_SMALLSTRING; + value_class := tclass1.create; + value_boolean := RESULT_BOOLEAN; + value_char := RESULT_CHAR; + value_s64real:=RESULT_S64REAL; + proc_const_smallarray_const_1_mixed(RESULT_U8BIT, [value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring, + value_s64real,value_boolean,value_class],RESULT_U8BIT); + + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if global_char <> RESULT_CHAR then + failed := true; + if global_boolean <> RESULT_BOOLEAN then + failed:=true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed := true; + if global_bigstring <> RESULT_SMALLSTRING then + failed := true; + if global_ptr <> value_ptr then + failed := true; +{ if value_class <> global_class then + failed := true;!!!!!!!!!!!!!!!!!!!!} + if global_s64bit <> RESULT_S64BIT then + failed := true; + if assigned(value_class) then + value_class.destroy; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + global_u8bit := 0; + proc_const_smallarray_const_2_mixed(RESULT_U8BIT,[],RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$endif} + + if failed then + fail + else + WriteLn('Passed!'); +end. + +{ $Log$ - Revision 1.5 2002-10-08 07:42:19 pierre - * give result for arrays and const arrays separately - - Revision 1.4 2002/09/22 09:08:41 carl - * gets64bit was not returning an int64! - - Revision 1.3 2002/09/07 15:40:50 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 17:47:06 carl - + constant parameter passing for different calling conventions - -} + Revision 1.6 2003-04-22 10:24:29 florian + * fixed defines for powerpc + + Revision 1.5 2002/10/08 07:42:19 pierre + * give result for arrays and const arrays separately + + Revision 1.4 2002/09/22 09:08:41 carl + * gets64bit was not returning an int64! + + Revision 1.3 2002/09/07 15:40:50 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 17:47:06 carl + + constant parameter passing for different calling conventions + +} diff --git a/tests/test/cg/tcalcst9.pp b/tests/test/cg/tcalcst9.pp index 615eac0d70..8685a14103 100644 --- a/tests/test/cg/tcalcst9.pp +++ b/tests/test/cg/tcalcst9.pp @@ -1,863 +1,865 @@ -{****************************************************************} -{ 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 } -{ (const parameters with saveregisters } -{ calling convention) } -{****************************************************************} -program tcalcst9; -{$ifdef fpc} - {$mode objfpc} - {$INLINE ON} -{$endif} -{$R+} - -{$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; - {$endif} - {$ifdef cpui386} - 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; - value_u8bit : byte; - value_u16bit : word; - value_s32bit : longint; -{$ifndef tp} - global_class : tclass1; - global_s64bit : int64; - value_s64bit : int64; - value_class : tclass1; -{$endif} - 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; -{$ifndef tp} - global_s64bit := 0; - global_class := nil; -{$endif} - 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; -{$ifndef tp} - value_s64bit := 0; - value_class := nil; -{$endif} - 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; - end; - - - procedure testprocedure; - begin - end; - - function getu8bit : byte; - begin - getu8bit:=RESULT_U8BIT; - end; - - function getu16bit: word; - begin - getu16bit:=RESULT_U16BIT; - end; - - function gets32bit: longint; - begin - gets32bit:=RESULT_S32BIT; - end; - - function gets64bit: int64; - begin - gets64bit:=RESULT_S64BIT; - end; - - - function gets32real: single; - begin - gets32real:=RESULT_S32REAL; - end; - - function gets64real: double; - begin - gets64real:=RESULT_S64REAL; - end; - - {************************************************************************} - { CONST PARAMETERS } - {************************************************************************} - procedure proc_const_s32bit(const v : longint);saveregisters; - begin - global_s32bit := v; - end; - -{$ifndef tp} - procedure proc_const_s64bit(const v: int64);saveregisters; - begin - global_s64bit:= v; - end; - - procedure proc_const_smallarray_const_1(const arr : array of const);saveregisters; - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : global_u8bit := arr[i].vinteger and $ff; - vtBoolean : global_boolean := arr[i].vboolean; - vtChar : global_char := arr[i].vchar; - vtExtended : global_s64real := arr[i].VExtended^; - vtString : global_bigstring := arr[i].VString^; - vtPointer : ; - vtPChar : global_ptr := arr[i].VPchar; - vtObject : ; -{ vtClass : global_class := (arr[i].VClass) as tclass1;} - vtAnsiString : ; - vtInt64 : global_s64bit := arr[i].vInt64^; - else - RunError(255); - end; - end; {endfor} - end; - - - procedure proc_const_smallarray_const_2(const arr : array of const);saveregisters; - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - end; - -{$endif} - - - procedure proc_const_smallrecord(const smallrec : tsmallrecord);saveregisters; - begin - if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_const_largerecord(const largerec : tlargerecord);saveregisters; - begin - if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_const_smallset(const smallset : tsmallset);saveregisters; - begin - if A_D in smallset then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_const_largeset(const largeset : tlargeset);saveregisters; - begin - if 'I' in largeset then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_const_smallstring(const s:tsmallstring);saveregisters; - begin - if s = RESULT_SMALLSTRING then - global_u8bit := RESULT_u8BIT; - end; - - - procedure proc_const_bigstring(const s:shortstring);saveregisters; - begin - if s = RESULT_BIGSTRING then - global_u8bit := RESULT_u8BIT; - end; - - - procedure proc_const_smallarray(const arr : tsmallarray);saveregisters; - begin - if arr[SMALL_INDEX] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_const_smallarray_open(const arr : array of byte);saveregisters; - begin - { form 0 to N-1 indexes in open arrays } - if arr[SMALL_INDEX-1] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - end; - - - - - procedure proc_const_formaldef_array(const buf);saveregisters; - var - p: pchar; - begin - { array is indexed from 1 } - p := @buf; - global_u8bit := byte(p[SMALL_INDEX-1]); - end; - - - {************************************************************************} - { MIXED CONST PARAMETERS } - {************************************************************************} - procedure proc_const_s32bit_mixed(b1: byte; const v : longint; b2: byte);saveregisters; - begin - global_s32bit := v; - value_u8bit := b2; - end; - -{$ifndef tp} - procedure proc_const_s64bit_mixed(b1 : byte; const v: int64; b2: byte);saveregisters; - begin - global_s64bit:= v; - value_u8bit := b2; - end; - - procedure proc_const_smallarray_const_1_mixed(b1 : byte; const arr : array of const; b2: byte);saveregisters; - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : global_u8bit := arr[i].vinteger and $ff; - vtBoolean : global_boolean := arr[i].vboolean; - vtChar : global_char := arr[i].vchar; - vtExtended : global_s64real := arr[i].VExtended^; - vtString : global_bigstring := arr[i].VString^; - vtPointer : ; - vtPChar : global_ptr := arr[i].VPchar; - vtObject : ; -{ vtClass : global_class := (arr[i].VClass) as tclass1;} - vtAnsiString : ; - vtInt64 : global_s64bit := arr[i].vInt64^; - else - RunError(255); - end; - end; {endfor} - value_u8bit := b2; - end; - - - procedure proc_const_smallarray_const_2_mixed(b1: byte; const arr : array of const; b2: byte);saveregisters; - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; -{$endif} - - - procedure proc_const_smallrecord_mixed(b1 : byte; const smallrec : tsmallrecord; b2: byte);saveregisters; - begin - if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - procedure proc_const_largerecord_mixed(b1: byte; const largerec : tlargerecord; b2: byte);saveregisters; - begin - if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - procedure proc_const_smallset_mixed(b1: byte; const smallset : tsmallset; b2: byte);saveregisters; - begin - if A_D in smallset then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - procedure proc_const_largeset_mixed(b1: byte; const largeset : tlargeset; b2: byte);saveregisters; - begin - if 'I' in largeset then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - procedure proc_const_smallstring_mixed(b1: byte; const s:tsmallstring; b2: byte);saveregisters; - begin - if s = RESULT_SMALLSTRING then - global_u8bit := RESULT_u8BIT; - value_u8bit := b2; - end; - - - procedure proc_const_bigstring_mixed(b1: byte; const s:shortstring; b2: byte);saveregisters; - begin - if s = RESULT_BIGSTRING then - global_u8bit := RESULT_u8BIT; - value_u8bit := b2; - end; - - - procedure proc_const_smallarray_mixed(b1: byte; const arr : tsmallarray; b2: byte);saveregisters; - begin - if arr[SMALL_INDEX] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - procedure proc_const_smallarray_open_mixed(b1: byte; const arr : array of byte; b2: byte);saveregisters; - begin - { form 0 to N-1 indexes in open arrays } - if arr[high(arr)] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - - - procedure proc_const_formaldef_array_mixed(b1: byte; const buf; b2: byte);saveregisters; - var - p: pchar; - begin - { array is indexed from 1 } - p := @buf; - global_u8bit := byte(p[SMALL_INDEX-1]); - value_u8bit := b2; - end; - - -var - failed: boolean; - pp : ^pchar; -begin - {***************************** NORMAL TESTS *******************************} - write('Const parameter test (src : LOC_REGISTER (orddef)))...'); - clear_globals; - clear_values; - failed:=false; - - proc_const_s32bit(gets32bit); - if global_s32bit <> RESULT_S32BIT then - failed:=true; -{$ifndef tp} - proc_const_s64bit(gets64bit); - if global_s64bit <> RESULT_S64BIT then - failed:=true; -{$endif} - - if failed then - fail - else - WriteLn('Passed!'); - - write('Const parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallrec.b := RESULT_U8BIT; - value_smallrec.w := RESULT_U16BIT; - proc_const_smallrecord(value_smallrec); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); - proc_const_largerecord(value_largerec); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('const parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallset := [A_A,A_D]; - proc_const_smallset(value_smallset); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_largeset := ['I']; - proc_const_largeset(value_largeset); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - - - write('const parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - value_smallstring := RESULT_SMALLSTRING; - - proc_const_smallstring(value_smallstring); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_bigstring := RESULT_BIGSTRING; - proc_const_bigstring(value_bigstring); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - - write('Const parameter test (src : LOC_REFERENCE (formaldef)))...'); - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_formaldef_array(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Const parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_smallarray(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_smallarray_open(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - -{$ifndef tp} - clear_globals; - clear_values; - - value_u8bit := RESULT_U8BIT; - value_ptr := RESULT_PCHAR; - value_s64bit := RESULT_S64BIT; - value_smallstring := RESULT_SMALLSTRING; - value_class := tclass1.create; - value_boolean := RESULT_BOOLEAN; - value_char := RESULT_CHAR; - value_s64real:=RESULT_S64REAL; - proc_const_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real, - value_boolean,value_class]); - - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if global_char <> RESULT_CHAR then - failed := true; - if global_boolean <> RESULT_BOOLEAN then - failed:=true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed := true; - if global_bigstring <> RESULT_SMALLSTRING then - failed := true; - if global_ptr <> value_ptr then - failed := true; -{ if value_class <> global_class then - failed := true;!!!!!!!!!!!!!!!!!!!!} - if global_s64bit <> RESULT_S64BIT then - failed := true; - if assigned(value_class) then - value_class.destroy; - - global_u8bit := 0; - proc_const_smallarray_const_2([]); - if global_u8bit <> RESULT_U8BIT then - failed := true; -{$endif} - - if failed then - fail - else - WriteLn('Passed!'); - - - {***************************** MIXED TESTS *******************************} - write('Mixed const parameter test (src : LOC_REGISTER (orddef)))...'); - clear_globals; - clear_values; - failed:=false; - - proc_const_s32bit_mixed(RESULT_U8BIT,gets32bit,RESULT_U8BIT); - if global_s32bit <> RESULT_S32BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$ifndef tp} - proc_const_s64bit_mixed(RESULT_U8BIT,gets64bit,RESULT_U8BIT); - if global_s64bit <> RESULT_S64BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$endif} - if failed then - fail - else - WriteLn('Passed!'); - - write('Mixed const parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallrec.b := RESULT_U8BIT; - value_smallrec.w := RESULT_U16BIT; - proc_const_smallrecord_mixed(RESULT_U8BIT,value_smallrec,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); - proc_const_largerecord_mixed(RESULT_U8BIT,value_largerec,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Mixed const parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallset := [A_A,A_D]; - proc_const_smallset_mixed(RESULT_U8BIT,value_smallset,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_largeset := ['I']; - proc_const_largeset_mixed(RESULT_U8BIT,value_largeset,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - write('Mixed const parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - value_smallstring := RESULT_SMALLSTRING; - - proc_const_smallstring_mixed(RESULT_U8BIT,value_smallstring,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_bigstring := RESULT_BIGSTRING; - proc_const_bigstring_mixed(RESULT_U8BIT,value_bigstring,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - write('Mixed const parameter test (src : LOC_REFERENCE (formaldef)))...'); - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_formaldef_array_mixed(RESULT_U8BIT,value_smallarray,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Mixed const parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_smallarray_mixed(RESULT_U8BIt,value_smallarray,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_const_smallarray_open_mixed(RESULT_U8BIT,value_smallarray,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - -{$ifndef tp} - clear_globals; - clear_values; - - value_u8bit := RESULT_U8BIT; - value_ptr := RESULT_PCHAR; - value_s64bit := RESULT_S64BIT; - value_smallstring := RESULT_SMALLSTRING; - value_class := tclass1.create; - value_boolean := RESULT_BOOLEAN; - value_char := RESULT_CHAR; - value_s64real:=RESULT_S64REAL; - proc_const_smallarray_const_1_mixed(RESULT_U8BIT, [value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring, - value_s64real,value_boolean,value_class],RESULT_U8BIT); - - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if global_char <> RESULT_CHAR then - failed := true; - if global_boolean <> RESULT_BOOLEAN then - failed:=true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed := true; - if global_bigstring <> RESULT_SMALLSTRING then - failed := true; - if global_ptr <> value_ptr then - failed := true; -{ if value_class <> global_class then - failed := true;!!!!!!!!!!!!!!!!!!!!} - if global_s64bit <> RESULT_S64BIT then - failed := true; - if assigned(value_class) then - value_class.destroy; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - global_u8bit := 0; - proc_const_smallarray_const_2_mixed(RESULT_U8BIT,[],RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$endif} - - 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 } +{ (const parameters with saveregisters } +{ calling convention) } +{****************************************************************} +program tcalcst9; +{$ifdef fpc} + {$mode objfpc} + {$INLINE ON} +{$endif} +{$R+} + +{$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; + value_u8bit : byte; + value_u16bit : word; + value_s32bit : longint; +{$ifndef tp} + global_class : tclass1; + global_s64bit : int64; + value_s64bit : int64; + value_class : tclass1; +{$endif} + 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; +{$ifndef tp} + global_s64bit := 0; + global_class := nil; +{$endif} + 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; +{$ifndef tp} + value_s64bit := 0; + value_class := nil; +{$endif} + 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; + end; + + + procedure testprocedure; + begin + end; + + function getu8bit : byte; + begin + getu8bit:=RESULT_U8BIT; + end; + + function getu16bit: word; + begin + getu16bit:=RESULT_U16BIT; + end; + + function gets32bit: longint; + begin + gets32bit:=RESULT_S32BIT; + end; + + function gets64bit: int64; + begin + gets64bit:=RESULT_S64BIT; + end; + + + function gets32real: single; + begin + gets32real:=RESULT_S32REAL; + end; + + function gets64real: double; + begin + gets64real:=RESULT_S64REAL; + end; + + {************************************************************************} + { CONST PARAMETERS } + {************************************************************************} + procedure proc_const_s32bit(const v : longint);saveregisters; + begin + global_s32bit := v; + end; + +{$ifndef tp} + procedure proc_const_s64bit(const v: int64);saveregisters; + begin + global_s64bit:= v; + end; + + procedure proc_const_smallarray_const_1(const arr : array of const);saveregisters; + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : global_u8bit := arr[i].vinteger and $ff; + vtBoolean : global_boolean := arr[i].vboolean; + vtChar : global_char := arr[i].vchar; + vtExtended : global_s64real := arr[i].VExtended^; + vtString : global_bigstring := arr[i].VString^; + vtPointer : ; + vtPChar : global_ptr := arr[i].VPchar; + vtObject : ; +{ vtClass : global_class := (arr[i].VClass) as tclass1;} + vtAnsiString : ; + vtInt64 : global_s64bit := arr[i].vInt64^; + else + RunError(255); + end; + end; {endfor} + end; + + + procedure proc_const_smallarray_const_2(const arr : array of const);saveregisters; + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + end; + +{$endif} + + + procedure proc_const_smallrecord(const smallrec : tsmallrecord);saveregisters; + begin + if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_const_largerecord(const largerec : tlargerecord);saveregisters; + begin + if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_const_smallset(const smallset : tsmallset);saveregisters; + begin + if A_D in smallset then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_const_largeset(const largeset : tlargeset);saveregisters; + begin + if 'I' in largeset then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_const_smallstring(const s:tsmallstring);saveregisters; + begin + if s = RESULT_SMALLSTRING then + global_u8bit := RESULT_u8BIT; + end; + + + procedure proc_const_bigstring(const s:shortstring);saveregisters; + begin + if s = RESULT_BIGSTRING then + global_u8bit := RESULT_u8BIT; + end; + + + procedure proc_const_smallarray(const arr : tsmallarray);saveregisters; + begin + if arr[SMALL_INDEX] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_const_smallarray_open(const arr : array of byte);saveregisters; + begin + { form 0 to N-1 indexes in open arrays } + if arr[SMALL_INDEX-1] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + end; + + + + + procedure proc_const_formaldef_array(const buf);saveregisters; + var + p: pchar; + begin + { array is indexed from 1 } + p := @buf; + global_u8bit := byte(p[SMALL_INDEX-1]); + end; + + + {************************************************************************} + { MIXED CONST PARAMETERS } + {************************************************************************} + procedure proc_const_s32bit_mixed(b1: byte; const v : longint; b2: byte);saveregisters; + begin + global_s32bit := v; + value_u8bit := b2; + end; + +{$ifndef tp} + procedure proc_const_s64bit_mixed(b1 : byte; const v: int64; b2: byte);saveregisters; + begin + global_s64bit:= v; + value_u8bit := b2; + end; + + procedure proc_const_smallarray_const_1_mixed(b1 : byte; const arr : array of const; b2: byte);saveregisters; + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : global_u8bit := arr[i].vinteger and $ff; + vtBoolean : global_boolean := arr[i].vboolean; + vtChar : global_char := arr[i].vchar; + vtExtended : global_s64real := arr[i].VExtended^; + vtString : global_bigstring := arr[i].VString^; + vtPointer : ; + vtPChar : global_ptr := arr[i].VPchar; + vtObject : ; +{ vtClass : global_class := (arr[i].VClass) as tclass1;} + vtAnsiString : ; + vtInt64 : global_s64bit := arr[i].vInt64^; + else + RunError(255); + end; + end; {endfor} + value_u8bit := b2; + end; + + + procedure proc_const_smallarray_const_2_mixed(b1: byte; const arr : array of const; b2: byte);saveregisters; + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; +{$endif} + + + procedure proc_const_smallrecord_mixed(b1 : byte; const smallrec : tsmallrecord; b2: byte);saveregisters; + begin + if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + procedure proc_const_largerecord_mixed(b1: byte; const largerec : tlargerecord; b2: byte);saveregisters; + begin + if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + procedure proc_const_smallset_mixed(b1: byte; const smallset : tsmallset; b2: byte);saveregisters; + begin + if A_D in smallset then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + procedure proc_const_largeset_mixed(b1: byte; const largeset : tlargeset; b2: byte);saveregisters; + begin + if 'I' in largeset then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + procedure proc_const_smallstring_mixed(b1: byte; const s:tsmallstring; b2: byte);saveregisters; + begin + if s = RESULT_SMALLSTRING then + global_u8bit := RESULT_u8BIT; + value_u8bit := b2; + end; + + + procedure proc_const_bigstring_mixed(b1: byte; const s:shortstring; b2: byte);saveregisters; + begin + if s = RESULT_BIGSTRING then + global_u8bit := RESULT_u8BIT; + value_u8bit := b2; + end; + + + procedure proc_const_smallarray_mixed(b1: byte; const arr : tsmallarray; b2: byte);saveregisters; + begin + if arr[SMALL_INDEX] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + procedure proc_const_smallarray_open_mixed(b1: byte; const arr : array of byte; b2: byte);saveregisters; + begin + { form 0 to N-1 indexes in open arrays } + if arr[high(arr)] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + + + procedure proc_const_formaldef_array_mixed(b1: byte; const buf; b2: byte);saveregisters; + var + p: pchar; + begin + { array is indexed from 1 } + p := @buf; + global_u8bit := byte(p[SMALL_INDEX-1]); + value_u8bit := b2; + end; + + +var + failed: boolean; + pp : ^pchar; +begin + {***************************** NORMAL TESTS *******************************} + write('Const parameter test (src : LOC_REGISTER (orddef)))...'); + clear_globals; + clear_values; + failed:=false; + + proc_const_s32bit(gets32bit); + if global_s32bit <> RESULT_S32BIT then + failed:=true; +{$ifndef tp} + proc_const_s64bit(gets64bit); + if global_s64bit <> RESULT_S64BIT then + failed:=true; +{$endif} + + if failed then + fail + else + WriteLn('Passed!'); + + write('Const parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallrec.b := RESULT_U8BIT; + value_smallrec.w := RESULT_U16BIT; + proc_const_smallrecord(value_smallrec); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); + proc_const_largerecord(value_largerec); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('const parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallset := [A_A,A_D]; + proc_const_smallset(value_smallset); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_largeset := ['I']; + proc_const_largeset(value_largeset); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + + + write('const parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + value_smallstring := RESULT_SMALLSTRING; + + proc_const_smallstring(value_smallstring); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_bigstring := RESULT_BIGSTRING; + proc_const_bigstring(value_bigstring); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + + write('Const parameter test (src : LOC_REFERENCE (formaldef)))...'); + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_formaldef_array(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Const parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_smallarray(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_smallarray_open(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + +{$ifndef tp} + clear_globals; + clear_values; + + value_u8bit := RESULT_U8BIT; + value_ptr := RESULT_PCHAR; + value_s64bit := RESULT_S64BIT; + value_smallstring := RESULT_SMALLSTRING; + value_class := tclass1.create; + value_boolean := RESULT_BOOLEAN; + value_char := RESULT_CHAR; + value_s64real:=RESULT_S64REAL; + proc_const_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real, + value_boolean,value_class]); + + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if global_char <> RESULT_CHAR then + failed := true; + if global_boolean <> RESULT_BOOLEAN then + failed:=true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed := true; + if global_bigstring <> RESULT_SMALLSTRING then + failed := true; + if global_ptr <> value_ptr then + failed := true; +{ if value_class <> global_class then + failed := true;!!!!!!!!!!!!!!!!!!!!} + if global_s64bit <> RESULT_S64BIT then + failed := true; + if assigned(value_class) then + value_class.destroy; + + global_u8bit := 0; + proc_const_smallarray_const_2([]); + if global_u8bit <> RESULT_U8BIT then + failed := true; +{$endif} + + if failed then + fail + else + WriteLn('Passed!'); + + + {***************************** MIXED TESTS *******************************} + write('Mixed const parameter test (src : LOC_REGISTER (orddef)))...'); + clear_globals; + clear_values; + failed:=false; + + proc_const_s32bit_mixed(RESULT_U8BIT,gets32bit,RESULT_U8BIT); + if global_s32bit <> RESULT_S32BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$ifndef tp} + proc_const_s64bit_mixed(RESULT_U8BIT,gets64bit,RESULT_U8BIT); + if global_s64bit <> RESULT_S64BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$endif} + if failed then + fail + else + WriteLn('Passed!'); + + write('Mixed const parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallrec.b := RESULT_U8BIT; + value_smallrec.w := RESULT_U16BIT; + proc_const_smallrecord_mixed(RESULT_U8BIT,value_smallrec,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); + proc_const_largerecord_mixed(RESULT_U8BIT,value_largerec,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Mixed const parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallset := [A_A,A_D]; + proc_const_smallset_mixed(RESULT_U8BIT,value_smallset,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_largeset := ['I']; + proc_const_largeset_mixed(RESULT_U8BIT,value_largeset,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + write('Mixed const parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + value_smallstring := RESULT_SMALLSTRING; + + proc_const_smallstring_mixed(RESULT_U8BIT,value_smallstring,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_bigstring := RESULT_BIGSTRING; + proc_const_bigstring_mixed(RESULT_U8BIT,value_bigstring,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + write('Mixed const parameter test (src : LOC_REFERENCE (formaldef)))...'); + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_formaldef_array_mixed(RESULT_U8BIT,value_smallarray,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Mixed const parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_smallarray_mixed(RESULT_U8BIt,value_smallarray,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_const_smallarray_open_mixed(RESULT_U8BIT,value_smallarray,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + +{$ifndef tp} + clear_globals; + clear_values; + + value_u8bit := RESULT_U8BIT; + value_ptr := RESULT_PCHAR; + value_s64bit := RESULT_S64BIT; + value_smallstring := RESULT_SMALLSTRING; + value_class := tclass1.create; + value_boolean := RESULT_BOOLEAN; + value_char := RESULT_CHAR; + value_s64real:=RESULT_S64REAL; + proc_const_smallarray_const_1_mixed(RESULT_U8BIT, [value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring, + value_s64real,value_boolean,value_class],RESULT_U8BIT); + + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if global_char <> RESULT_CHAR then + failed := true; + if global_boolean <> RESULT_BOOLEAN then + failed:=true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed := true; + if global_bigstring <> RESULT_SMALLSTRING then + failed := true; + if global_ptr <> value_ptr then + failed := true; +{ if value_class <> global_class then + failed := true;!!!!!!!!!!!!!!!!!!!!} + if global_s64bit <> RESULT_S64BIT then + failed := true; + if assigned(value_class) then + value_class.destroy; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + global_u8bit := 0; + proc_const_smallarray_const_2_mixed(RESULT_U8BIT,[],RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$endif} + + if failed then + fail + else + WriteLn('Passed!'); +end. + +{ $Log$ - Revision 1.4 2002-09-22 09:08:41 carl - * gets64bit was not returning an int64! - - 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 17:47:06 carl - + constant parameter passing for different calling conventions - -} + Revision 1.5 2003-04-22 10:24:29 florian + * fixed defines for powerpc + + Revision 1.4 2002/09/22 09:08:41 carl + * gets64bit was not returning an int64! + + 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 17:47:06 carl + + constant parameter passing for different calling conventions + +} diff --git a/tests/test/cg/tcalfun1.pp b/tests/test/cg/tcalfun1.pp index 68690fe023..dedb89a9bf 100644 --- a/tests/test/cg/tcalfun1.pp +++ b/tests/test/cg/tcalfun1.pp @@ -1,1417 +1,1419 @@ - {****************************************************************} - { 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 standard calling cnvs) } - { (also tests nested routines up to 2 level deep) } - {****************************************************************} - program tcalfun1; - - {$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; - {$endif} - {$ifdef cpui386} - 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; - 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; - 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; - begin - func_shortstring := RESULT_BIGSTRING; - end; - -function func_largeset : tlargeset; - var - largeset : tlargeset; - begin - largeset := ['I']; - func_largeset := largeset; - end; - -function func_u8bit : byte; - begin - func_u8bit := RESULT_U8BIT; - end; - -function func_u16bit : word; - begin - func_u16bit := RESULT_U16BIT; - end; - -function func_s32bit : longint; - begin - func_s32bit := RESULT_S32BIT; - end; - -function func_s64bit : int64; - begin - func_s64bit := RESULT_S64BIT; - end; - -function func_s32real : single; - begin - func_s32real := RESULT_S32REAL; - end; - -function func_s64real : double; - begin - func_s64real := RESULT_S64REAl; - end; - -function func_ansistring : ansistring; - begin - func_ansistring := RESULT_BIGSTRING; - end; - -function func_pchar : pchar; - begin - func_pchar := RESULT_PCHAR; - end; - - {************************** FUNCTION RESULT WITH PARAMS ******************} -{ LOC_MEM return values } -function func_array_mixed(b: byte): tsmallarray; - 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; - 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; - var - local_b: byte; - begin - func_shortstring_mixed := RESULT_BIGSTRING; - local_b:=b; - global_u8bit := b; - end; - -function func_largeset_mixed(b: byte) : tlargeset; - 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; - var - local_b: byte; - begin - func_u8bit_mixed := RESULT_U8BIT; - local_b:=b; - global_u8bit := b; - end; - -function func_u16bit_mixed(b: byte) : word; - var - local_b: byte; - begin - func_u16bit_mixed := RESULT_U16BIT; - local_b:=b; - global_u8bit := b; - end; - -function func_s32bit_mixed(b: byte) : longint; - var - local_b: byte; - begin - func_s32bit_mixed := RESULT_S32BIT; - local_b:=b; - global_u8bit := b; - end; - -function func_s64bit_mixed(b: byte) : int64; - var - local_b: byte; - begin - func_s64bit_mixed := RESULT_S64BIT; - local_b:=b; - global_u8bit := b; - end; - -function func_s32real_mixed(b: byte) : single; - var - local_b: byte; - begin - func_s32real_mixed := RESULT_S32REAL; - local_b:=b; - global_u8bit := b; - end; - -function func_s64real_mixed(b: byte) : double; - var - local_b: byte; - begin - func_s64real_mixed := RESULT_S64REAl; - local_b:=b; - global_u8bit := b; - end; - -function func_ansistring_mixed(b: byte) : ansistring; - var - local_b: byte; - begin - func_ansistring_mixed := RESULT_BIGSTRING; - local_b:=b; - global_u8bit := b; - end; - -function func_pchar_mixed(b: byte) : pchar; - 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; - - 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; - - 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; - - 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; - - 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; - - 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; - - 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; - - 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; - - 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; - - 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; - - 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; - - 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; - - 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 standard calling cnvs) } + { (also tests nested routines up to 2 level deep) } + {****************************************************************} + program tcalfun1; + + {$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; + 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; + 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; + begin + func_shortstring := RESULT_BIGSTRING; + end; + +function func_largeset : tlargeset; + var + largeset : tlargeset; + begin + largeset := ['I']; + func_largeset := largeset; + end; + +function func_u8bit : byte; + begin + func_u8bit := RESULT_U8BIT; + end; + +function func_u16bit : word; + begin + func_u16bit := RESULT_U16BIT; + end; + +function func_s32bit : longint; + begin + func_s32bit := RESULT_S32BIT; + end; + +function func_s64bit : int64; + begin + func_s64bit := RESULT_S64BIT; + end; + +function func_s32real : single; + begin + func_s32real := RESULT_S32REAL; + end; + +function func_s64real : double; + begin + func_s64real := RESULT_S64REAl; + end; + +function func_ansistring : ansistring; + begin + func_ansistring := RESULT_BIGSTRING; + end; + +function func_pchar : pchar; + begin + func_pchar := RESULT_PCHAR; + end; + + {************************** FUNCTION RESULT WITH PARAMS ******************} +{ LOC_MEM return values } +function func_array_mixed(b: byte): tsmallarray; + 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; + 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; + var + local_b: byte; + begin + func_shortstring_mixed := RESULT_BIGSTRING; + local_b:=b; + global_u8bit := b; + end; + +function func_largeset_mixed(b: byte) : tlargeset; + 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; + var + local_b: byte; + begin + func_u8bit_mixed := RESULT_U8BIT; + local_b:=b; + global_u8bit := b; + end; + +function func_u16bit_mixed(b: byte) : word; + var + local_b: byte; + begin + func_u16bit_mixed := RESULT_U16BIT; + local_b:=b; + global_u8bit := b; + end; + +function func_s32bit_mixed(b: byte) : longint; + var + local_b: byte; + begin + func_s32bit_mixed := RESULT_S32BIT; + local_b:=b; + global_u8bit := b; + end; + +function func_s64bit_mixed(b: byte) : int64; + var + local_b: byte; + begin + func_s64bit_mixed := RESULT_S64BIT; + local_b:=b; + global_u8bit := b; + end; + +function func_s32real_mixed(b: byte) : single; + var + local_b: byte; + begin + func_s32real_mixed := RESULT_S32REAL; + local_b:=b; + global_u8bit := b; + end; + +function func_s64real_mixed(b: byte) : double; + var + local_b: byte; + begin + func_s64real_mixed := RESULT_S64REAl; + local_b:=b; + global_u8bit := b; + end; + +function func_ansistring_mixed(b: byte) : ansistring; + var + local_b: byte; + begin + func_ansistring_mixed := RESULT_BIGSTRING; + local_b:=b; + global_u8bit := b; + end; + +function func_pchar_mixed(b: byte) : pchar; + 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; + + 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; + + 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; + + 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; + + 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; + + 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; + + 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; + + 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; + + 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; + + 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; + + 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; + + 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; + + 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 2002-09-07 15:40:51 peter - * old logs removed and tabs fixed - - Revision 1.3 2002/05/13 13:45:36 peter - * updated to compile tests with kylix - - Revision 1.2 2002/04/13 07:48:47 carl - + testing for symtablelevel = lexlevel - - Revision 1.1 2002/04/11 19:35:49 carl - + function call testing -} + Revision 1.5 2003-04-22 10:24:29 florian + * fixed defines for powerpc + + Revision 1.4 2002/09/07 15:40:51 peter + * old logs removed and tabs fixed + + Revision 1.3 2002/05/13 13:45:36 peter + * updated to compile tests with kylix + + Revision 1.2 2002/04/13 07:48:47 carl + + testing for symtablelevel = lexlevel + + Revision 1.1 2002/04/11 19:35:49 carl + + function call testing +} diff --git a/tests/test/cg/tcalfun2.pp b/tests/test/cg/tcalfun2.pp index 61285e02ed..690da07be6 100644 --- a/tests/test/cg/tcalfun2.pp +++ b/tests/test/cg/tcalfun2.pp @@ -1,1415 +1,1417 @@ - {****************************************************************} - { 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; - {$endif} - {$ifdef cpui386} - 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.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.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. + +} diff --git a/tests/test/cg/tcalfun3.pp b/tests/test/cg/tcalfun3.pp index fcb9d20357..32a2b962af 100644 --- a/tests/test/cg/tcalfun3.pp +++ b/tests/test/cg/tcalfun3.pp @@ -1,1415 +1,1417 @@ - {****************************************************************} - { 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; - {$endif} - {$ifdef cpui386} - 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.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.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. + +} diff --git a/tests/test/cg/tcalfun4.pp b/tests/test/cg/tcalfun4.pp index 179c00e041..2d68eec2b0 100644 --- a/tests/test/cg/tcalfun4.pp +++ b/tests/test/cg/tcalfun4.pp @@ -1,1415 +1,1417 @@ - {****************************************************************} - { 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 popstack calling cnvs) } - { (also tests nested routines up to 2 level deep) } - {****************************************************************} - program tcalfun4; - - {$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; - {$endif} - {$ifdef cpui386} - 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;popstack; - 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;popstack; - 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;popstack; - begin - func_shortstring := RESULT_BIGSTRING; - end; - -function func_largeset : tlargeset;popstack; - var - largeset : tlargeset; - begin - largeset := ['I']; - func_largeset := largeset; - end; - -function func_u8bit : byte;popstack; - begin - func_u8bit := RESULT_U8BIT; - end; - -function func_u16bit : word;popstack; - begin - func_u16bit := RESULT_U16BIT; - end; - -function func_s32bit : longint;popstack; - begin - func_s32bit := RESULT_S32BIT; - end; - -function func_s64bit : int64;popstack; - begin - func_s64bit := RESULT_S64BIT; - end; - -function func_s32real : single;popstack; - begin - func_s32real := RESULT_S32REAL; - end; - -function func_s64real : double;popstack; - begin - func_s64real := RESULT_S64REAl; - end; - -function func_ansistring : ansistring;popstack; - begin - func_ansistring := RESULT_BIGSTRING; - end; - -function func_pchar : pchar;popstack; - begin - func_pchar := RESULT_PCHAR; - end; - - {************************** FUNCTION RESULT WITH PARAMS ******************} -{ LOC_MEM return values } -function func_array_mixed(b: byte): tsmallarray;popstack; - 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;popstack; - 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;popstack; - var - local_b: byte; - begin - func_shortstring_mixed := RESULT_BIGSTRING; - local_b:=b; - global_u8bit := b; - end; - -function func_largeset_mixed(b: byte) : tlargeset;popstack; - 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;popstack; - var - local_b: byte; - begin - func_u8bit_mixed := RESULT_U8BIT; - local_b:=b; - global_u8bit := b; - end; - -function func_u16bit_mixed(b: byte) : word;popstack; - var - local_b: byte; - begin - func_u16bit_mixed := RESULT_U16BIT; - local_b:=b; - global_u8bit := b; - end; - -function func_s32bit_mixed(b: byte) : longint;popstack; - var - local_b: byte; - begin - func_s32bit_mixed := RESULT_S32BIT; - local_b:=b; - global_u8bit := b; - end; - -function func_s64bit_mixed(b: byte) : int64;popstack; - var - local_b: byte; - begin - func_s64bit_mixed := RESULT_S64BIT; - local_b:=b; - global_u8bit := b; - end; - -function func_s32real_mixed(b: byte) : single;popstack; - var - local_b: byte; - begin - func_s32real_mixed := RESULT_S32REAL; - local_b:=b; - global_u8bit := b; - end; - -function func_s64real_mixed(b: byte) : double;popstack; - var - local_b: byte; - begin - func_s64real_mixed := RESULT_S64REAl; - local_b:=b; - global_u8bit := b; - end; - -function func_ansistring_mixed(b: byte) : ansistring;popstack; - var - local_b: byte; - begin - func_ansistring_mixed := RESULT_BIGSTRING; - local_b:=b; - global_u8bit := b; - end; - -function func_pchar_mixed(b: byte) : pchar;popstack; - 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;popstack; - - 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;popstack; - - 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;popstack; - - 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;popstack; - - 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;popstack; - - 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;popstack; - - 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;popstack; - - 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;popstack; - - 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;popstack; - - 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;popstack; - - 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;popstack; - - 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;popstack; - - 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 popstack calling cnvs) } + { (also tests nested routines up to 2 level deep) } + {****************************************************************} + program tcalfun4; + + {$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;popstack; + 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;popstack; + 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;popstack; + begin + func_shortstring := RESULT_BIGSTRING; + end; + +function func_largeset : tlargeset;popstack; + var + largeset : tlargeset; + begin + largeset := ['I']; + func_largeset := largeset; + end; + +function func_u8bit : byte;popstack; + begin + func_u8bit := RESULT_U8BIT; + end; + +function func_u16bit : word;popstack; + begin + func_u16bit := RESULT_U16BIT; + end; + +function func_s32bit : longint;popstack; + begin + func_s32bit := RESULT_S32BIT; + end; + +function func_s64bit : int64;popstack; + begin + func_s64bit := RESULT_S64BIT; + end; + +function func_s32real : single;popstack; + begin + func_s32real := RESULT_S32REAL; + end; + +function func_s64real : double;popstack; + begin + func_s64real := RESULT_S64REAl; + end; + +function func_ansistring : ansistring;popstack; + begin + func_ansistring := RESULT_BIGSTRING; + end; + +function func_pchar : pchar;popstack; + begin + func_pchar := RESULT_PCHAR; + end; + + {************************** FUNCTION RESULT WITH PARAMS ******************} +{ LOC_MEM return values } +function func_array_mixed(b: byte): tsmallarray;popstack; + 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;popstack; + 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;popstack; + var + local_b: byte; + begin + func_shortstring_mixed := RESULT_BIGSTRING; + local_b:=b; + global_u8bit := b; + end; + +function func_largeset_mixed(b: byte) : tlargeset;popstack; + 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;popstack; + var + local_b: byte; + begin + func_u8bit_mixed := RESULT_U8BIT; + local_b:=b; + global_u8bit := b; + end; + +function func_u16bit_mixed(b: byte) : word;popstack; + var + local_b: byte; + begin + func_u16bit_mixed := RESULT_U16BIT; + local_b:=b; + global_u8bit := b; + end; + +function func_s32bit_mixed(b: byte) : longint;popstack; + var + local_b: byte; + begin + func_s32bit_mixed := RESULT_S32BIT; + local_b:=b; + global_u8bit := b; + end; + +function func_s64bit_mixed(b: byte) : int64;popstack; + var + local_b: byte; + begin + func_s64bit_mixed := RESULT_S64BIT; + local_b:=b; + global_u8bit := b; + end; + +function func_s32real_mixed(b: byte) : single;popstack; + var + local_b: byte; + begin + func_s32real_mixed := RESULT_S32REAL; + local_b:=b; + global_u8bit := b; + end; + +function func_s64real_mixed(b: byte) : double;popstack; + var + local_b: byte; + begin + func_s64real_mixed := RESULT_S64REAl; + local_b:=b; + global_u8bit := b; + end; + +function func_ansistring_mixed(b: byte) : ansistring;popstack; + var + local_b: byte; + begin + func_ansistring_mixed := RESULT_BIGSTRING; + local_b:=b; + global_u8bit := b; + end; + +function func_pchar_mixed(b: byte) : pchar;popstack; + 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;popstack; + + 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;popstack; + + 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;popstack; + + 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;popstack; + + 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;popstack; + + 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;popstack; + + 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;popstack; + + 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;popstack; + + 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;popstack; + + 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;popstack; + + 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;popstack; + + 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;popstack; + + 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.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.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. + +} diff --git a/tests/test/cg/tcalfun5.pp b/tests/test/cg/tcalfun5.pp index 04da685ef0..842d982e4b 100644 --- a/tests/test/cg/tcalfun5.pp +++ b/tests/test/cg/tcalfun5.pp @@ -1,1415 +1,1417 @@ - {****************************************************************} - { 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; - {$endif} - {$ifdef cpui386} - 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.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.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. + +} diff --git a/tests/test/cg/tcalfun6.pp b/tests/test/cg/tcalfun6.pp index 116df51038..b12e737cc9 100644 --- a/tests/test/cg/tcalfun6.pp +++ b/tests/test/cg/tcalfun6.pp @@ -1,1415 +1,1417 @@ - {****************************************************************} - { 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; - {$endif} - {$ifdef cpui386} - 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.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.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. + +} diff --git a/tests/test/cg/tcalfun7.pp b/tests/test/cg/tcalfun7.pp index c8e63126a9..7f2bb72f47 100644 --- a/tests/test/cg/tcalfun7.pp +++ b/tests/test/cg/tcalfun7.pp @@ -1,1415 +1,1417 @@ - {****************************************************************} - { 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; - {$endif} - {$ifdef cpui386} - 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.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.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. + +} diff --git a/tests/test/cg/tcalfun8.pp b/tests/test/cg/tcalfun8.pp index c1aff23314..dd6974607d 100644 --- a/tests/test/cg/tcalfun8.pp +++ b/tests/test/cg/tcalfun8.pp @@ -1,1415 +1,1417 @@ - {****************************************************************} - { 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 inline calling cnvs) } - { (also tests nested routines up to 2 level deep) } - {****************************************************************} - program tcalfun8; - - {$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; - {$endif} - {$ifdef cpui386} - 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;inline; - 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;inline; - 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;inline; - begin - func_shortstring := RESULT_BIGSTRING; - end; - -function func_largeset : tlargeset;inline; - var - largeset : tlargeset; - begin - largeset := ['I']; - func_largeset := largeset; - end; - -function func_u8bit : byte;inline; - begin - func_u8bit := RESULT_U8BIT; - end; - -function func_u16bit : word;inline; - begin - func_u16bit := RESULT_U16BIT; - end; - -function func_s32bit : longint;inline; - begin - func_s32bit := RESULT_S32BIT; - end; - -function func_s64bit : int64;inline; - begin - func_s64bit := RESULT_S64BIT; - end; - -function func_s32real : single;inline; - begin - func_s32real := RESULT_S32REAL; - end; - -function func_s64real : double;inline; - begin - func_s64real := RESULT_S64REAl; - end; - -function func_ansistring : ansistring;inline; - begin - func_ansistring := RESULT_BIGSTRING; - end; - -function func_pchar : pchar;inline; - begin - func_pchar := RESULT_PCHAR; - end; - - {************************** FUNCTION RESULT WITH PARAMS ******************} -{ LOC_MEM return values } -function func_array_mixed(b: byte): tsmallarray;inline; - 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;inline; - 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;inline; - var - local_b: byte; - begin - func_shortstring_mixed := RESULT_BIGSTRING; - local_b:=b; - global_u8bit := b; - end; - -function func_largeset_mixed(b: byte) : tlargeset;inline; - 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;inline; - var - local_b: byte; - begin - func_u8bit_mixed := RESULT_U8BIT; - local_b:=b; - global_u8bit := b; - end; - -function func_u16bit_mixed(b: byte) : word;inline; - var - local_b: byte; - begin - func_u16bit_mixed := RESULT_U16BIT; - local_b:=b; - global_u8bit := b; - end; - -function func_s32bit_mixed(b: byte) : longint;inline; - var - local_b: byte; - begin - func_s32bit_mixed := RESULT_S32BIT; - local_b:=b; - global_u8bit := b; - end; - -function func_s64bit_mixed(b: byte) : int64;inline; - var - local_b: byte; - begin - func_s64bit_mixed := RESULT_S64BIT; - local_b:=b; - global_u8bit := b; - end; - -function func_s32real_mixed(b: byte) : single;inline; - var - local_b: byte; - begin - func_s32real_mixed := RESULT_S32REAL; - local_b:=b; - global_u8bit := b; - end; - -function func_s64real_mixed(b: byte) : double;inline; - var - local_b: byte; - begin - func_s64real_mixed := RESULT_S64REAl; - local_b:=b; - global_u8bit := b; - end; - -function func_ansistring_mixed(b: byte) : ansistring;inline; - var - local_b: byte; - begin - func_ansistring_mixed := RESULT_BIGSTRING; - local_b:=b; - global_u8bit := b; - end; - -function func_pchar_mixed(b: byte) : pchar;inline; - 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;inline; - - 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;inline; - - 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;inline; - - 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;inline; - - 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;inline; - - 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;inline; - - 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;inline; - - 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;inline; - - 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;inline; - - 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;inline; - - 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;inline; - - 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;inline; - - 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 inline calling cnvs) } + { (also tests nested routines up to 2 level deep) } + {****************************************************************} + program tcalfun8; + + {$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;inline; + 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;inline; + 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;inline; + begin + func_shortstring := RESULT_BIGSTRING; + end; + +function func_largeset : tlargeset;inline; + var + largeset : tlargeset; + begin + largeset := ['I']; + func_largeset := largeset; + end; + +function func_u8bit : byte;inline; + begin + func_u8bit := RESULT_U8BIT; + end; + +function func_u16bit : word;inline; + begin + func_u16bit := RESULT_U16BIT; + end; + +function func_s32bit : longint;inline; + begin + func_s32bit := RESULT_S32BIT; + end; + +function func_s64bit : int64;inline; + begin + func_s64bit := RESULT_S64BIT; + end; + +function func_s32real : single;inline; + begin + func_s32real := RESULT_S32REAL; + end; + +function func_s64real : double;inline; + begin + func_s64real := RESULT_S64REAl; + end; + +function func_ansistring : ansistring;inline; + begin + func_ansistring := RESULT_BIGSTRING; + end; + +function func_pchar : pchar;inline; + begin + func_pchar := RESULT_PCHAR; + end; + + {************************** FUNCTION RESULT WITH PARAMS ******************} +{ LOC_MEM return values } +function func_array_mixed(b: byte): tsmallarray;inline; + 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;inline; + 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;inline; + var + local_b: byte; + begin + func_shortstring_mixed := RESULT_BIGSTRING; + local_b:=b; + global_u8bit := b; + end; + +function func_largeset_mixed(b: byte) : tlargeset;inline; + 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;inline; + var + local_b: byte; + begin + func_u8bit_mixed := RESULT_U8BIT; + local_b:=b; + global_u8bit := b; + end; + +function func_u16bit_mixed(b: byte) : word;inline; + var + local_b: byte; + begin + func_u16bit_mixed := RESULT_U16BIT; + local_b:=b; + global_u8bit := b; + end; + +function func_s32bit_mixed(b: byte) : longint;inline; + var + local_b: byte; + begin + func_s32bit_mixed := RESULT_S32BIT; + local_b:=b; + global_u8bit := b; + end; + +function func_s64bit_mixed(b: byte) : int64;inline; + var + local_b: byte; + begin + func_s64bit_mixed := RESULT_S64BIT; + local_b:=b; + global_u8bit := b; + end; + +function func_s32real_mixed(b: byte) : single;inline; + var + local_b: byte; + begin + func_s32real_mixed := RESULT_S32REAL; + local_b:=b; + global_u8bit := b; + end; + +function func_s64real_mixed(b: byte) : double;inline; + var + local_b: byte; + begin + func_s64real_mixed := RESULT_S64REAl; + local_b:=b; + global_u8bit := b; + end; + +function func_ansistring_mixed(b: byte) : ansistring;inline; + var + local_b: byte; + begin + func_ansistring_mixed := RESULT_BIGSTRING; + local_b:=b; + global_u8bit := b; + end; + +function func_pchar_mixed(b: byte) : pchar;inline; + 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;inline; + + 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;inline; + + 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;inline; + + 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;inline; + + 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;inline; + + 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;inline; + + 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;inline; + + 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;inline; + + 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;inline; + + 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;inline; + + 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;inline; + + 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;inline; + + 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.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 07:45:49 carl - + Function calling tests , for different calling conventions. - -} + 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:37 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 674f8967d1..29e1c338e1 100644 --- a/tests/test/cg/tcalfun9.pp +++ b/tests/test/cg/tcalfun9.pp @@ -1,1445 +1,1447 @@ - {****************************************************************} - { 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; - {$endif} - {$ifdef cpui386} - 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.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.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 + +} diff --git a/tests/test/cg/tcalobj1.pp b/tests/test/cg/tcalobj1.pp index d1c474d384..bacecd11f5 100644 --- a/tests/test/cg/tcalobj1.pp +++ b/tests/test/cg/tcalobj1.pp @@ -1,3312 +1,3310 @@ -{****************************************************************} -{ 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(). } -{ } -{ } -{****************************************************************} -program tcalobj1; -{$STATIC ON} -{$R+} - - const - { should be defined depending on CPU target } - {$ifdef cpu68k} - BIG_INDEX = 8000; - SMALL_INDEX = 13; - {$endif} - {$ifdef cpu86} - BIG_INDEX = 33000; - SMALL_INDEX = 13; { value should not be aligned! } - {$endif} - {$ifdef cpupowerpc} - 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; - procedure method_public_static_none; static; - procedure method_call_private_none; - procedure method_call_private_static_none; static; - { simple value parameter testing } - procedure method_public_u8(x : byte); - procedure method_public_static_u8(x: byte); static; - procedure method_call_private_u8(x: byte); - procedure method_call_private_static_u8(x: byte); static; - function func_array_mixed_nested(b: byte): tsmallarray; - private - procedure method_private_none; - procedure method_private_static_none; static; - function func_getu16bit : word; - { simple value parameter testing } - procedure method_private_u8(x: byte); - procedure method_private_static_u8(x: byte); static; - 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); - 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; - procedure method_normal_call_inherited_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); - - { 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); - procedure method_normal_call_virtual_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); - procedure method_normal_call_overriden_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); - procedure method_normal_call_normal_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); - procedure method_normal_call_constructor_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); - procedure method_normal_call_inherited_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); - - { 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; - begin - global_u8bit := RESULT_U8BIT; - end; - - - procedure tnovmtobject.method_public_static_none; - begin - global_u8bit := RESULT_U8BIT; - end; - - - procedure tnovmtobject.method_call_private_none; - begin - method_private_none; - method_private_static_none; - end; - - procedure tnovmtobject.method_call_private_static_none; - begin - method_private_static_none; - end; - - - procedure tnovmtobject.method_private_none; - begin - Inc(global_u16bit, RESULT_U8BIT); - end; - - - procedure tnovmtobject.method_private_static_none; - begin - Inc(global_u16bit, RESULT_U8BIT); - end; - - {******************** PARAMETERS ******************} - - procedure tnovmtobject.method_public_u8(x : byte); - begin - global_u8bit := x; - end; - - procedure tnovmtobject.method_public_static_u8(x: byte); - begin - global_u8bit := x; - end; - - procedure tnovmtobject.method_call_private_u8(x: byte); - begin - method_private_static_u8(x); - method_private_u8(x); - end; - - procedure tnovmtobject. method_call_private_static_u8(x: byte); - begin - method_private_static_u8(x); - end; - - procedure tnovmtobject.method_private_u8(x: byte); - begin - Inc(global_u16bit,x); - end; - - procedure tnovmtobject.method_private_static_u8(x: byte); - begin - Inc(global_u16bit,x); - end; - - - function tnovmtobject.func_getu16bit : word; - 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; - - 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); - 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); - 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); - 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); - 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); - 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); - 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); - 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); - 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); - 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(). } +{ } +{ } +{****************************************************************} +program tcalobj1; +{$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; + procedure method_public_static_none; static; + procedure method_call_private_none; + procedure method_call_private_static_none; static; + { simple value parameter testing } + procedure method_public_u8(x : byte); + procedure method_public_static_u8(x: byte); static; + procedure method_call_private_u8(x: byte); + procedure method_call_private_static_u8(x: byte); static; + function func_array_mixed_nested(b: byte): tsmallarray; + private + procedure method_private_none; + procedure method_private_static_none; static; + function func_getu16bit : word; + { simple value parameter testing } + procedure method_private_u8(x: byte); + procedure method_private_static_u8(x: byte); static; + 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); + 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; + procedure method_normal_call_inherited_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); + + { 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); + procedure method_normal_call_virtual_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); + procedure method_normal_call_overriden_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); + procedure method_normal_call_normal_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); + procedure method_normal_call_constructor_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); + procedure method_normal_call_inherited_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64); + + { 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; + begin + global_u8bit := RESULT_U8BIT; + end; + + + procedure tnovmtobject.method_public_static_none; + begin + global_u8bit := RESULT_U8BIT; + end; + + + procedure tnovmtobject.method_call_private_none; + begin + method_private_none; + method_private_static_none; + end; + + procedure tnovmtobject.method_call_private_static_none; + begin + method_private_static_none; + end; + + + procedure tnovmtobject.method_private_none; + begin + Inc(global_u16bit, RESULT_U8BIT); + end; + + + procedure tnovmtobject.method_private_static_none; + begin + Inc(global_u16bit, RESULT_U8BIT); + end; + + {******************** PARAMETERS ******************} + + procedure tnovmtobject.method_public_u8(x : byte); + begin + global_u8bit := x; + end; + + procedure tnovmtobject.method_public_static_u8(x: byte); + begin + global_u8bit := x; + end; + + procedure tnovmtobject.method_call_private_u8(x: byte); + begin + method_private_static_u8(x); + method_private_u8(x); + end; + + procedure tnovmtobject. method_call_private_static_u8(x: byte); + begin + method_private_static_u8(x); + end; + + procedure tnovmtobject.method_private_u8(x: byte); + begin + Inc(global_u16bit,x); + end; + + procedure tnovmtobject.method_private_static_u8(x: byte); + begin + Inc(global_u16bit,x); + end; + + + function tnovmtobject.func_getu16bit : word; + 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; + + 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); + 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); + 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); + 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); + 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); + 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); + 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); + 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); + 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); + 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.4 2003-04-21 18:34:00 florian - + powerpc support - - Revision 1.3 2002/09/07 15:40:52 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.5 2003-04-22 10:24:29 florian + * fixed defines for powerpc + + Revision 1.4 2003/04/21 18:34:00 florian + + powerpc support + + Revision 1.3 2002/09/07 15:40:52 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/tcalobj2.pp b/tests/test/cg/tcalobj2.pp index 73c30ebf88..53c523ff95 100644 --- a/tests/test/cg/tcalobj2.pp +++ b/tests/test/cg/tcalobj2.pp @@ -1,3311 +1,3313 @@ -{****************************************************************} -{ 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 pascal } -{ calling convention. } -{ } -{****************************************************************} -program tcalobj2; -{$STATIC ON} -{$R+} - - const - { should be defined depending on CPU target } - {$ifdef cpu68k} - BIG_INDEX = 8000; - SMALL_INDEX = 13; - {$endif} - {$ifdef cpu86} - 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;pascal; - procedure method_public_static_none; static;pascal; - procedure method_call_private_none;pascal; - procedure method_call_private_static_none; static;pascal; - { simple value parameter testing } - procedure method_public_u8(x : byte);pascal; - procedure method_public_static_u8(x: byte); static;pascal; - procedure method_call_private_u8(x: byte);pascal; - procedure method_call_private_static_u8(x: byte); static;pascal; - function func_array_mixed_nested(b: byte): tsmallarray;pascal; - private - procedure method_private_none;pascal; - procedure method_private_static_none; static;pascal; - function func_getu16bit : word;pascal; - { simple value parameter testing } - procedure method_private_u8(x: byte);pascal; - procedure method_private_static_u8(x: byte); static;pascal; - 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);pascal; - procedure method_virtual_params_mixed(u8 :byte; u16: word; - bigstring: shortstring; s32: longint; s64: int64);virtual;pascal; - procedure method_virtual_overriden_params_mixed(u8 :byte; u16: word; - bigstring: shortstring; s32: longint; s64: int64);virtual;pascal; - procedure method_static_params_mixed(u8 :byte; u16: word; - bigstring: shortstring; s32: longint; s64: int64);static;pascal; - procedure method_normal_call_inherited_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);pascal; - - { virtual methods which call other methods } - procedure method_virtual_call_static_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;pascal; - procedure method_virtual_call_virtual_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;pascal; - procedure method_virtual_call_overriden_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;pascal; - procedure method_virtual_call_normal_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;pascal; - procedure method_virtual_call_constructor_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;pascal; - procedure method_virtual_call_inherited_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;pascal; - - 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;pascal; - - { normal methods which call other methods } - procedure method_normal_call_static_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);pascal; - procedure method_normal_call_virtual_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);pascal; - procedure method_normal_call_overriden_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);pascal; - procedure method_normal_call_normal_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);pascal; - procedure method_normal_call_constructor_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);pascal; - procedure method_normal_call_inherited_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);pascal; - - { virtual methods which call other methods } - procedure method_virtual_call_inherited_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;pascal; - - end; - - pfailvmtobject = ^tfailvmtobject; - tfailvmtobject = object(tvmtobject) - public - constructor constructor_public_none; - end; - - - -{**************************************************************************} -{ NO VMT OBJECT } -{**************************************************************************} - - {****************** NO PARAMETERS ******************} - procedure tnovmtobject.method_public_none;pascal; - begin - global_u8bit := RESULT_U8BIT; - end; - - - procedure tnovmtobject.method_public_static_none;pascal; - begin - global_u8bit := RESULT_U8BIT; - end; - - - procedure tnovmtobject.method_call_private_none;pascal; - begin - method_private_none; - method_private_static_none; - end; - - procedure tnovmtobject.method_call_private_static_none;pascal; - begin - method_private_static_none; - end; - - - procedure tnovmtobject.method_private_none;pascal; - begin - Inc(global_u16bit, RESULT_U8BIT); - end; - - - procedure tnovmtobject.method_private_static_none;pascal; - begin - Inc(global_u16bit, RESULT_U8BIT); - end; - - {******************** PARAMETERS ******************} - - procedure tnovmtobject.method_public_u8(x : byte);pascal; - begin - global_u8bit := x; - end; - - procedure tnovmtobject.method_public_static_u8(x: byte);pascal; - begin - global_u8bit := x; - end; - - procedure tnovmtobject.method_call_private_u8(x: byte);pascal; - begin - method_private_static_u8(x); - method_private_u8(x); - end; - - procedure tnovmtobject. method_call_private_static_u8(x: byte);pascal; - begin - method_private_static_u8(x); - end; - - procedure tnovmtobject.method_private_u8(x: byte);pascal; - begin - Inc(global_u16bit,x); - end; - - procedure tnovmtobject.method_private_static_u8(x: byte);pascal; - begin - Inc(global_u16bit,x); - end; - - - function tnovmtobject.func_getu16bit : word;pascal; - 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;pascal; - - 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);pascal; - 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);pascal; - 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);pascal; - 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);pascal; - 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);pascal; - 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);pascal; - 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);pascal; - 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);pascal; - 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);pascal; - 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);pascal; - 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);pascal; - 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);pascal; - 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);pascal; - 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);pascal; - 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);pascal; - 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);pascal; - 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);pascal; - 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);pascal; - 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);pascal; - 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 pascal } +{ calling convention. } +{ } +{****************************************************************} +program tcalobj2; +{$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;pascal; + procedure method_public_static_none; static;pascal; + procedure method_call_private_none;pascal; + procedure method_call_private_static_none; static;pascal; + { simple value parameter testing } + procedure method_public_u8(x : byte);pascal; + procedure method_public_static_u8(x: byte); static;pascal; + procedure method_call_private_u8(x: byte);pascal; + procedure method_call_private_static_u8(x: byte); static;pascal; + function func_array_mixed_nested(b: byte): tsmallarray;pascal; + private + procedure method_private_none;pascal; + procedure method_private_static_none; static;pascal; + function func_getu16bit : word;pascal; + { simple value parameter testing } + procedure method_private_u8(x: byte);pascal; + procedure method_private_static_u8(x: byte); static;pascal; + 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);pascal; + procedure method_virtual_params_mixed(u8 :byte; u16: word; + bigstring: shortstring; s32: longint; s64: int64);virtual;pascal; + procedure method_virtual_overriden_params_mixed(u8 :byte; u16: word; + bigstring: shortstring; s32: longint; s64: int64);virtual;pascal; + procedure method_static_params_mixed(u8 :byte; u16: word; + bigstring: shortstring; s32: longint; s64: int64);static;pascal; + procedure method_normal_call_inherited_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);pascal; + + { virtual methods which call other methods } + procedure method_virtual_call_static_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;pascal; + procedure method_virtual_call_virtual_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;pascal; + procedure method_virtual_call_overriden_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;pascal; + procedure method_virtual_call_normal_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;pascal; + procedure method_virtual_call_constructor_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;pascal; + procedure method_virtual_call_inherited_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;pascal; + + 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;pascal; + + { normal methods which call other methods } + procedure method_normal_call_static_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);pascal; + procedure method_normal_call_virtual_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);pascal; + procedure method_normal_call_overriden_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);pascal; + procedure method_normal_call_normal_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);pascal; + procedure method_normal_call_constructor_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);pascal; + procedure method_normal_call_inherited_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);pascal; + + { virtual methods which call other methods } + procedure method_virtual_call_inherited_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;pascal; + + end; + + pfailvmtobject = ^tfailvmtobject; + tfailvmtobject = object(tvmtobject) + public + constructor constructor_public_none; + end; + + + +{**************************************************************************} +{ NO VMT OBJECT } +{**************************************************************************} + + {****************** NO PARAMETERS ******************} + procedure tnovmtobject.method_public_none;pascal; + begin + global_u8bit := RESULT_U8BIT; + end; + + + procedure tnovmtobject.method_public_static_none;pascal; + begin + global_u8bit := RESULT_U8BIT; + end; + + + procedure tnovmtobject.method_call_private_none;pascal; + begin + method_private_none; + method_private_static_none; + end; + + procedure tnovmtobject.method_call_private_static_none;pascal; + begin + method_private_static_none; + end; + + + procedure tnovmtobject.method_private_none;pascal; + begin + Inc(global_u16bit, RESULT_U8BIT); + end; + + + procedure tnovmtobject.method_private_static_none;pascal; + begin + Inc(global_u16bit, RESULT_U8BIT); + end; + + {******************** PARAMETERS ******************} + + procedure tnovmtobject.method_public_u8(x : byte);pascal; + begin + global_u8bit := x; + end; + + procedure tnovmtobject.method_public_static_u8(x: byte);pascal; + begin + global_u8bit := x; + end; + + procedure tnovmtobject.method_call_private_u8(x: byte);pascal; + begin + method_private_static_u8(x); + method_private_u8(x); + end; + + procedure tnovmtobject. method_call_private_static_u8(x: byte);pascal; + begin + method_private_static_u8(x); + end; + + procedure tnovmtobject.method_private_u8(x: byte);pascal; + begin + Inc(global_u16bit,x); + end; + + procedure tnovmtobject.method_private_static_u8(x: byte);pascal; + begin + Inc(global_u16bit,x); + end; + + + function tnovmtobject.func_getu16bit : word;pascal; + 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;pascal; + + 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);pascal; + 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);pascal; + 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);pascal; + 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);pascal; + 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);pascal; + 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);pascal; + 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);pascal; + 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);pascal; + 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);pascal; + 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);pascal; + 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);pascal; + 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);pascal; + 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);pascal; + 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);pascal; + 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);pascal; + 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);pascal; + 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);pascal; + 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);pascal; + 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);pascal; + 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.4 2003-01-05 18:21:30 peter - * removed more conflicting calling directives - - 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.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: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/tcalobj3.pp b/tests/test/cg/tcalobj3.pp index cca3634df1..a2cc6e141b 100644 --- a/tests/test/cg/tcalobj3.pp +++ b/tests/test/cg/tcalobj3.pp @@ -1,3324 +1,3326 @@ -{****************************************************************} -{ 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; - {$endif} - {$ifdef cpu86} - 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.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.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 + +} diff --git a/tests/test/cg/tcalobj4.pp b/tests/test/cg/tcalobj4.pp index 1ffc582296..061898a6e4 100644 --- a/tests/test/cg/tcalobj4.pp +++ b/tests/test/cg/tcalobj4.pp @@ -1,3314 +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 popstack } -{ calling convention. } -{ } -{****************************************************************} -program tcalobj4; -{$STATIC ON} -{$R+} - - const - { should be defined depending on CPU target } - {$ifdef cpu68k} - BIG_INDEX = 8000; - SMALL_INDEX = 13; - {$endif} - {$ifdef cpu86} - 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;popstack; - procedure method_public_static_none; static;popstack; - procedure method_call_private_none;popstack; - procedure method_call_private_static_none; static;popstack; - { simple value parameter testing } - procedure method_public_u8(x : byte);popstack; - procedure method_public_static_u8(x: byte); static;popstack; - procedure method_call_private_u8(x: byte);popstack; - procedure method_call_private_static_u8(x: byte); static;popstack; - function func_array_mixed_nested(b: byte): tsmallarray;popstack; - private - procedure method_private_none;popstack; - procedure method_private_static_none; static;popstack; - function func_getu16bit : word;popstack; - { simple value parameter testing } - procedure method_private_u8(x: byte);popstack; - procedure method_private_static_u8(x: byte); static;popstack; - 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);popstack; - procedure method_virtual_params_mixed(u8 :byte; u16: word; - bigstring: shortstring; s32: longint; s64: int64);virtual;popstack; - procedure method_virtual_overriden_params_mixed(u8 :byte; u16: word; - bigstring: shortstring; s32: longint; s64: int64);virtual;popstack; - procedure method_static_params_mixed(u8 :byte; u16: word; - bigstring: shortstring; s32: longint; s64: int64);static;popstack; - procedure method_normal_call_inherited_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);popstack; - - { virtual methods which call other methods } - procedure method_virtual_call_static_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;popstack; - procedure method_virtual_call_virtual_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;popstack; - procedure method_virtual_call_overriden_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;popstack; - procedure method_virtual_call_normal_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;popstack; - procedure method_virtual_call_constructor_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;popstack; - procedure method_virtual_call_inherited_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;popstack; - - 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;popstack; - - { normal methods which call other methods } - procedure method_normal_call_static_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);popstack; - procedure method_normal_call_virtual_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);popstack; - procedure method_normal_call_overriden_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);popstack; - procedure method_normal_call_normal_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);popstack; - procedure method_normal_call_constructor_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);popstack; - procedure method_normal_call_inherited_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);popstack; - - { virtual methods which call other methods } - procedure method_virtual_call_inherited_params_mixed( - u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;popstack; - - end; - - pfailvmtobject = ^tfailvmtobject; - tfailvmtobject = object(tvmtobject) - public - constructor constructor_public_none; - end; - - - -{**************************************************************************} -{ NO VMT OBJECT } -{**************************************************************************} - - {****************** NO PARAMETERS ******************} - procedure tnovmtobject.method_public_none;popstack; - begin - global_u8bit := RESULT_U8BIT; - end; - - - procedure tnovmtobject.method_public_static_none;popstack; - begin - global_u8bit := RESULT_U8BIT; - end; - - - procedure tnovmtobject.method_call_private_none;popstack; - begin - method_private_none; - method_private_static_none; - end; - - procedure tnovmtobject.method_call_private_static_none;popstack; - begin - method_private_static_none; - end; - - - procedure tnovmtobject.method_private_none;popstack; - begin - Inc(global_u16bit, RESULT_U8BIT); - end; - - - procedure tnovmtobject.method_private_static_none;popstack; - begin - Inc(global_u16bit, RESULT_U8BIT); - end; - - {******************** PARAMETERS ******************} - - procedure tnovmtobject.method_public_u8(x : byte);popstack; - begin - global_u8bit := x; - end; - - procedure tnovmtobject.method_public_static_u8(x: byte);popstack; - begin - global_u8bit := x; - end; - - procedure tnovmtobject.method_call_private_u8(x: byte);popstack; - begin - method_private_static_u8(x); - method_private_u8(x); - end; - - procedure tnovmtobject. method_call_private_static_u8(x: byte);popstack; - begin - method_private_static_u8(x); - end; - - procedure tnovmtobject.method_private_u8(x: byte);popstack; - begin - Inc(global_u16bit,x); - end; - - procedure tnovmtobject.method_private_static_u8(x: byte);popstack; - begin - Inc(global_u16bit,x); - end; - - - function tnovmtobject.func_getu16bit : word;popstack; - 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;popstack; - - 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);popstack; - 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);popstack; - 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);popstack; - 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);popstack; - 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);popstack; - 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);popstack; - 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);popstack; - 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);popstack; - 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);popstack; - 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);popstack; - 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);popstack; - 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);popstack; - 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);popstack; - 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);popstack; - 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);popstack; - 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);popstack; - 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);popstack; - 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);popstack; - 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);popstack; - 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 popstack } +{ calling convention. } +{ } +{****************************************************************} +program tcalobj4; +{$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;popstack; + procedure method_public_static_none; static;popstack; + procedure method_call_private_none;popstack; + procedure method_call_private_static_none; static;popstack; + { simple value parameter testing } + procedure method_public_u8(x : byte);popstack; + procedure method_public_static_u8(x: byte); static;popstack; + procedure method_call_private_u8(x: byte);popstack; + procedure method_call_private_static_u8(x: byte); static;popstack; + function func_array_mixed_nested(b: byte): tsmallarray;popstack; + private + procedure method_private_none;popstack; + procedure method_private_static_none; static;popstack; + function func_getu16bit : word;popstack; + { simple value parameter testing } + procedure method_private_u8(x: byte);popstack; + procedure method_private_static_u8(x: byte); static;popstack; + 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);popstack; + procedure method_virtual_params_mixed(u8 :byte; u16: word; + bigstring: shortstring; s32: longint; s64: int64);virtual;popstack; + procedure method_virtual_overriden_params_mixed(u8 :byte; u16: word; + bigstring: shortstring; s32: longint; s64: int64);virtual;popstack; + procedure method_static_params_mixed(u8 :byte; u16: word; + bigstring: shortstring; s32: longint; s64: int64);static;popstack; + procedure method_normal_call_inherited_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);popstack; + + { virtual methods which call other methods } + procedure method_virtual_call_static_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;popstack; + procedure method_virtual_call_virtual_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;popstack; + procedure method_virtual_call_overriden_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;popstack; + procedure method_virtual_call_normal_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;popstack; + procedure method_virtual_call_constructor_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;popstack; + procedure method_virtual_call_inherited_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;popstack; + + 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;popstack; + + { normal methods which call other methods } + procedure method_normal_call_static_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);popstack; + procedure method_normal_call_virtual_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);popstack; + procedure method_normal_call_overriden_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);popstack; + procedure method_normal_call_normal_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);popstack; + procedure method_normal_call_constructor_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);popstack; + procedure method_normal_call_inherited_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);popstack; + + { virtual methods which call other methods } + procedure method_virtual_call_inherited_params_mixed( + u8 :byte; u16: word; bigstring: shortstring; s32: longint; s64: int64);virtual;popstack; + + end; + + pfailvmtobject = ^tfailvmtobject; + tfailvmtobject = object(tvmtobject) + public + constructor constructor_public_none; + end; + + + +{**************************************************************************} +{ NO VMT OBJECT } +{**************************************************************************} + + {****************** NO PARAMETERS ******************} + procedure tnovmtobject.method_public_none;popstack; + begin + global_u8bit := RESULT_U8BIT; + end; + + + procedure tnovmtobject.method_public_static_none;popstack; + begin + global_u8bit := RESULT_U8BIT; + end; + + + procedure tnovmtobject.method_call_private_none;popstack; + begin + method_private_none; + method_private_static_none; + end; + + procedure tnovmtobject.method_call_private_static_none;popstack; + begin + method_private_static_none; + end; + + + procedure tnovmtobject.method_private_none;popstack; + begin + Inc(global_u16bit, RESULT_U8BIT); + end; + + + procedure tnovmtobject.method_private_static_none;popstack; + begin + Inc(global_u16bit, RESULT_U8BIT); + end; + + {******************** PARAMETERS ******************} + + procedure tnovmtobject.method_public_u8(x : byte);popstack; + begin + global_u8bit := x; + end; + + procedure tnovmtobject.method_public_static_u8(x: byte);popstack; + begin + global_u8bit := x; + end; + + procedure tnovmtobject.method_call_private_u8(x: byte);popstack; + begin + method_private_static_u8(x); + method_private_u8(x); + end; + + procedure tnovmtobject. method_call_private_static_u8(x: byte);popstack; + begin + method_private_static_u8(x); + end; + + procedure tnovmtobject.method_private_u8(x: byte);popstack; + begin + Inc(global_u16bit,x); + end; + + procedure tnovmtobject.method_private_static_u8(x: byte);popstack; + begin + Inc(global_u16bit,x); + end; + + + function tnovmtobject.func_getu16bit : word;popstack; + 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;popstack; + + 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);popstack; + 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);popstack; + 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);popstack; + 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);popstack; + 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);popstack; + 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);popstack; + 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);popstack; + 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);popstack; + 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);popstack; + 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);popstack; + 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);popstack; + 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);popstack; + 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);popstack; + 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);popstack; + 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);popstack; + 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);popstack; + 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);popstack; + 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);popstack; + 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);popstack; + 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-01-05 18:21:30 peter - * removed more conflicting calling directives - - 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: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.6 2003-04-22 10:24:29 florian + * fixed defines for powerpc + + Revision 1.5 2003/01/05 18:21:30 peter + * removed more conflicting calling directives + + 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: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 c5c9c0a6dd..51270e5594 100644 --- a/tests/test/cg/tcalobj5.pp +++ b/tests/test/cg/tcalobj5.pp @@ -1,3312 +1,3314 @@ -{****************************************************************} -{ 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; - {$endif} - {$ifdef cpu86} - 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.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.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 + +} diff --git a/tests/test/cg/tcalobj6.pp b/tests/test/cg/tcalobj6.pp index 07443bd071..f37d95c1a3 100644 --- a/tests/test/cg/tcalobj6.pp +++ b/tests/test/cg/tcalobj6.pp @@ -1,3311 +1,3313 @@ -{****************************************************************} -{ 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; - {$endif} - {$ifdef cpu86} - 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.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.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 + +} diff --git a/tests/test/cg/tcalobj7.pp b/tests/test/cg/tcalobj7.pp index d13b0639b7..a60a6166c1 100644 --- a/tests/test/cg/tcalobj7.pp +++ b/tests/test/cg/tcalobj7.pp @@ -1,3312 +1,3314 @@ -{****************************************************************} -{ 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; - {$endif} - {$ifdef cpu86} - 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.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.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 + +} diff --git a/tests/test/cg/tcalobj8.pp b/tests/test/cg/tcalobj8.pp index 1fc2510c19..e186163514 100644 --- a/tests/test/cg/tcalobj8.pp +++ b/tests/test/cg/tcalobj8.pp @@ -1,3312 +1,3314 @@ -{****************************************************************} -{ 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; - {$endif} - {$ifdef cpu86} - 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.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.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 + +} diff --git a/tests/test/cg/tcalval1.pp b/tests/test/cg/tcalval1.pp index 487628f350..b0b7be62eb 100644 --- a/tests/test/cg/tcalval1.pp +++ b/tests/test/cg/tcalval1.pp @@ -1,1304 +1,1306 @@ -{****************************************************************} -{ 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 } -{ (value parameters with std calling convention) } -{****************************************************************} -program tcalval1; - -{$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; - {$endif} - {$ifdef cpui386} - 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_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; -{$ifndef tp} - global_s64bit := 0; - global_class := nil; -{$endif} - 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; -{$ifndef tp} - value_s64bit := 0; - value_class := nil; -{$endif} - end; - - - procedure testprocedure; - begin - end; - - function getu8bit : byte; - begin - getu8bit:=RESULT_U8BIT; - end; - - function getu16bit: word; - begin - getu16bit:=RESULT_U16BIT; - end; - - function gets32bit: longint; - begin - gets32bit:=RESULT_S32BIT; - end; - - function gets64bit: int64; - begin - gets64bit:=RESULT_S64BIT; - end; - - - function gets32real: single; - begin - gets32real:=RESULT_S32REAL; - end; - - function gets64real: double; - begin - gets64real:=RESULT_S64REAL; - end; - -{ ***************************************************************** } -{ VALUE PARAMETERS } -{ ***************************************************************** } - - procedure proc_value_u8bit(v: byte); - begin - global_u8bit := v; - end; - - - procedure proc_value_u16bit(v: word); - begin - global_u16bit := v; - end; - - - procedure proc_value_s32bit(v : longint); - begin - global_s32bit := v; - end; - - - - - procedure proc_value_bool8bit(v: boolean); - begin - { boolean should be 8-bit always! } - if sizeof(boolean) <> 1 then RunError(255); - global_u8bit := byte(v); - end; - - - procedure proc_value_bool16bit(v: wordbool); - begin - global_u16bit := word(v); - end; - - - procedure proc_value_bool32bit(v : longbool); - begin - global_s32bit := longint(v); - end; - - - procedure proc_value_s32real(v : single); - begin - global_s32real := v; - end; - - procedure proc_value_s64real(v: double); - begin - global_s64real:= v; - end; - - - procedure proc_value_pointerdef(p : pchar); - begin - global_ptr:=p; - end; - - - procedure proc_value_procvardef(p : tprocedure); - begin - global_proc:=p; - end; - - - - - procedure proc_value_smallrecord(smallrec : tsmallrecord); - begin - if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_value_largerecord(largerec : tlargerecord); - begin - if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_value_smallset(smallset : tsmallset); - begin - if A_D in smallset then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_value_largeset(largeset : tlargeset); - begin - if 'I' in largeset then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_value_smallstring(s:tsmallstring); - begin - if s = RESULT_SMALLSTRING then - global_u8bit := RESULT_u8BIT; - end; - - - procedure proc_value_bigstring(s:shortstring); - begin - if s = RESULT_BIGSTRING then - global_u8bit := RESULT_u8BIT; - end; - - - procedure proc_value_smallarray(arr : tsmallarray); - begin - if arr[SMALL_INDEX] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_value_smallarray_open(arr : array of byte); - begin - { form 0 to N-1 indexes in open arrays } - if arr[SMALL_INDEX-1] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - end; - -{$ifndef tp} - procedure proc_value_classrefdef(obj : tclass1); - begin - global_class:=obj; - end; - - - procedure proc_value_smallarray_const_1(arr : array of const); - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : global_u8bit := arr[i].vinteger and $ff; - vtBoolean : global_boolean := arr[i].vboolean; - vtChar : global_char := arr[i].vchar; - vtExtended : global_s64real := arr[i].VExtended^; - vtString : global_bigstring := arr[i].VString^; - vtPointer : ; - vtPChar : global_ptr := arr[i].VPchar; - vtObject : ; -{ vtClass : global_class := (arr[i].VClass) as tclass1;} - vtAnsiString : ; - vtInt64 : global_s64bit := arr[i].vInt64^; - else - RunError(255); - end; - end; {endfor} - end; - - - procedure proc_value_smallarray_const_2(arr : array of const); - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_value_s64bit(v: int64); - begin - global_s64bit:= v; - end; -{$endif} - - {********************************* MIXED PARAMETERS *************************} - - procedure proc_value_u8bit_mixed(b1 : byte; v: byte; b2: byte); - begin - global_u8bit := v; - value_u8bit := b2; - end; - - - procedure proc_value_u16bit_mixed(b1: byte; v: word; b2: byte); - begin - global_u16bit := v; - value_u8bit := b2; - end; - - - procedure proc_value_s32bit_mixed(b1 : byte; v : longint; b2: byte); - begin - global_s32bit := v; - value_u8bit := b2; - end; - - - - - procedure proc_value_bool8bit_mixed(b1: byte; v: boolean; b2: byte); - begin - { boolean should be 8-bit always! } - if sizeof(boolean) <> 1 then RunError(255); - global_u8bit := byte(v); - value_u8bit := b2; - end; - - - procedure proc_value_bool16bit_mixed(b1 : byte; v: wordbool; b2: byte); - begin - global_u16bit := word(v); - value_u8bit := b2; - end; - - - procedure proc_value_bool32bit_mixed(b1 : byte; v : longbool; b2: byte); - begin - global_s32bit := longint(v); - value_u8bit := b2; - end; - - - procedure proc_value_s32real_mixed(b1: byte; v : single; b2: byte); - begin - global_s32real := v; - value_u8bit := b2; - end; - - procedure proc_value_s64real_mixed(b1: byte; v: double; b2: byte); - begin - global_s64real:= v; - value_u8bit := b2; - end; - - - procedure proc_value_pointerdef_mixed(b1: byte; p : pchar; b2: byte); - begin - global_ptr:=p; - value_u8bit := b2; - end; - - - procedure proc_value_procvardef_mixed(b1: byte; p : tprocedure; b2: byte); - begin - global_proc:=p; - value_u8bit := b2; - end; - - - - - procedure proc_value_smallrecord_mixed(b1: byte; smallrec : tsmallrecord; b2: byte); - begin - if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - procedure proc_value_largerecord_mixed(b1: byte; largerec : tlargerecord; b2: byte); - begin - if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - procedure proc_value_smallset_mixed(b1: byte; smallset : tsmallset; b2: byte); - begin - if A_D in smallset then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - procedure proc_value_largeset_mixed(b1: byte; largeset : tlargeset; b2: byte); - begin - if 'I' in largeset then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - procedure proc_value_smallstring_mixed(b1: byte; s:tsmallstring; b2: byte); - begin - if s = RESULT_SMALLSTRING then - global_u8bit := RESULT_u8BIT; - value_u8bit := b2; - end; - - - procedure proc_value_bigstring_mixed(b1: byte; s:shortstring; b2: byte); - begin - if s = RESULT_BIGSTRING then - global_u8bit := RESULT_u8BIT; - value_u8bit := b2; - end; - - - procedure proc_value_smallarray_mixed(b1: byte; arr : tsmallarray; b2: byte); - begin - if arr[SMALL_INDEX] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - procedure proc_value_smallarray_open_mixed(b1: byte; arr : array of byte; b2: byte); - begin - { form 0 to N-1 indexes in open arrays } - if arr[SMALL_INDEX-1] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - -{$ifndef tp} - procedure proc_value_classrefdef_mixed(b1: byte; obj : tclass1; b2: byte); - begin - global_class:=obj; - value_u8bit := b2; - end; - - - procedure proc_value_s64bit_mixed(b1 : byte; v: int64; b2: byte); - begin - global_s64bit:= v; - value_u8bit := b2; - end; - - - procedure proc_value_smallarray_const_1_mixed(b1: byte; arr : array of const; b2: byte); - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : global_u8bit := arr[i].vinteger and $ff; - vtBoolean : global_boolean := arr[i].vboolean; - vtChar : global_char := arr[i].vchar; - vtExtended : global_s64real := arr[i].VExtended^; - vtString : global_bigstring := arr[i].VString^; - vtPointer : ; - vtPChar : global_ptr := arr[i].VPchar; - vtObject : ; -{ vtClass : global_class := (arr[i].VClass) as tclass1;} - vtAnsiString : ; - vtInt64 : global_s64bit := arr[i].vInt64^; - else - RunError(255); - end; - end; {endfor} - value_u8bit := b2; - end; - - - procedure proc_value_smallarray_const_2_mixed(b1: byte; arr : array of const; b2: byte); - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; -{$endif} - -var - failed: boolean; -Begin - {***************************** NORMAL TESTS *******************************} - clear_globals; - clear_values; - - failed:=false; - - { LOC_REGISTER } - write('Value parameter test (src : LOC_REGISTER)...'); - proc_value_u8bit(getu8bit); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - proc_value_u16bit(getu16bit); - if global_u16bit <> RESULT_U16BIT then - failed:=true; - proc_value_s32bit(gets32bit); - if global_s32bit <> RESULT_S32BIT then - failed:=true; -{$ifndef tp} - proc_value_s64bit(gets64bit); - if global_s64bit <> RESULT_S64BIT then - failed:=true; -{$endif} - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_FPUREGISTER } - clear_globals; - clear_values; - failed:=false; - write('Value parameter test (src : LOC_FPUREGISTER)...'); - proc_value_s32real(gets32real); - if trunc(global_s32real) <> trunc(RESULT_S32REAL) then - failed:=true; - proc_value_s64real(gets64real); - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed:=true; - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_MEM, LOC_REFERENCE orddef } - clear_globals; - clear_values; - value_u8bit := RESULT_U8BIT; - value_u16bit := RESULT_U16BIT; - value_s32bit := RESULT_S32BIT; -{$ifndef tp} - value_s64bit := RESULT_S64BIT; -{$endif} - value_s32real := RESULT_S32REAL; - value_s64real := RESULT_S64REAL; - - failed:=false; - - { LOC_REFERENCE } - write('Value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...'); - proc_value_u8bit(value_u8bit); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - proc_value_u16bit(value_u16bit); - if global_u16bit <> RESULT_U16BIT then - failed:=true; - proc_value_s32bit(value_s32bit); - if global_s32bit <> RESULT_S32BIT then - failed:=true; -{$ifndef tp} - proc_value_s64bit(value_s64bit); - if global_s64bit <> RESULT_S64BIT then - failed:=true; -{$endif} - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_REFERENCE } - clear_globals; - failed:=false; - write('Value parameter test (src : LOC_REFERENCE (floatdef))...'); - proc_value_s32real(value_s32real); - if trunc(global_s32real) <> trunc(RESULT_S32REAL) then - failed:=true; - proc_value_s64real(value_s64real); - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed:=true; - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Value parameter test (src : LOC_REFERENCE (pointer))...'); - clear_globals; - clear_values; - failed:=false; - value_ptr := RESULT_PCHAR; - proc_value_pointerdef(value_ptr); - if global_ptr <> value_ptr then - failed := true; - - - value_proc := {$ifndef tp}@{$endif}testprocedure; - proc_value_procvardef(value_proc); - if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then - failed := true; - -{$ifndef tp} - value_class := tclass1.create; - proc_value_classrefdef(value_class); - if value_class <> global_class then - failed := true; - value_class.destroy; -{$endif} - if failed then - fail - else - WriteLn('Passed!'); - - - - - { LOC_REFERENCE } - clear_globals; - clear_values; - failed:=false; - value_u8bit := 0; - write('Value parameter test (src : LOC_FLAGS (orddef)))...'); - proc_value_bool8bit(value_u8bit = 0); - if global_u8bit <> RESULT_BOOL8BIT then - failed:=true; -{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x - proc_value_bool16bit(value_s64bit < 0); - if global_u16bit <> RESULT_BOOL16BIT then - failed:=true; - proc_value_bool32bit(bool1 and bool2); - if global_s32bit <> RESULT_BOOL32BIT then - failed:=true;*} - if failed then - fail - else - WriteLn('Passed!'); - - - -{$ifndef tp} - clear_globals; - clear_values; - failed:=false; - write('Value parameter test (src : LOC_JUMP (orddef)))...'); - proc_value_bool8bit(value_s64bit = 0); - if global_u8bit <> RESULT_BOOL8BIT then - failed:=true; -{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x - proc_value_bool16bit(value_s64bit < 0); - if global_u16bit <> RESULT_BOOL16BIT then - failed:=true; - proc_value_bool32bit(bool1 and bool2); - if global_s32bit <> RESULT_BOOL32BIT then - failed:=true;*} - if failed then - fail - else - WriteLn('Passed!'); -{$endif} - - { arraydef, - recorddef, - objectdef, - stringdef, - setdef : all considered the same by code generator. - } - write('Value parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallrec.b := RESULT_U8BIT; - value_smallrec.w := RESULT_U16BIT; - proc_value_smallrecord(value_smallrec); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); - proc_value_largerecord(value_largerec); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Value parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallset := [A_A,A_D]; - proc_value_smallset(value_smallset); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_largeset := ['I']; - proc_value_largeset(value_largeset); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - - - write('Value parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - value_smallstring := RESULT_SMALLSTRING; - - proc_value_smallstring(value_smallstring); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_bigstring := RESULT_BIGSTRING; - proc_value_bigstring(value_bigstring); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!} - { DON'T KNOW WHY/HOW TO TEST!!!!! } - - - write('Value parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - fillchar(value_smallarray,sizeof(value_smallarray),#0); - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_value_smallarray(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - fillchar(value_smallarray,sizeof(value_smallarray),#0); - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_value_smallarray_open(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - -{$ifndef tp} - clear_globals; - clear_values; - - value_u8bit := RESULT_U8BIT; - value_ptr := RESULT_PCHAR; - value_s64bit := RESULT_S64BIT; - value_smallstring := RESULT_SMALLSTRING; - value_class := tclass1.create; - value_boolean := RESULT_BOOLEAN; - value_char := RESULT_CHAR; - value_s64real:=RESULT_S64REAL; - proc_value_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real, - value_boolean,value_class]); - - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if global_char <> RESULT_CHAR then - failed := true; - if global_boolean <> RESULT_BOOLEAN then - failed:=true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed := true; - if global_bigstring <> RESULT_SMALLSTRING then - failed := true; - if global_ptr <> value_ptr then - failed := true; -{ if value_class <> global_class then - failed := true;!!!!!!!!!!!!!!!!!!!!} - if global_s64bit <> RESULT_S64BIT then - failed := true; - if assigned(value_class) then - value_class.destroy; - - global_u8bit := 0; - proc_value_smallarray_const_2([]); - if global_u8bit <> RESULT_U8BIT then - failed := true; -{$endif fpc} - - if failed then - fail - else - WriteLn('Passed!'); - - {***************************** MIXED TESTS *******************************} - clear_globals; - clear_values; - - failed:=false; - - { LOC_REGISTER } - write('Mixed value parameter test (src : LOC_REGISTER)...'); - proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),getu8bit,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - proc_value_u16bit_mixed(byte(NOT RESULT_U8BIT),getu16bit,RESULT_U8BIT); - if global_u16bit <> RESULT_U16BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - proc_value_s32bit_mixed(byte(NOT RESULT_U8BIT),gets32bit, RESULT_U8BIT); - if global_s32bit <> RESULT_S32BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$ifndef tp} - proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT),gets64bit,RESULT_U8BIT); - if global_s64bit <> RESULT_S64BIT then - failed:=true; -{$endif} - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_FPUREGISTER } - clear_globals; - clear_values; - failed:=false; - write('Mixed value parameter test (src : LOC_FPUREGISTER)...'); - proc_value_s32real_mixed(byte(NOT RESULT_U8BIT), gets32real, RESULT_U8BIT); - if value_u8bit <> RESULT_U8BIT then - failed := true; - if trunc(global_s32real) <> trunc(RESULT_S32REAL) then - failed:=true; - proc_value_s64real_mixed(byte(NOT RESULT_U8BIT),gets64real,RESULT_U8BIT); - if value_u8bit <> RESULT_U8BIT then - failed := true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed:=true; - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_MEM, LOC_REFERENCE orddef } - clear_globals; - clear_values; - value_u8bit := RESULT_U8BIT; - value_u16bit := RESULT_U16BIT; - value_s32bit := RESULT_S32BIT; -{$ifndef tp} - value_s64bit := RESULT_S64BIT; -{$endif} - value_s32real := RESULT_S32REAL; - value_s64real := RESULT_S64REAL; - - failed:=false; - - { LOC_REFERENCE } - write('Mixed value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...'); - proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),value_u8bit, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - proc_value_u16bit_mixed(byte(NOT RESULT_U8BIT),value_u16bit, RESULT_U8BIT); - if global_u16bit <> RESULT_U16BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - proc_value_s32bit_mixed(byte(NOT RESULT_U8BIT),value_s32bit, RESULT_U8BIT); - if global_s32bit <> RESULT_S32BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$ifndef tp} - proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit, RESULT_U8BIT); - if global_s64bit <> RESULT_S64BIT then - failed:=true; -{$endif} - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_REFERENCE } - clear_globals; - failed:=false; - write('Mixed value parameter test (src : LOC_REFERENCE (floatdef))...'); - proc_value_s32real_mixed(byte(NOT RESULT_U8BIT), value_s32real, RESULT_U8BIT); - if trunc(global_s32real) <> trunc(RESULT_S32REAL) then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - proc_value_s64real_mixed(byte(NOT RESULT_U8BIT), value_s64real, RESULT_U8BIT); - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Mixed value parameter test (src : LOC_REFERENCE (pointer))...'); - clear_globals; - clear_values; - failed:=false; - value_ptr := RESULT_PCHAR; - proc_value_pointerdef_mixed(byte(NOT RESULT_U8BIT), value_ptr, RESULT_U8BIT); - if global_ptr <> value_ptr then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - - value_proc := {$ifndef tp}@{$endif}testprocedure; - proc_value_procvardef_mixed(byte(NOT RESULT_U8BIT), value_proc, RESULT_U8BIT); - if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then - failed := true; - -{$ifndef tp} - value_class := tclass1.create; - proc_value_classrefdef_mixed(byte(NOT RESULT_U8BIT), value_class, RESULT_U8BIT); - if value_class <> global_class then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - value_class.destroy; -{$endif} - if failed then - fail - else - WriteLn('Passed!'); - - - - - { LOC_REFERENCE } - clear_globals; - clear_values; - failed:=false; - value_u8bit := 0; - write('Mixed value parameter test (src : LOC_FLAGS (orddef)))...'); - proc_value_bool8bit_mixed(byte(NOT RESULT_U8BIT), value_u8bit = 0, RESULT_U8BIT); - if global_u8bit <> RESULT_BOOL8BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x - proc_value_bool16bit(value_s64bit < 0); - if global_u16bit <> RESULT_BOOL16BIT then - failed:=true; - proc_value_bool32bit(bool1 and bool2); - if global_s32bit <> RESULT_BOOL32BIT then - failed:=true;*} - if failed then - fail - else - WriteLn('Passed!'); - - - -{$ifndef tp} - clear_globals; - clear_values; - failed:=false; - write('Mixed value parameter test (src : LOC_JUMP (orddef)))...'); - proc_value_bool8bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit = 0, RESULT_U8BIT); - if global_u8bit <> RESULT_BOOL8BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x - proc_value_bool16bit(value_s64bit < 0); - if global_u16bit <> RESULT_BOOL16BIT then - failed:=true; - proc_value_bool32bit(bool1 and bool2); - if global_s32bit <> RESULT_BOOL32BIT then - failed:=true;*} - if failed then - fail - else - WriteLn('Passed!'); -{$endif} - - { arraydef, - recorddef, - objectdef, - stringdef, - setdef : all considered the same by code generator. - } - write('Mixed value parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallrec.b := RESULT_U8BIT; - value_smallrec.w := RESULT_U16BIT; - proc_value_smallrecord_mixed(byte(NOT RESULT_U8BIT), value_smallrec, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); - proc_value_largerecord_mixed(byte(NOT RESULT_U8BIT), value_largerec, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Mixed value parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallset := [A_A,A_D]; - proc_value_smallset_mixed(byte(NOT RESULT_U8BIT), value_smallset, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_largeset := ['I']; - proc_value_largeset_mixed(byte(NOT RESULT_U8BIT), value_largeset, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - - - write('Mixed value parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - value_smallstring := RESULT_SMALLSTRING; - - proc_value_smallstring_mixed(byte(NOT RESULT_U8BIT), value_smallstring, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_bigstring := RESULT_BIGSTRING; - proc_value_bigstring_mixed(byte(NOT RESULT_U8BIT), value_bigstring, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!} - { DON'T KNOW WHY/HOW TO TEST!!!!! } - - - write('Mixed value parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - fillchar(value_smallarray,sizeof(value_smallarray),#0); - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_value_smallarray_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - fillchar(value_smallarray,sizeof(value_smallarray),#0); - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_value_smallarray_open_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - -{$ifndef tp} - clear_globals; - clear_values; - - value_u8bit := RESULT_U8BIT; - value_ptr := RESULT_PCHAR; - value_s64bit := RESULT_S64BIT; - value_smallstring := RESULT_SMALLSTRING; - value_class := tclass1.create; - value_boolean := RESULT_BOOLEAN; - value_char := RESULT_CHAR; - value_s64real:=RESULT_S64REAL; - proc_value_smallarray_const_1_mixed(byte(NOT RESULT_U8BIT), [value_u8bit,value_ptr,value_s64bit,value_char, - value_smallstring,value_s64real,value_boolean,value_class], - RESULT_U8BIT); - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if global_char <> RESULT_CHAR then - failed := true; - if global_boolean <> RESULT_BOOLEAN then - failed:=true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed := true; - if global_bigstring <> RESULT_SMALLSTRING then - failed := true; - if global_ptr <> value_ptr then - failed := true; -{ if value_class <> global_class then - failed := true;!!!!!!!!!!!!!!!!!!!!} - if global_s64bit <> RESULT_S64BIT then - failed := true; - if assigned(value_class) then - value_class.destroy; - - global_u8bit := 0; - proc_value_smallarray_const_2_mixed(byte(NOT RESULT_U8BIT), [], RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$endif} - - 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 } +{ (value parameters with std calling convention) } +{****************************************************************} +program tcalval1; + +{$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_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; +{$ifndef tp} + global_s64bit := 0; + global_class := nil; +{$endif} + 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; +{$ifndef tp} + value_s64bit := 0; + value_class := nil; +{$endif} + end; + + + procedure testprocedure; + begin + end; + + function getu8bit : byte; + begin + getu8bit:=RESULT_U8BIT; + end; + + function getu16bit: word; + begin + getu16bit:=RESULT_U16BIT; + end; + + function gets32bit: longint; + begin + gets32bit:=RESULT_S32BIT; + end; + + function gets64bit: int64; + begin + gets64bit:=RESULT_S64BIT; + end; + + + function gets32real: single; + begin + gets32real:=RESULT_S32REAL; + end; + + function gets64real: double; + begin + gets64real:=RESULT_S64REAL; + end; + +{ ***************************************************************** } +{ VALUE PARAMETERS } +{ ***************************************************************** } + + procedure proc_value_u8bit(v: byte); + begin + global_u8bit := v; + end; + + + procedure proc_value_u16bit(v: word); + begin + global_u16bit := v; + end; + + + procedure proc_value_s32bit(v : longint); + begin + global_s32bit := v; + end; + + + + + procedure proc_value_bool8bit(v: boolean); + begin + { boolean should be 8-bit always! } + if sizeof(boolean) <> 1 then RunError(255); + global_u8bit := byte(v); + end; + + + procedure proc_value_bool16bit(v: wordbool); + begin + global_u16bit := word(v); + end; + + + procedure proc_value_bool32bit(v : longbool); + begin + global_s32bit := longint(v); + end; + + + procedure proc_value_s32real(v : single); + begin + global_s32real := v; + end; + + procedure proc_value_s64real(v: double); + begin + global_s64real:= v; + end; + + + procedure proc_value_pointerdef(p : pchar); + begin + global_ptr:=p; + end; + + + procedure proc_value_procvardef(p : tprocedure); + begin + global_proc:=p; + end; + + + + + procedure proc_value_smallrecord(smallrec : tsmallrecord); + begin + if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_value_largerecord(largerec : tlargerecord); + begin + if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_value_smallset(smallset : tsmallset); + begin + if A_D in smallset then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_value_largeset(largeset : tlargeset); + begin + if 'I' in largeset then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_value_smallstring(s:tsmallstring); + begin + if s = RESULT_SMALLSTRING then + global_u8bit := RESULT_u8BIT; + end; + + + procedure proc_value_bigstring(s:shortstring); + begin + if s = RESULT_BIGSTRING then + global_u8bit := RESULT_u8BIT; + end; + + + procedure proc_value_smallarray(arr : tsmallarray); + begin + if arr[SMALL_INDEX] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_value_smallarray_open(arr : array of byte); + begin + { form 0 to N-1 indexes in open arrays } + if arr[SMALL_INDEX-1] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + end; + +{$ifndef tp} + procedure proc_value_classrefdef(obj : tclass1); + begin + global_class:=obj; + end; + + + procedure proc_value_smallarray_const_1(arr : array of const); + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : global_u8bit := arr[i].vinteger and $ff; + vtBoolean : global_boolean := arr[i].vboolean; + vtChar : global_char := arr[i].vchar; + vtExtended : global_s64real := arr[i].VExtended^; + vtString : global_bigstring := arr[i].VString^; + vtPointer : ; + vtPChar : global_ptr := arr[i].VPchar; + vtObject : ; +{ vtClass : global_class := (arr[i].VClass) as tclass1;} + vtAnsiString : ; + vtInt64 : global_s64bit := arr[i].vInt64^; + else + RunError(255); + end; + end; {endfor} + end; + + + procedure proc_value_smallarray_const_2(arr : array of const); + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_value_s64bit(v: int64); + begin + global_s64bit:= v; + end; +{$endif} + + {********************************* MIXED PARAMETERS *************************} + + procedure proc_value_u8bit_mixed(b1 : byte; v: byte; b2: byte); + begin + global_u8bit := v; + value_u8bit := b2; + end; + + + procedure proc_value_u16bit_mixed(b1: byte; v: word; b2: byte); + begin + global_u16bit := v; + value_u8bit := b2; + end; + + + procedure proc_value_s32bit_mixed(b1 : byte; v : longint; b2: byte); + begin + global_s32bit := v; + value_u8bit := b2; + end; + + + + + procedure proc_value_bool8bit_mixed(b1: byte; v: boolean; b2: byte); + begin + { boolean should be 8-bit always! } + if sizeof(boolean) <> 1 then RunError(255); + global_u8bit := byte(v); + value_u8bit := b2; + end; + + + procedure proc_value_bool16bit_mixed(b1 : byte; v: wordbool; b2: byte); + begin + global_u16bit := word(v); + value_u8bit := b2; + end; + + + procedure proc_value_bool32bit_mixed(b1 : byte; v : longbool; b2: byte); + begin + global_s32bit := longint(v); + value_u8bit := b2; + end; + + + procedure proc_value_s32real_mixed(b1: byte; v : single; b2: byte); + begin + global_s32real := v; + value_u8bit := b2; + end; + + procedure proc_value_s64real_mixed(b1: byte; v: double; b2: byte); + begin + global_s64real:= v; + value_u8bit := b2; + end; + + + procedure proc_value_pointerdef_mixed(b1: byte; p : pchar; b2: byte); + begin + global_ptr:=p; + value_u8bit := b2; + end; + + + procedure proc_value_procvardef_mixed(b1: byte; p : tprocedure; b2: byte); + begin + global_proc:=p; + value_u8bit := b2; + end; + + + + + procedure proc_value_smallrecord_mixed(b1: byte; smallrec : tsmallrecord; b2: byte); + begin + if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + procedure proc_value_largerecord_mixed(b1: byte; largerec : tlargerecord; b2: byte); + begin + if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + procedure proc_value_smallset_mixed(b1: byte; smallset : tsmallset; b2: byte); + begin + if A_D in smallset then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + procedure proc_value_largeset_mixed(b1: byte; largeset : tlargeset; b2: byte); + begin + if 'I' in largeset then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + procedure proc_value_smallstring_mixed(b1: byte; s:tsmallstring; b2: byte); + begin + if s = RESULT_SMALLSTRING then + global_u8bit := RESULT_u8BIT; + value_u8bit := b2; + end; + + + procedure proc_value_bigstring_mixed(b1: byte; s:shortstring; b2: byte); + begin + if s = RESULT_BIGSTRING then + global_u8bit := RESULT_u8BIT; + value_u8bit := b2; + end; + + + procedure proc_value_smallarray_mixed(b1: byte; arr : tsmallarray; b2: byte); + begin + if arr[SMALL_INDEX] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + procedure proc_value_smallarray_open_mixed(b1: byte; arr : array of byte; b2: byte); + begin + { form 0 to N-1 indexes in open arrays } + if arr[SMALL_INDEX-1] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + +{$ifndef tp} + procedure proc_value_classrefdef_mixed(b1: byte; obj : tclass1; b2: byte); + begin + global_class:=obj; + value_u8bit := b2; + end; + + + procedure proc_value_s64bit_mixed(b1 : byte; v: int64; b2: byte); + begin + global_s64bit:= v; + value_u8bit := b2; + end; + + + procedure proc_value_smallarray_const_1_mixed(b1: byte; arr : array of const; b2: byte); + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : global_u8bit := arr[i].vinteger and $ff; + vtBoolean : global_boolean := arr[i].vboolean; + vtChar : global_char := arr[i].vchar; + vtExtended : global_s64real := arr[i].VExtended^; + vtString : global_bigstring := arr[i].VString^; + vtPointer : ; + vtPChar : global_ptr := arr[i].VPchar; + vtObject : ; +{ vtClass : global_class := (arr[i].VClass) as tclass1;} + vtAnsiString : ; + vtInt64 : global_s64bit := arr[i].vInt64^; + else + RunError(255); + end; + end; {endfor} + value_u8bit := b2; + end; + + + procedure proc_value_smallarray_const_2_mixed(b1: byte; arr : array of const; b2: byte); + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; +{$endif} + +var + failed: boolean; +Begin + {***************************** NORMAL TESTS *******************************} + clear_globals; + clear_values; + + failed:=false; + + { LOC_REGISTER } + write('Value parameter test (src : LOC_REGISTER)...'); + proc_value_u8bit(getu8bit); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + proc_value_u16bit(getu16bit); + if global_u16bit <> RESULT_U16BIT then + failed:=true; + proc_value_s32bit(gets32bit); + if global_s32bit <> RESULT_S32BIT then + failed:=true; +{$ifndef tp} + proc_value_s64bit(gets64bit); + if global_s64bit <> RESULT_S64BIT then + failed:=true; +{$endif} + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_FPUREGISTER } + clear_globals; + clear_values; + failed:=false; + write('Value parameter test (src : LOC_FPUREGISTER)...'); + proc_value_s32real(gets32real); + if trunc(global_s32real) <> trunc(RESULT_S32REAL) then + failed:=true; + proc_value_s64real(gets64real); + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed:=true; + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_MEM, LOC_REFERENCE orddef } + clear_globals; + clear_values; + value_u8bit := RESULT_U8BIT; + value_u16bit := RESULT_U16BIT; + value_s32bit := RESULT_S32BIT; +{$ifndef tp} + value_s64bit := RESULT_S64BIT; +{$endif} + value_s32real := RESULT_S32REAL; + value_s64real := RESULT_S64REAL; + + failed:=false; + + { LOC_REFERENCE } + write('Value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...'); + proc_value_u8bit(value_u8bit); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + proc_value_u16bit(value_u16bit); + if global_u16bit <> RESULT_U16BIT then + failed:=true; + proc_value_s32bit(value_s32bit); + if global_s32bit <> RESULT_S32BIT then + failed:=true; +{$ifndef tp} + proc_value_s64bit(value_s64bit); + if global_s64bit <> RESULT_S64BIT then + failed:=true; +{$endif} + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_REFERENCE } + clear_globals; + failed:=false; + write('Value parameter test (src : LOC_REFERENCE (floatdef))...'); + proc_value_s32real(value_s32real); + if trunc(global_s32real) <> trunc(RESULT_S32REAL) then + failed:=true; + proc_value_s64real(value_s64real); + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed:=true; + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Value parameter test (src : LOC_REFERENCE (pointer))...'); + clear_globals; + clear_values; + failed:=false; + value_ptr := RESULT_PCHAR; + proc_value_pointerdef(value_ptr); + if global_ptr <> value_ptr then + failed := true; + + + value_proc := {$ifndef tp}@{$endif}testprocedure; + proc_value_procvardef(value_proc); + if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then + failed := true; + +{$ifndef tp} + value_class := tclass1.create; + proc_value_classrefdef(value_class); + if value_class <> global_class then + failed := true; + value_class.destroy; +{$endif} + if failed then + fail + else + WriteLn('Passed!'); + + + + + { LOC_REFERENCE } + clear_globals; + clear_values; + failed:=false; + value_u8bit := 0; + write('Value parameter test (src : LOC_FLAGS (orddef)))...'); + proc_value_bool8bit(value_u8bit = 0); + if global_u8bit <> RESULT_BOOL8BIT then + failed:=true; +{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x + proc_value_bool16bit(value_s64bit < 0); + if global_u16bit <> RESULT_BOOL16BIT then + failed:=true; + proc_value_bool32bit(bool1 and bool2); + if global_s32bit <> RESULT_BOOL32BIT then + failed:=true;*} + if failed then + fail + else + WriteLn('Passed!'); + + + +{$ifndef tp} + clear_globals; + clear_values; + failed:=false; + write('Value parameter test (src : LOC_JUMP (orddef)))...'); + proc_value_bool8bit(value_s64bit = 0); + if global_u8bit <> RESULT_BOOL8BIT then + failed:=true; +{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x + proc_value_bool16bit(value_s64bit < 0); + if global_u16bit <> RESULT_BOOL16BIT then + failed:=true; + proc_value_bool32bit(bool1 and bool2); + if global_s32bit <> RESULT_BOOL32BIT then + failed:=true;*} + if failed then + fail + else + WriteLn('Passed!'); +{$endif} + + { arraydef, + recorddef, + objectdef, + stringdef, + setdef : all considered the same by code generator. + } + write('Value parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallrec.b := RESULT_U8BIT; + value_smallrec.w := RESULT_U16BIT; + proc_value_smallrecord(value_smallrec); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); + proc_value_largerecord(value_largerec); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Value parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallset := [A_A,A_D]; + proc_value_smallset(value_smallset); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_largeset := ['I']; + proc_value_largeset(value_largeset); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + + + write('Value parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + value_smallstring := RESULT_SMALLSTRING; + + proc_value_smallstring(value_smallstring); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_bigstring := RESULT_BIGSTRING; + proc_value_bigstring(value_bigstring); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!} + { DON'T KNOW WHY/HOW TO TEST!!!!! } + + + write('Value parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + fillchar(value_smallarray,sizeof(value_smallarray),#0); + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_value_smallarray(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + fillchar(value_smallarray,sizeof(value_smallarray),#0); + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_value_smallarray_open(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + +{$ifndef tp} + clear_globals; + clear_values; + + value_u8bit := RESULT_U8BIT; + value_ptr := RESULT_PCHAR; + value_s64bit := RESULT_S64BIT; + value_smallstring := RESULT_SMALLSTRING; + value_class := tclass1.create; + value_boolean := RESULT_BOOLEAN; + value_char := RESULT_CHAR; + value_s64real:=RESULT_S64REAL; + proc_value_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real, + value_boolean,value_class]); + + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if global_char <> RESULT_CHAR then + failed := true; + if global_boolean <> RESULT_BOOLEAN then + failed:=true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed := true; + if global_bigstring <> RESULT_SMALLSTRING then + failed := true; + if global_ptr <> value_ptr then + failed := true; +{ if value_class <> global_class then + failed := true;!!!!!!!!!!!!!!!!!!!!} + if global_s64bit <> RESULT_S64BIT then + failed := true; + if assigned(value_class) then + value_class.destroy; + + global_u8bit := 0; + proc_value_smallarray_const_2([]); + if global_u8bit <> RESULT_U8BIT then + failed := true; +{$endif fpc} + + if failed then + fail + else + WriteLn('Passed!'); + + {***************************** MIXED TESTS *******************************} + clear_globals; + clear_values; + + failed:=false; + + { LOC_REGISTER } + write('Mixed value parameter test (src : LOC_REGISTER)...'); + proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),getu8bit,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + proc_value_u16bit_mixed(byte(NOT RESULT_U8BIT),getu16bit,RESULT_U8BIT); + if global_u16bit <> RESULT_U16BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + proc_value_s32bit_mixed(byte(NOT RESULT_U8BIT),gets32bit, RESULT_U8BIT); + if global_s32bit <> RESULT_S32BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$ifndef tp} + proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT),gets64bit,RESULT_U8BIT); + if global_s64bit <> RESULT_S64BIT then + failed:=true; +{$endif} + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_FPUREGISTER } + clear_globals; + clear_values; + failed:=false; + write('Mixed value parameter test (src : LOC_FPUREGISTER)...'); + proc_value_s32real_mixed(byte(NOT RESULT_U8BIT), gets32real, RESULT_U8BIT); + if value_u8bit <> RESULT_U8BIT then + failed := true; + if trunc(global_s32real) <> trunc(RESULT_S32REAL) then + failed:=true; + proc_value_s64real_mixed(byte(NOT RESULT_U8BIT),gets64real,RESULT_U8BIT); + if value_u8bit <> RESULT_U8BIT then + failed := true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed:=true; + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_MEM, LOC_REFERENCE orddef } + clear_globals; + clear_values; + value_u8bit := RESULT_U8BIT; + value_u16bit := RESULT_U16BIT; + value_s32bit := RESULT_S32BIT; +{$ifndef tp} + value_s64bit := RESULT_S64BIT; +{$endif} + value_s32real := RESULT_S32REAL; + value_s64real := RESULT_S64REAL; + + failed:=false; + + { LOC_REFERENCE } + write('Mixed value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...'); + proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),value_u8bit, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + proc_value_u16bit_mixed(byte(NOT RESULT_U8BIT),value_u16bit, RESULT_U8BIT); + if global_u16bit <> RESULT_U16BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + proc_value_s32bit_mixed(byte(NOT RESULT_U8BIT),value_s32bit, RESULT_U8BIT); + if global_s32bit <> RESULT_S32BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$ifndef tp} + proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit, RESULT_U8BIT); + if global_s64bit <> RESULT_S64BIT then + failed:=true; +{$endif} + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_REFERENCE } + clear_globals; + failed:=false; + write('Mixed value parameter test (src : LOC_REFERENCE (floatdef))...'); + proc_value_s32real_mixed(byte(NOT RESULT_U8BIT), value_s32real, RESULT_U8BIT); + if trunc(global_s32real) <> trunc(RESULT_S32REAL) then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + proc_value_s64real_mixed(byte(NOT RESULT_U8BIT), value_s64real, RESULT_U8BIT); + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Mixed value parameter test (src : LOC_REFERENCE (pointer))...'); + clear_globals; + clear_values; + failed:=false; + value_ptr := RESULT_PCHAR; + proc_value_pointerdef_mixed(byte(NOT RESULT_U8BIT), value_ptr, RESULT_U8BIT); + if global_ptr <> value_ptr then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + + value_proc := {$ifndef tp}@{$endif}testprocedure; + proc_value_procvardef_mixed(byte(NOT RESULT_U8BIT), value_proc, RESULT_U8BIT); + if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then + failed := true; + +{$ifndef tp} + value_class := tclass1.create; + proc_value_classrefdef_mixed(byte(NOT RESULT_U8BIT), value_class, RESULT_U8BIT); + if value_class <> global_class then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + value_class.destroy; +{$endif} + if failed then + fail + else + WriteLn('Passed!'); + + + + + { LOC_REFERENCE } + clear_globals; + clear_values; + failed:=false; + value_u8bit := 0; + write('Mixed value parameter test (src : LOC_FLAGS (orddef)))...'); + proc_value_bool8bit_mixed(byte(NOT RESULT_U8BIT), value_u8bit = 0, RESULT_U8BIT); + if global_u8bit <> RESULT_BOOL8BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x + proc_value_bool16bit(value_s64bit < 0); + if global_u16bit <> RESULT_BOOL16BIT then + failed:=true; + proc_value_bool32bit(bool1 and bool2); + if global_s32bit <> RESULT_BOOL32BIT then + failed:=true;*} + if failed then + fail + else + WriteLn('Passed!'); + + + +{$ifndef tp} + clear_globals; + clear_values; + failed:=false; + write('Mixed value parameter test (src : LOC_JUMP (orddef)))...'); + proc_value_bool8bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit = 0, RESULT_U8BIT); + if global_u8bit <> RESULT_BOOL8BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x + proc_value_bool16bit(value_s64bit < 0); + if global_u16bit <> RESULT_BOOL16BIT then + failed:=true; + proc_value_bool32bit(bool1 and bool2); + if global_s32bit <> RESULT_BOOL32BIT then + failed:=true;*} + if failed then + fail + else + WriteLn('Passed!'); +{$endif} + + { arraydef, + recorddef, + objectdef, + stringdef, + setdef : all considered the same by code generator. + } + write('Mixed value parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallrec.b := RESULT_U8BIT; + value_smallrec.w := RESULT_U16BIT; + proc_value_smallrecord_mixed(byte(NOT RESULT_U8BIT), value_smallrec, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); + proc_value_largerecord_mixed(byte(NOT RESULT_U8BIT), value_largerec, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Mixed value parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallset := [A_A,A_D]; + proc_value_smallset_mixed(byte(NOT RESULT_U8BIT), value_smallset, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_largeset := ['I']; + proc_value_largeset_mixed(byte(NOT RESULT_U8BIT), value_largeset, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + + + write('Mixed value parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + value_smallstring := RESULT_SMALLSTRING; + + proc_value_smallstring_mixed(byte(NOT RESULT_U8BIT), value_smallstring, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_bigstring := RESULT_BIGSTRING; + proc_value_bigstring_mixed(byte(NOT RESULT_U8BIT), value_bigstring, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!} + { DON'T KNOW WHY/HOW TO TEST!!!!! } + + + write('Mixed value parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + fillchar(value_smallarray,sizeof(value_smallarray),#0); + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_value_smallarray_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + fillchar(value_smallarray,sizeof(value_smallarray),#0); + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_value_smallarray_open_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + +{$ifndef tp} + clear_globals; + clear_values; + + value_u8bit := RESULT_U8BIT; + value_ptr := RESULT_PCHAR; + value_s64bit := RESULT_S64BIT; + value_smallstring := RESULT_SMALLSTRING; + value_class := tclass1.create; + value_boolean := RESULT_BOOLEAN; + value_char := RESULT_CHAR; + value_s64real:=RESULT_S64REAL; + proc_value_smallarray_const_1_mixed(byte(NOT RESULT_U8BIT), [value_u8bit,value_ptr,value_s64bit,value_char, + value_smallstring,value_s64real,value_boolean,value_class], + RESULT_U8BIT); + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if global_char <> RESULT_CHAR then + failed := true; + if global_boolean <> RESULT_BOOLEAN then + failed:=true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed := true; + if global_bigstring <> RESULT_SMALLSTRING then + failed := true; + if global_ptr <> value_ptr then + failed := true; +{ if value_class <> global_class then + failed := true;!!!!!!!!!!!!!!!!!!!!} + if global_s64bit <> RESULT_S64BIT then + failed := true; + if assigned(value_class) then + value_class.destroy; + + global_u8bit := 0; + proc_value_smallarray_const_2_mixed(byte(NOT RESULT_U8BIT), [], RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$endif} + + if failed then + fail + else + WriteLn('Passed!'); + +end. + + +{ $Log$ - Revision 1.4 2002-09-22 09:08:41 carl - * gets64bit was not returning an int64! - - Revision 1.3 2002/09/07 15:40:55 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/10 16:33:18 carl - + first tries at first calln testing - -} + Revision 1.5 2003-04-22 10:24:29 florian + * fixed defines for powerpc + + Revision 1.4 2002/09/22 09:08:41 carl + * gets64bit was not returning an int64! + + Revision 1.3 2002/09/07 15:40:55 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/10 16:33:18 carl + + first tries at first calln testing + +} diff --git a/tests/test/cg/tcalval2.pp b/tests/test/cg/tcalval2.pp index ea03d811f7..46ce43cd1b 100644 --- a/tests/test/cg/tcalval2.pp +++ b/tests/test/cg/tcalval2.pp @@ -1,622 +1,621 @@ -{****************************************************************} -{ 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 } -{ (value parameters with inline calls) } -{****************************************************************} -program tcalval2; - -{$mode objfpc} -{$INLINE ON} -{$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; - {$endif} - {$ifdef cpui386} - 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 - tclass1 = class - end; - - 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_s64bit : int64; - global_s32real : single; - global_s64real : double; - global_ptr : pchar; - global_proc : tprocedure; - global_class : tclass1; - global_bigstring : shortstring; - global_boolean : boolean; - global_char : char; - value_u8bit : byte; - value_u16bit : word; - value_s32bit : longint; - value_s64bit : int64; - value_s32real : single; - value_s64real : double; - value_proc : tprocedure; - value_ptr : pchar; - value_class : tclass1; - 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_s64bit := 0; - global_s32real := 0.0; - global_s64real := 0.0; - global_ptr := nil; - global_proc := nil; - global_class := nil; - global_bigstring := ''; - global_boolean := false; - global_char := #0; - end; - - - procedure clear_values; - begin - value_u8bit := 0; - value_u16bit := 0; - value_s32bit := 0; - value_s64bit := 0; - value_s32real := 0.0; - value_s64real := 0.0; - value_proc := nil; - value_ptr := nil; - value_class := 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; - end; - - - procedure testprocedure; - begin - end; - - function getu8bit : byte; - begin - getu8bit:=RESULT_U8BIT; - end; - - function getu16bit: word; - begin - getu16bit:=RESULT_U16BIT; - end; - - function gets32bit: longint; - begin - gets32bit:=RESULT_S32BIT; - end; - - function gets64bit: int64; - begin - gets64bit:=RESULT_S64BIT; - end; - - - function gets32real: single; - begin - gets32real:=RESULT_S32REAL; - end; - - function gets64real: double; - begin - gets64real:=RESULT_S64REAL; - end; - - - procedure proc_value_u8bit_inline(v: byte);inline; - begin - global_u8bit := v; - end; - - - procedure proc_value_u16bit_inline(v: word);inline; - begin - global_u16bit := v; - end; - - - procedure proc_value_s32bit_inline(v : longint);inline; - begin - global_s32bit := v; - end; - - procedure proc_value_s64bit_inline(v: int64);inline; - begin - global_s64bit:= v; - end; - - procedure proc_value_s32real_inline(v : single);inline; - begin - global_s32real := v; - end; - - procedure proc_value_s64real_inline(v: double);inline; - begin - global_s64real:= v; - end; - - procedure proc_value_pointerdef_inline(p : pchar);inline; - begin - global_ptr:=p; - end; - - - procedure proc_value_procvardef_inline(p : tprocedure);inline; - begin - global_proc:=p; - end; - - - procedure proc_value_classrefdef_inline(obj : tclass1);inline; - begin - global_class:=obj; - end; - - procedure proc_value_bool8bit_inline(v: boolean);inline; - begin - { boolean should be 8-bit always! } - if sizeof(boolean) <> 1 then RunError(255); - global_u8bit := byte(v); - end; - - procedure proc_value_smallrecord_inline(smallrec : tsmallrecord);inline; - begin - if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_value_largerecord_inline(largerec : tlargerecord);inline; - begin - if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_value_smallset_inline(smallset : tsmallset);inline; - begin - if A_D in smallset then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_value_largeset_inline(largeset : tlargeset);inline; - begin - if 'I' in largeset then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_value_smallstring_inline(s:tsmallstring);inline; - begin - if s = RESULT_SMALLSTRING then - global_u8bit := RESULT_u8BIT; - end; - - - procedure proc_value_bigstring_inline(s:shortstring);inline; - begin - if s = RESULT_BIGSTRING then - global_u8bit := RESULT_u8BIT; - end; - - - procedure proc_value_smallarray_inline(arr : tsmallarray);inline; - begin - if arr[SMALL_INDEX] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_value_smallarray_open_inline(arr : array of byte);inline; - begin - { form 0 to N-1 indexes in open arrays } - if arr[SMALL_INDEX-1] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_value_smallarray_const_1_inline(arr : array of const);inline; - var - i: integer; - begin - global_u8bit := arr[0].vinteger and $ff; - global_ptr := arr[1].VPchar; - global_s64bit := arr[2].vInt64^; - global_char := arr[3].vchar; - global_bigstring := arr[4].VString^; - global_s64real := arr[5].VExtended^; - - global_boolean := arr[6].vboolean; -(* - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : global_u8bit := arr[i].vinteger and $ff; - vtBoolean : global_boolean := arr[i].vboolean; - vtChar : global_char := arr[i].vchar; - vtExtended : global_s64real := arr[i].VExtended^; - vtString : global_bigstring := arr[i].VString^; - vtPointer : ; - vtPChar : global_ptr := arr[i].VPchar; - vtObject : ; -{ vtClass : global_class := tclass1(arr[i].VClass);} - vtAnsiString : ; - vtInt64 : global_s64bit := arr[i].vInt64^; - else - RunError(255); - end; - end; {endfor} -*) - end; - - - procedure proc_value_smallarray_const_2_inline(arr : array of const);inline; - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - end; - - -var - failed: boolean; -begin - - {***************************** INLINE TESTS *******************************} - - write('(Inline) Value parameter test (src : LOC_REGISTER)...'); - clear_globals; - clear_values; - failed:=false; - proc_value_u8bit_inline(getu8bit); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - proc_value_u16bit_inline(getu16bit); - if global_u16bit <> RESULT_U16BIT then - failed:=true; - proc_value_s32bit_inline(gets32bit); - if global_s32bit <> RESULT_S32BIT then - failed:=true; - proc_value_s64bit_inline(gets64bit); - if global_s64bit <> RESULT_S64BIT then - failed:=true; - if failed then - fail - else - WriteLn('Passed!'); - - clear_globals; - clear_values; - failed:=false; - write('(Inline) Value parameter test (src : LOC_FPUREGISTER)...'); - proc_value_s32real_inline(gets32real); - if trunc(global_s32real) <> trunc(RESULT_S32REAL) then - failed:=true; - proc_value_s64real_inline(gets64real); - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed:=true; - - if failed then - fail - else - WriteLn('Passed!'); - - { LOC_REFERENCE } - write('(Inline) Value parameter test (src : LOC_REFERENCE (orddef/enumdef))...'); - clear_globals; - clear_values; - value_u8bit := RESULT_U8BIT; - value_u16bit := RESULT_U16BIT; - value_s32bit := RESULT_S32BIT; -{$ifndef tp} - value_s64bit := RESULT_S64BIT; -{$endif} - value_s32real := RESULT_S32REAL; - value_s64real := RESULT_S64REAL; - failed:=false; - proc_value_u8bit_inline(value_u8bit); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - proc_value_u16bit_inline(value_u16bit); - if global_u16bit <> RESULT_U16BIT then - failed:=true; - proc_value_s32bit_inline(value_s32bit); - if global_s32bit <> RESULT_S32BIT then - failed:=true; - proc_value_s64bit_inline(value_s64bit); - if global_s64bit <> RESULT_S64BIT then - failed:=true; - if failed then - fail - else - WriteLn('Passed!'); - - - clear_globals; - failed:=false; - write('(Inline) Value parameter test (src : LOC_REFERENCE (floatdef))...'); - proc_value_s32real_inline(value_s32real); - if trunc(global_s32real) <> trunc(RESULT_S32REAL) then - failed:=true; - proc_value_s64real_inline(value_s64real); - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed:=true; - - if failed then - fail - else - WriteLn('Passed!'); - - write('(Inline) Value parameter test (src : LOC_REFERENCE (pointer))...'); - clear_globals; - clear_values; - value_ptr := RESULT_PCHAR; - failed:=false; - proc_value_pointerdef_inline(value_ptr); - if global_ptr <> value_ptr then - failed := true; - - - value_proc := @testprocedure; - proc_value_procvardef_inline(value_proc); - if value_proc <> global_proc then - failed := true; - - value_class := tclass1.create; - proc_value_classrefdef_inline(value_class); - if value_class <> global_class then - failed := true; - value_class.destroy; - if failed then - fail - else - WriteLn('Passed!'); - - write('(Inline) Value parameter test (src : LOC_FLAGS (orddef))...'); - clear_globals; - clear_values; - failed:=false; - value_u8bit := 0; - failed:=false; - proc_value_bool8bit_inline(value_u8bit = 0); - if global_u8bit <> RESULT_BOOL8BIT then - failed:=true; - if failed then - fail - else - WriteLn('Passed!'); - - write('(Inline) Value parameter test (src : LOC_REFERENCE (recorddef)))...'); - failed := false; - - clear_globals; - clear_values; - value_smallrec.b := RESULT_U8BIT; - value_smallrec.w := RESULT_U16BIT; - proc_value_smallrecord_inline(value_smallrec); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); - proc_value_largerecord_inline(value_largerec); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - write('(Inline) Value parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - value_smallset := [A_A,A_D]; - - proc_value_smallset_inline(value_smallset); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_largeset := ['I']; - proc_value_largeset_inline(value_largeset); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - write('(Inline) Value parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - value_smallstring := RESULT_SMALLSTRING; - - proc_value_smallstring_inline(value_smallstring); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_bigstring := RESULT_BIGSTRING; - proc_value_bigstring_inline(value_bigstring); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - write('(Inline) value parameter test (src : LOC_REFERENCE (arraydef)))...'); - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_value_smallarray_inline(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_value_smallarray_open_inline(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - value_u8bit := RESULT_U8BIT; - value_ptr := RESULT_PCHAR; - value_s64bit := RESULT_S64BIT; - value_smallstring := RESULT_SMALLSTRING; - value_class := tclass1.create; - value_boolean := RESULT_BOOLEAN; - value_char := RESULT_CHAR; - value_s64real:=RESULT_S64REAL; - proc_value_smallarray_const_1_inline([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,value_boolean,value_class]); - - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if global_char <> RESULT_CHAR then - failed := true; - if global_boolean <> RESULT_BOOLEAN then - failed:=true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed := true; - if global_bigstring <> RESULT_SMALLSTRING then - failed := true; - if global_ptr <> value_ptr then - failed := true; -{ if value_class <> global_class then - failed := true;!!!!!!!!!!!!!!!!!!!!} - if global_s64bit <> RESULT_S64BIT then - failed := true; - if assigned(value_class) then - value_class.destroy; - - global_u8bit := 0; - proc_value_smallarray_const_2_inline([]); - if global_u8bit <> RESULT_U8BIT 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 } +{ (value parameters with inline calls) } +{****************************************************************} +program tcalval2; + +{$mode objfpc} +{$INLINE ON} +{$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 + tclass1 = class + end; + + 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_s64bit : int64; + global_s32real : single; + global_s64real : double; + global_ptr : pchar; + global_proc : tprocedure; + global_class : tclass1; + global_bigstring : shortstring; + global_boolean : boolean; + global_char : char; + value_u8bit : byte; + value_u16bit : word; + value_s32bit : longint; + value_s64bit : int64; + value_s32real : single; + value_s64real : double; + value_proc : tprocedure; + value_ptr : pchar; + value_class : tclass1; + 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_s64bit := 0; + global_s32real := 0.0; + global_s64real := 0.0; + global_ptr := nil; + global_proc := nil; + global_class := nil; + global_bigstring := ''; + global_boolean := false; + global_char := #0; + end; + + + procedure clear_values; + begin + value_u8bit := 0; + value_u16bit := 0; + value_s32bit := 0; + value_s64bit := 0; + value_s32real := 0.0; + value_s64real := 0.0; + value_proc := nil; + value_ptr := nil; + value_class := 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; + end; + + + procedure testprocedure; + begin + end; + + function getu8bit : byte; + begin + getu8bit:=RESULT_U8BIT; + end; + + function getu16bit: word; + begin + getu16bit:=RESULT_U16BIT; + end; + + function gets32bit: longint; + begin + gets32bit:=RESULT_S32BIT; + end; + + function gets64bit: int64; + begin + gets64bit:=RESULT_S64BIT; + end; + + + function gets32real: single; + begin + gets32real:=RESULT_S32REAL; + end; + + function gets64real: double; + begin + gets64real:=RESULT_S64REAL; + end; + + + procedure proc_value_u8bit_inline(v: byte);inline; + begin + global_u8bit := v; + end; + + + procedure proc_value_u16bit_inline(v: word);inline; + begin + global_u16bit := v; + end; + + + procedure proc_value_s32bit_inline(v : longint);inline; + begin + global_s32bit := v; + end; + + procedure proc_value_s64bit_inline(v: int64);inline; + begin + global_s64bit:= v; + end; + + procedure proc_value_s32real_inline(v : single);inline; + begin + global_s32real := v; + end; + + procedure proc_value_s64real_inline(v: double);inline; + begin + global_s64real:= v; + end; + + procedure proc_value_pointerdef_inline(p : pchar);inline; + begin + global_ptr:=p; + end; + + + procedure proc_value_procvardef_inline(p : tprocedure);inline; + begin + global_proc:=p; + end; + + + procedure proc_value_classrefdef_inline(obj : tclass1);inline; + begin + global_class:=obj; + end; + + procedure proc_value_bool8bit_inline(v: boolean);inline; + begin + { boolean should be 8-bit always! } + if sizeof(boolean) <> 1 then RunError(255); + global_u8bit := byte(v); + end; + + procedure proc_value_smallrecord_inline(smallrec : tsmallrecord);inline; + begin + if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_value_largerecord_inline(largerec : tlargerecord);inline; + begin + if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_value_smallset_inline(smallset : tsmallset);inline; + begin + if A_D in smallset then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_value_largeset_inline(largeset : tlargeset);inline; + begin + if 'I' in largeset then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_value_smallstring_inline(s:tsmallstring);inline; + begin + if s = RESULT_SMALLSTRING then + global_u8bit := RESULT_u8BIT; + end; + + + procedure proc_value_bigstring_inline(s:shortstring);inline; + begin + if s = RESULT_BIGSTRING then + global_u8bit := RESULT_u8BIT; + end; + + + procedure proc_value_smallarray_inline(arr : tsmallarray);inline; + begin + if arr[SMALL_INDEX] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_value_smallarray_open_inline(arr : array of byte);inline; + begin + { form 0 to N-1 indexes in open arrays } + if arr[SMALL_INDEX-1] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_value_smallarray_const_1_inline(arr : array of const);inline; + var + i: integer; + begin + global_u8bit := arr[0].vinteger and $ff; + global_ptr := arr[1].VPchar; + global_s64bit := arr[2].vInt64^; + global_char := arr[3].vchar; + global_bigstring := arr[4].VString^; + global_s64real := arr[5].VExtended^; + + global_boolean := arr[6].vboolean; +(* + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : global_u8bit := arr[i].vinteger and $ff; + vtBoolean : global_boolean := arr[i].vboolean; + vtChar : global_char := arr[i].vchar; + vtExtended : global_s64real := arr[i].VExtended^; + vtString : global_bigstring := arr[i].VString^; + vtPointer : ; + vtPChar : global_ptr := arr[i].VPchar; + vtObject : ; +{ vtClass : global_class := tclass1(arr[i].VClass);} + vtAnsiString : ; + vtInt64 : global_s64bit := arr[i].vInt64^; + else + RunError(255); + end; + end; {endfor} +*) + end; + + + procedure proc_value_smallarray_const_2_inline(arr : array of const);inline; + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + end; + + +var + failed: boolean; +begin + + {***************************** INLINE TESTS *******************************} + + write('(Inline) Value parameter test (src : LOC_REGISTER)...'); + clear_globals; + clear_values; + failed:=false; + proc_value_u8bit_inline(getu8bit); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + proc_value_u16bit_inline(getu16bit); + if global_u16bit <> RESULT_U16BIT then + failed:=true; + proc_value_s32bit_inline(gets32bit); + if global_s32bit <> RESULT_S32BIT then + failed:=true; + proc_value_s64bit_inline(gets64bit); + if global_s64bit <> RESULT_S64BIT then + failed:=true; + if failed then + fail + else + WriteLn('Passed!'); + + clear_globals; + clear_values; + failed:=false; + write('(Inline) Value parameter test (src : LOC_FPUREGISTER)...'); + proc_value_s32real_inline(gets32real); + if trunc(global_s32real) <> trunc(RESULT_S32REAL) then + failed:=true; + proc_value_s64real_inline(gets64real); + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed:=true; + + if failed then + fail + else + WriteLn('Passed!'); + + { LOC_REFERENCE } + write('(Inline) Value parameter test (src : LOC_REFERENCE (orddef/enumdef))...'); + clear_globals; + clear_values; + value_u8bit := RESULT_U8BIT; + value_u16bit := RESULT_U16BIT; + value_s32bit := RESULT_S32BIT; +{$ifndef tp} + value_s64bit := RESULT_S64BIT; +{$endif} + value_s32real := RESULT_S32REAL; + value_s64real := RESULT_S64REAL; + failed:=false; + proc_value_u8bit_inline(value_u8bit); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + proc_value_u16bit_inline(value_u16bit); + if global_u16bit <> RESULT_U16BIT then + failed:=true; + proc_value_s32bit_inline(value_s32bit); + if global_s32bit <> RESULT_S32BIT then + failed:=true; + proc_value_s64bit_inline(value_s64bit); + if global_s64bit <> RESULT_S64BIT then + failed:=true; + if failed then + fail + else + WriteLn('Passed!'); + + + clear_globals; + failed:=false; + write('(Inline) Value parameter test (src : LOC_REFERENCE (floatdef))...'); + proc_value_s32real_inline(value_s32real); + if trunc(global_s32real) <> trunc(RESULT_S32REAL) then + failed:=true; + proc_value_s64real_inline(value_s64real); + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed:=true; + + if failed then + fail + else + WriteLn('Passed!'); + + write('(Inline) Value parameter test (src : LOC_REFERENCE (pointer))...'); + clear_globals; + clear_values; + value_ptr := RESULT_PCHAR; + failed:=false; + proc_value_pointerdef_inline(value_ptr); + if global_ptr <> value_ptr then + failed := true; + + + value_proc := @testprocedure; + proc_value_procvardef_inline(value_proc); + if value_proc <> global_proc then + failed := true; + + value_class := tclass1.create; + proc_value_classrefdef_inline(value_class); + if value_class <> global_class then + failed := true; + value_class.destroy; + if failed then + fail + else + WriteLn('Passed!'); + + write('(Inline) Value parameter test (src : LOC_FLAGS (orddef))...'); + clear_globals; + clear_values; + failed:=false; + value_u8bit := 0; + failed:=false; + proc_value_bool8bit_inline(value_u8bit = 0); + if global_u8bit <> RESULT_BOOL8BIT then + failed:=true; + if failed then + fail + else + WriteLn('Passed!'); + + write('(Inline) Value parameter test (src : LOC_REFERENCE (recorddef)))...'); + failed := false; + + clear_globals; + clear_values; + value_smallrec.b := RESULT_U8BIT; + value_smallrec.w := RESULT_U16BIT; + proc_value_smallrecord_inline(value_smallrec); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); + proc_value_largerecord_inline(value_largerec); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + write('(Inline) Value parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + value_smallset := [A_A,A_D]; + + proc_value_smallset_inline(value_smallset); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_largeset := ['I']; + proc_value_largeset_inline(value_largeset); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + write('(Inline) Value parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + value_smallstring := RESULT_SMALLSTRING; + + proc_value_smallstring_inline(value_smallstring); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_bigstring := RESULT_BIGSTRING; + proc_value_bigstring_inline(value_bigstring); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + write('(Inline) value parameter test (src : LOC_REFERENCE (arraydef)))...'); + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_value_smallarray_inline(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_value_smallarray_open_inline(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + value_u8bit := RESULT_U8BIT; + value_ptr := RESULT_PCHAR; + value_s64bit := RESULT_S64BIT; + value_smallstring := RESULT_SMALLSTRING; + value_class := tclass1.create; + value_boolean := RESULT_BOOLEAN; + value_char := RESULT_CHAR; + value_s64real:=RESULT_S64REAL; + proc_value_smallarray_const_1_inline([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,value_boolean,value_class]); + + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if global_char <> RESULT_CHAR then + failed := true; + if global_boolean <> RESULT_BOOLEAN then + failed:=true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed := true; + if global_bigstring <> RESULT_SMALLSTRING then + failed := true; + if global_ptr <> value_ptr then + failed := true; +{ if value_class <> global_class then + failed := true;!!!!!!!!!!!!!!!!!!!!} + if global_s64bit <> RESULT_S64BIT then + failed := true; + if assigned(value_class) then + value_class.destroy; + + global_u8bit := 0; + proc_value_smallarray_const_2_inline([]); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); +end. diff --git a/tests/test/cg/tcalval3.pp b/tests/test/cg/tcalval3.pp index f6b0d4b4e5..b295e74df4 100644 --- a/tests/test/cg/tcalval3.pp +++ b/tests/test/cg/tcalval3.pp @@ -1,1309 +1,1311 @@ -{****************************************************************} -{ 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 } -{ (value parameters with pascal calling convention) } -{****************************************************************} -program tcalval3; - -{$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; - {$endif} - {$ifdef cpui386} - 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_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; -{$ifndef tp} - global_s64bit := 0; - global_class := nil; -{$endif} - 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; -{$ifndef tp} - value_s64bit := 0; - value_class := nil; -{$endif} - end; - - - procedure testprocedure; - begin - end; - - function getu8bit : byte; - begin - getu8bit:=RESULT_U8BIT; - end; - - function getu16bit: word; - begin - getu16bit:=RESULT_U16BIT; - end; - - function gets32bit: longint; - begin - gets32bit:=RESULT_S32BIT; - end; - - function gets64bit: int64; - begin - gets64bit:=RESULT_S64BIT; - end; - - - function gets32real: single; - begin - gets32real:=RESULT_S32REAL; - end; - - function gets64real: double; - begin - gets64real:=RESULT_S64REAL; - end; - -{ ***************************************************************** } -{ VALUE PARAMETERS } -{ ***************************************************************** } - - procedure proc_value_u8bit(v: byte);pascal; - begin - global_u8bit := v; - end; - - - procedure proc_value_u16bit(v: word);pascal; - begin - global_u16bit := v; - end; - - - procedure proc_value_s32bit(v : longint);pascal; - begin - global_s32bit := v; - end; - - - - - procedure proc_value_bool8bit(v: boolean);pascal; - begin - { boolean should be 8-bit always! } - if sizeof(boolean) <> 1 then RunError(255); - global_u8bit := byte(v); - end; - - - procedure proc_value_bool16bit(v: wordbool);pascal; - begin - global_u16bit := word(v); - end; - - - procedure proc_value_bool32bit(v : longbool);pascal; - begin - global_s32bit := longint(v); - end; - - - procedure proc_value_s32real(v : single);pascal; - begin - global_s32real := v; - end; - - procedure proc_value_s64real(v: double);pascal; - begin - global_s64real:= v; - end; - - - procedure proc_value_pointerdef(p : pchar);pascal; - begin - global_ptr:=p; - end; - - - procedure proc_value_procvardef(p : tprocedure);pascal; - begin - global_proc:=p; - end; - - - - - procedure proc_value_smallrecord(smallrec : tsmallrecord);pascal; - begin - if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_value_largerecord(largerec : tlargerecord);pascal; - begin - if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_value_smallset(smallset : tsmallset);pascal; - begin - if A_D in smallset then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_value_largeset(largeset : tlargeset);pascal; - begin - if 'I' in largeset then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_value_smallstring(s:tsmallstring);pascal; - begin - if s = RESULT_SMALLSTRING then - global_u8bit := RESULT_u8BIT; - end; - - - procedure proc_value_bigstring(s:shortstring);pascal; - begin - if s = RESULT_BIGSTRING then - global_u8bit := RESULT_u8BIT; - end; - - - procedure proc_value_smallarray(arr : tsmallarray);pascal; - begin - if arr[SMALL_INDEX] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_value_smallarray_open(arr : array of byte);pascal; - begin - { form 0 to N-1 indexes in open arrays } - if arr[SMALL_INDEX-1] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - end; - -{$ifndef tp} - procedure proc_value_classrefdef(obj : tclass1);pascal; - begin - global_class:=obj; - end; - - - procedure proc_value_smallarray_const_1(arr : array of const);pascal; - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : global_u8bit := arr[i].vinteger and $ff; - vtBoolean : global_boolean := arr[i].vboolean; - vtChar : global_char := arr[i].vchar; - vtExtended : global_s64real := arr[i].VExtended^; - vtString : global_bigstring := arr[i].VString^; - vtPointer : ; - vtPChar : global_ptr := arr[i].VPchar; - vtObject : ; -{ vtClass : global_class := (arr[i].VClass) as tclass1;} - vtAnsiString : ; - vtInt64 : global_s64bit := arr[i].vInt64^; - else - RunError(255); - end; - end; {endfor} - end; - - - procedure proc_value_smallarray_const_2(arr : array of const);pascal; - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_value_s64bit(v: int64);pascal; - begin - global_s64bit:= v; - end; -{$endif} - - {********************************* MIXED PARAMETERS *************************} - - procedure proc_value_u8bit_mixed(b1 : byte; v: byte; b2: byte);pascal; - begin - global_u8bit := v; - value_u8bit := b2; - end; - - - procedure proc_value_u16bit_mixed(b1: byte; v: word; b2: byte);pascal; - begin - global_u16bit := v; - value_u8bit := b2; - end; - - - procedure proc_value_s32bit_mixed(b1 : byte; v : longint; b2: byte);pascal; - begin - global_s32bit := v; - value_u8bit := b2; - end; - - - - - procedure proc_value_bool8bit_mixed(b1: byte; v: boolean; b2: byte);pascal; - begin - { boolean should be 8-bit always! } - if sizeof(boolean) <> 1 then RunError(255); - global_u8bit := byte(v); - value_u8bit := b2; - end; - - - procedure proc_value_bool16bit_mixed(b1 : byte; v: wordbool; b2: byte);pascal; - begin - global_u16bit := word(v); - value_u8bit := b2; - end; - - - procedure proc_value_bool32bit_mixed(b1 : byte; v : longbool; b2: byte);pascal; - begin - global_s32bit := longint(v); - value_u8bit := b2; - end; - - - procedure proc_value_s32real_mixed(b1: byte; v : single; b2: byte);pascal; - begin - global_s32real := v; - value_u8bit := b2; - end; - - procedure proc_value_s64real_mixed(b1: byte; v: double; b2: byte);pascal; - begin - global_s64real:= v; - value_u8bit := b2; - end; - - - procedure proc_value_pointerdef_mixed(b1: byte; p : pchar; b2: byte);pascal; - begin - global_ptr:=p; - value_u8bit := b2; - end; - - - procedure proc_value_procvardef_mixed(b1: byte; p : tprocedure; b2: byte);pascal; - begin - global_proc:=p; - value_u8bit := b2; - end; - - - - - procedure proc_value_smallrecord_mixed(b1: byte; smallrec : tsmallrecord; b2: byte);pascal; - begin - if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - procedure proc_value_largerecord_mixed(b1: byte; largerec : tlargerecord; b2: byte);pascal; - begin - if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - procedure proc_value_smallset_mixed(b1: byte; smallset : tsmallset; b2: byte);pascal; - begin - if A_D in smallset then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - procedure proc_value_largeset_mixed(b1: byte; largeset : tlargeset; b2: byte);pascal; - begin - if 'I' in largeset then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - procedure proc_value_smallstring_mixed(b1: byte; s:tsmallstring; b2: byte);pascal; - begin - if s = RESULT_SMALLSTRING then - global_u8bit := RESULT_u8BIT; - value_u8bit := b2; - end; - - - procedure proc_value_bigstring_mixed(b1: byte; s:shortstring; b2: byte);pascal; - begin - if s = RESULT_BIGSTRING then - global_u8bit := RESULT_u8BIT; - value_u8bit := b2; - end; - - - procedure proc_value_smallarray_mixed(b1: byte; arr : tsmallarray; b2: byte);pascal; - begin - if arr[SMALL_INDEX] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - procedure proc_value_smallarray_open_mixed(b1: byte; arr : array of byte; b2: byte);pascal; - begin - { form 0 to N-1 indexes in open arrays } - if arr[SMALL_INDEX-1] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - -{$ifndef tp} - procedure proc_value_classrefdef_mixed(b1: byte; obj : tclass1; b2: byte);pascal; - begin - global_class:=obj; - value_u8bit := b2; - end; - - - procedure proc_value_s64bit_mixed(b1 : byte; v: int64; b2: byte);pascal; - begin - global_s64bit:= v; - value_u8bit := b2; - end; - - - procedure proc_value_smallarray_const_1_mixed(b1: byte; arr : array of const; b2: byte);pascal; - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : global_u8bit := arr[i].vinteger and $ff; - vtBoolean : global_boolean := arr[i].vboolean; - vtChar : global_char := arr[i].vchar; - vtExtended : global_s64real := arr[i].VExtended^; - vtString : global_bigstring := arr[i].VString^; - vtPointer : ; - vtPChar : global_ptr := arr[i].VPchar; - vtObject : ; -{ vtClass : global_class := (arr[i].VClass) as tclass1;} - vtAnsiString : ; - vtInt64 : global_s64bit := arr[i].vInt64^; - else - RunError(255); - end; - end; {endfor} - value_u8bit := b2; - end; - - - procedure proc_value_smallarray_const_2_mixed(b1: byte; arr : array of const; b2: byte);pascal; - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; -{$endif} - - - -var - failed: boolean; -Begin - {***************************** NORMAL TESTS *******************************} - clear_globals; - clear_values; - - failed:=false; - - { LOC_REGISTER } - write('Value parameter test (src : LOC_REGISTER)...'); - proc_value_u8bit(getu8bit); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - proc_value_u16bit(getu16bit); - if global_u16bit <> RESULT_U16BIT then - failed:=true; - proc_value_s32bit(gets32bit); - if global_s32bit <> RESULT_S32BIT then - failed:=true; -{$ifndef tp} - proc_value_s64bit(gets64bit); - if global_s64bit <> RESULT_S64BIT then - failed:=true; -{$endif} - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_FPUREGISTER } - clear_globals; - clear_values; - failed:=false; - write('Value parameter test (src : LOC_FPUREGISTER)...'); - proc_value_s32real(gets32real); - if trunc(global_s32real) <> trunc(RESULT_S32REAL) then - failed:=true; - proc_value_s64real(gets64real); - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed:=true; - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_MEM, LOC_REFERENCE orddef } - clear_globals; - clear_values; - value_u8bit := RESULT_U8BIT; - value_u16bit := RESULT_U16BIT; - value_s32bit := RESULT_S32BIT; -{$ifndef tp} - value_s64bit := RESULT_S64BIT; -{$endif} - value_s32real := RESULT_S32REAL; - value_s64real := RESULT_S64REAL; - - failed:=false; - - { LOC_REFERENCE } - write('Value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...'); - proc_value_u8bit(value_u8bit); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - proc_value_u16bit(value_u16bit); - if global_u16bit <> RESULT_U16BIT then - failed:=true; - proc_value_s32bit(value_s32bit); - if global_s32bit <> RESULT_S32BIT then - failed:=true; -{$ifndef tp} - proc_value_s64bit(value_s64bit); - if global_s64bit <> RESULT_S64BIT then - failed:=true; -{$endif} - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_REFERENCE } - clear_globals; - failed:=false; - write('Value parameter test (src : LOC_REFERENCE (floatdef))...'); - proc_value_s32real(value_s32real); - if trunc(global_s32real) <> trunc(RESULT_S32REAL) then - failed:=true; - proc_value_s64real(value_s64real); - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed:=true; - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Value parameter test (src : LOC_REFERENCE (pointer))...'); - clear_globals; - clear_values; - failed:=false; - value_ptr := RESULT_PCHAR; - proc_value_pointerdef(value_ptr); - if global_ptr <> value_ptr then - failed := true; - - - value_proc := {$ifndef tp}@{$endif}testprocedure; - proc_value_procvardef(value_proc); - if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then - failed := true; - -{$ifndef tp} - value_class := tclass1.create; - proc_value_classrefdef(value_class); - if value_class <> global_class then - failed := true; - value_class.destroy; -{$endif} - if failed then - fail - else - WriteLn('Passed!'); - - - - - { LOC_REFERENCE } - clear_globals; - clear_values; - failed:=false; - value_u8bit := 0; - write('Value parameter test (src : LOC_FLAGS (orddef)))...'); - proc_value_bool8bit(value_u8bit = 0); - if global_u8bit <> RESULT_BOOL8BIT then - failed:=true; -{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x - proc_value_bool16bit(value_s64bit < 0); - if global_u16bit <> RESULT_BOOL16BIT then - failed:=true; - proc_value_bool32bit(bool1 and bool2); - if global_s32bit <> RESULT_BOOL32BIT then - failed:=true;*} - if failed then - fail - else - WriteLn('Passed!'); - - - -{$ifndef tp} - clear_globals; - clear_values; - failed:=false; - write('Value parameter test (src : LOC_JUMP (orddef)))...'); - proc_value_bool8bit(value_s64bit = 0); - if global_u8bit <> RESULT_BOOL8BIT then - failed:=true; -{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x - proc_value_bool16bit(value_s64bit < 0); - if global_u16bit <> RESULT_BOOL16BIT then - failed:=true; - proc_value_bool32bit(bool1 and bool2); - if global_s32bit <> RESULT_BOOL32BIT then - failed:=true;*} - if failed then - fail - else - WriteLn('Passed!'); -{$endif} - - { arraydef, - recorddef, - objectdef, - stringdef, - setdef : all considered the same by code generator. - } - write('Value parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallrec.b := RESULT_U8BIT; - value_smallrec.w := RESULT_U16BIT; - proc_value_smallrecord(value_smallrec); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); - proc_value_largerecord(value_largerec); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Value parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallset := [A_A,A_D]; - proc_value_smallset(value_smallset); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_largeset := ['I']; - proc_value_largeset(value_largeset); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - - - write('Value parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - value_smallstring := RESULT_SMALLSTRING; - - proc_value_smallstring(value_smallstring); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_bigstring := RESULT_BIGSTRING; - proc_value_bigstring(value_bigstring); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!} - { DON'T KNOW WHY/HOW TO TEST!!!!! } - - - write('Value parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - fillchar(value_smallarray,sizeof(value_smallarray),#0); - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_value_smallarray(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - fillchar(value_smallarray,sizeof(value_smallarray),#0); - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_value_smallarray_open(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - -{$ifndef tp} - clear_globals; - clear_values; - - value_u8bit := RESULT_U8BIT; - value_ptr := RESULT_PCHAR; - value_s64bit := RESULT_S64BIT; - value_smallstring := RESULT_SMALLSTRING; - value_class := tclass1.create; - value_boolean := RESULT_BOOLEAN; - value_char := RESULT_CHAR; - value_s64real:=RESULT_S64REAL; - proc_value_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real, - value_boolean,value_class]); - - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if global_char <> RESULT_CHAR then - failed := true; - if global_boolean <> RESULT_BOOLEAN then - failed:=true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed := true; - if global_bigstring <> RESULT_SMALLSTRING then - failed := true; - if global_ptr <> value_ptr then - failed := true; -{ if value_class <> global_class then - failed := true;!!!!!!!!!!!!!!!!!!!!} - if global_s64bit <> RESULT_S64BIT then - failed := true; - if assigned(value_class) then - value_class.destroy; - - global_u8bit := 0; - proc_value_smallarray_const_2([]); - if global_u8bit <> RESULT_U8BIT then - failed := true; -{$endif fpc} - - if failed then - fail - else - WriteLn('Passed!'); - - {***************************** MIXED TESTS *******************************} - clear_globals; - clear_values; - - failed:=false; - - { LOC_REGISTER } - write('Mixed value parameter test (src : LOC_REGISTER)...'); - proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),getu8bit,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - proc_value_u16bit_mixed(byte(NOT RESULT_U8BIT),getu16bit,RESULT_U8BIT); - if global_u16bit <> RESULT_U16BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - proc_value_s32bit_mixed(byte(NOT RESULT_U8BIT),gets32bit, RESULT_U8BIT); - if global_s32bit <> RESULT_S32BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$ifndef tp} - proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT),gets64bit,RESULT_U8BIT); - if global_s64bit <> RESULT_S64BIT then - failed:=true; -{$endif} - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_FPUREGISTER } - clear_globals; - clear_values; - failed:=false; - write('Mixed value parameter test (src : LOC_FPUREGISTER)...'); - proc_value_s32real_mixed(byte(NOT RESULT_U8BIT), gets32real, RESULT_U8BIT); - if value_u8bit <> RESULT_U8BIT then - failed := true; - if trunc(global_s32real) <> trunc(RESULT_S32REAL) then - failed:=true; - proc_value_s64real_mixed(byte(NOT RESULT_U8BIT),gets64real,RESULT_U8BIT); - if value_u8bit <> RESULT_U8BIT then - failed := true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed:=true; - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_MEM, LOC_REFERENCE orddef } - clear_globals; - clear_values; - value_u8bit := RESULT_U8BIT; - value_u16bit := RESULT_U16BIT; - value_s32bit := RESULT_S32BIT; -{$ifndef tp} - value_s64bit := RESULT_S64BIT; -{$endif} - value_s32real := RESULT_S32REAL; - value_s64real := RESULT_S64REAL; - - failed:=false; - - { LOC_REFERENCE } - write('Mixed value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...'); - proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),value_u8bit, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - proc_value_u16bit_mixed(byte(NOT RESULT_U8BIT),value_u16bit, RESULT_U8BIT); - if global_u16bit <> RESULT_U16BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - proc_value_s32bit_mixed(byte(NOT RESULT_U8BIT),value_s32bit, RESULT_U8BIT); - if global_s32bit <> RESULT_S32BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$ifndef tp} - proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit, RESULT_U8BIT); - if global_s64bit <> RESULT_S64BIT then - failed:=true; -{$endif} - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_REFERENCE } - clear_globals; - failed:=false; - write('Mixed value parameter test (src : LOC_REFERENCE (floatdef))...'); - proc_value_s32real_mixed(byte(NOT RESULT_U8BIT), value_s32real, RESULT_U8BIT); - if trunc(global_s32real) <> trunc(RESULT_S32REAL) then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - proc_value_s64real_mixed(byte(NOT RESULT_U8BIT), value_s64real, RESULT_U8BIT); - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Mixed value parameter test (src : LOC_REFERENCE (pointer))...'); - clear_globals; - clear_values; - failed:=false; - value_ptr := RESULT_PCHAR; - proc_value_pointerdef_mixed(byte(NOT RESULT_U8BIT), value_ptr, RESULT_U8BIT); - if global_ptr <> value_ptr then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - - value_proc := {$ifndef tp}@{$endif}testprocedure; - proc_value_procvardef_mixed(byte(NOT RESULT_U8BIT), value_proc, RESULT_U8BIT); - if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then - failed := true; - -{$ifndef tp} - value_class := tclass1.create; - proc_value_classrefdef_mixed(byte(NOT RESULT_U8BIT), value_class, RESULT_U8BIT); - if value_class <> global_class then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - value_class.destroy; -{$endif} - if failed then - fail - else - WriteLn('Passed!'); - - - - - { LOC_REFERENCE } - clear_globals; - clear_values; - failed:=false; - value_u8bit := 0; - write('Mixed value parameter test (src : LOC_FLAGS (orddef)))...'); - proc_value_bool8bit_mixed(byte(NOT RESULT_U8BIT), value_u8bit = 0, RESULT_U8BIT); - if global_u8bit <> RESULT_BOOL8BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x - proc_value_bool16bit(value_s64bit < 0); - if global_u16bit <> RESULT_BOOL16BIT then - failed:=true; - proc_value_bool32bit(bool1 and bool2); - if global_s32bit <> RESULT_BOOL32BIT then - failed:=true;*} - if failed then - fail - else - WriteLn('Passed!'); - - - -{$ifndef tp} - clear_globals; - clear_values; - failed:=false; - write('Mixed value parameter test (src : LOC_JUMP (orddef)))...'); - proc_value_bool8bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit = 0, RESULT_U8BIT); - if global_u8bit <> RESULT_BOOL8BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x - proc_value_bool16bit(value_s64bit < 0); - if global_u16bit <> RESULT_BOOL16BIT then - failed:=true; - proc_value_bool32bit(bool1 and bool2); - if global_s32bit <> RESULT_BOOL32BIT then - failed:=true;*} - if failed then - fail - else - WriteLn('Passed!'); -{$endif} - - { arraydef, - recorddef, - objectdef, - stringdef, - setdef : all considered the same by code generator. - } - write('Mixed value parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallrec.b := RESULT_U8BIT; - value_smallrec.w := RESULT_U16BIT; - proc_value_smallrecord_mixed(byte(NOT RESULT_U8BIT), value_smallrec, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); - proc_value_largerecord_mixed(byte(NOT RESULT_U8BIT), value_largerec, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Mixed value parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallset := [A_A,A_D]; - proc_value_smallset_mixed(byte(NOT RESULT_U8BIT), value_smallset, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_largeset := ['I']; - proc_value_largeset_mixed(byte(NOT RESULT_U8BIT), value_largeset, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - - - write('Mixed value parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - value_smallstring := RESULT_SMALLSTRING; - - proc_value_smallstring_mixed(byte(NOT RESULT_U8BIT), value_smallstring, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_bigstring := RESULT_BIGSTRING; - proc_value_bigstring_mixed(byte(NOT RESULT_U8BIT), value_bigstring, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!} - { DON'T KNOW WHY/HOW TO TEST!!!!! } - - - write('Mixed value parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - fillchar(value_smallarray,sizeof(value_smallarray),#0); - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_value_smallarray_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - fillchar(value_smallarray,sizeof(value_smallarray),#0); - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_value_smallarray_open_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - -{$ifndef tp} - clear_globals; - clear_values; - - value_u8bit := RESULT_U8BIT; - value_ptr := RESULT_PCHAR; - value_s64bit := RESULT_S64BIT; - value_smallstring := RESULT_SMALLSTRING; - value_class := tclass1.create; - value_boolean := RESULT_BOOLEAN; - value_char := RESULT_CHAR; - value_s64real:=RESULT_S64REAL; - proc_value_smallarray_const_1_mixed(byte(NOT RESULT_U8BIT), [value_u8bit,value_ptr,value_s64bit,value_char, - value_smallstring,value_s64real,value_boolean,value_class], - RESULT_U8BIT); - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if global_char <> RESULT_CHAR then - failed := true; - if global_boolean <> RESULT_BOOLEAN then - failed:=true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed := true; - if global_bigstring <> RESULT_SMALLSTRING then - failed := true; - if global_ptr <> value_ptr then - failed := true; -{ if value_class <> global_class then - failed := true;!!!!!!!!!!!!!!!!!!!!} - if global_s64bit <> RESULT_S64BIT then - failed := true; - if assigned(value_class) then - value_class.destroy; - - global_u8bit := 0; - proc_value_smallarray_const_2_mixed(byte(NOT RESULT_U8BIT), [], RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$endif} - - 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 } +{ (value parameters with pascal calling convention) } +{****************************************************************} +program tcalval3; + +{$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_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; +{$ifndef tp} + global_s64bit := 0; + global_class := nil; +{$endif} + 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; +{$ifndef tp} + value_s64bit := 0; + value_class := nil; +{$endif} + end; + + + procedure testprocedure; + begin + end; + + function getu8bit : byte; + begin + getu8bit:=RESULT_U8BIT; + end; + + function getu16bit: word; + begin + getu16bit:=RESULT_U16BIT; + end; + + function gets32bit: longint; + begin + gets32bit:=RESULT_S32BIT; + end; + + function gets64bit: int64; + begin + gets64bit:=RESULT_S64BIT; + end; + + + function gets32real: single; + begin + gets32real:=RESULT_S32REAL; + end; + + function gets64real: double; + begin + gets64real:=RESULT_S64REAL; + end; + +{ ***************************************************************** } +{ VALUE PARAMETERS } +{ ***************************************************************** } + + procedure proc_value_u8bit(v: byte);pascal; + begin + global_u8bit := v; + end; + + + procedure proc_value_u16bit(v: word);pascal; + begin + global_u16bit := v; + end; + + + procedure proc_value_s32bit(v : longint);pascal; + begin + global_s32bit := v; + end; + + + + + procedure proc_value_bool8bit(v: boolean);pascal; + begin + { boolean should be 8-bit always! } + if sizeof(boolean) <> 1 then RunError(255); + global_u8bit := byte(v); + end; + + + procedure proc_value_bool16bit(v: wordbool);pascal; + begin + global_u16bit := word(v); + end; + + + procedure proc_value_bool32bit(v : longbool);pascal; + begin + global_s32bit := longint(v); + end; + + + procedure proc_value_s32real(v : single);pascal; + begin + global_s32real := v; + end; + + procedure proc_value_s64real(v: double);pascal; + begin + global_s64real:= v; + end; + + + procedure proc_value_pointerdef(p : pchar);pascal; + begin + global_ptr:=p; + end; + + + procedure proc_value_procvardef(p : tprocedure);pascal; + begin + global_proc:=p; + end; + + + + + procedure proc_value_smallrecord(smallrec : tsmallrecord);pascal; + begin + if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_value_largerecord(largerec : tlargerecord);pascal; + begin + if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_value_smallset(smallset : tsmallset);pascal; + begin + if A_D in smallset then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_value_largeset(largeset : tlargeset);pascal; + begin + if 'I' in largeset then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_value_smallstring(s:tsmallstring);pascal; + begin + if s = RESULT_SMALLSTRING then + global_u8bit := RESULT_u8BIT; + end; + + + procedure proc_value_bigstring(s:shortstring);pascal; + begin + if s = RESULT_BIGSTRING then + global_u8bit := RESULT_u8BIT; + end; + + + procedure proc_value_smallarray(arr : tsmallarray);pascal; + begin + if arr[SMALL_INDEX] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_value_smallarray_open(arr : array of byte);pascal; + begin + { form 0 to N-1 indexes in open arrays } + if arr[SMALL_INDEX-1] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + end; + +{$ifndef tp} + procedure proc_value_classrefdef(obj : tclass1);pascal; + begin + global_class:=obj; + end; + + + procedure proc_value_smallarray_const_1(arr : array of const);pascal; + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : global_u8bit := arr[i].vinteger and $ff; + vtBoolean : global_boolean := arr[i].vboolean; + vtChar : global_char := arr[i].vchar; + vtExtended : global_s64real := arr[i].VExtended^; + vtString : global_bigstring := arr[i].VString^; + vtPointer : ; + vtPChar : global_ptr := arr[i].VPchar; + vtObject : ; +{ vtClass : global_class := (arr[i].VClass) as tclass1;} + vtAnsiString : ; + vtInt64 : global_s64bit := arr[i].vInt64^; + else + RunError(255); + end; + end; {endfor} + end; + + + procedure proc_value_smallarray_const_2(arr : array of const);pascal; + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_value_s64bit(v: int64);pascal; + begin + global_s64bit:= v; + end; +{$endif} + + {********************************* MIXED PARAMETERS *************************} + + procedure proc_value_u8bit_mixed(b1 : byte; v: byte; b2: byte);pascal; + begin + global_u8bit := v; + value_u8bit := b2; + end; + + + procedure proc_value_u16bit_mixed(b1: byte; v: word; b2: byte);pascal; + begin + global_u16bit := v; + value_u8bit := b2; + end; + + + procedure proc_value_s32bit_mixed(b1 : byte; v : longint; b2: byte);pascal; + begin + global_s32bit := v; + value_u8bit := b2; + end; + + + + + procedure proc_value_bool8bit_mixed(b1: byte; v: boolean; b2: byte);pascal; + begin + { boolean should be 8-bit always! } + if sizeof(boolean) <> 1 then RunError(255); + global_u8bit := byte(v); + value_u8bit := b2; + end; + + + procedure proc_value_bool16bit_mixed(b1 : byte; v: wordbool; b2: byte);pascal; + begin + global_u16bit := word(v); + value_u8bit := b2; + end; + + + procedure proc_value_bool32bit_mixed(b1 : byte; v : longbool; b2: byte);pascal; + begin + global_s32bit := longint(v); + value_u8bit := b2; + end; + + + procedure proc_value_s32real_mixed(b1: byte; v : single; b2: byte);pascal; + begin + global_s32real := v; + value_u8bit := b2; + end; + + procedure proc_value_s64real_mixed(b1: byte; v: double; b2: byte);pascal; + begin + global_s64real:= v; + value_u8bit := b2; + end; + + + procedure proc_value_pointerdef_mixed(b1: byte; p : pchar; b2: byte);pascal; + begin + global_ptr:=p; + value_u8bit := b2; + end; + + + procedure proc_value_procvardef_mixed(b1: byte; p : tprocedure; b2: byte);pascal; + begin + global_proc:=p; + value_u8bit := b2; + end; + + + + + procedure proc_value_smallrecord_mixed(b1: byte; smallrec : tsmallrecord; b2: byte);pascal; + begin + if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + procedure proc_value_largerecord_mixed(b1: byte; largerec : tlargerecord; b2: byte);pascal; + begin + if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + procedure proc_value_smallset_mixed(b1: byte; smallset : tsmallset; b2: byte);pascal; + begin + if A_D in smallset then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + procedure proc_value_largeset_mixed(b1: byte; largeset : tlargeset; b2: byte);pascal; + begin + if 'I' in largeset then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + procedure proc_value_smallstring_mixed(b1: byte; s:tsmallstring; b2: byte);pascal; + begin + if s = RESULT_SMALLSTRING then + global_u8bit := RESULT_u8BIT; + value_u8bit := b2; + end; + + + procedure proc_value_bigstring_mixed(b1: byte; s:shortstring; b2: byte);pascal; + begin + if s = RESULT_BIGSTRING then + global_u8bit := RESULT_u8BIT; + value_u8bit := b2; + end; + + + procedure proc_value_smallarray_mixed(b1: byte; arr : tsmallarray; b2: byte);pascal; + begin + if arr[SMALL_INDEX] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + procedure proc_value_smallarray_open_mixed(b1: byte; arr : array of byte; b2: byte);pascal; + begin + { form 0 to N-1 indexes in open arrays } + if arr[SMALL_INDEX-1] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + +{$ifndef tp} + procedure proc_value_classrefdef_mixed(b1: byte; obj : tclass1; b2: byte);pascal; + begin + global_class:=obj; + value_u8bit := b2; + end; + + + procedure proc_value_s64bit_mixed(b1 : byte; v: int64; b2: byte);pascal; + begin + global_s64bit:= v; + value_u8bit := b2; + end; + + + procedure proc_value_smallarray_const_1_mixed(b1: byte; arr : array of const; b2: byte);pascal; + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : global_u8bit := arr[i].vinteger and $ff; + vtBoolean : global_boolean := arr[i].vboolean; + vtChar : global_char := arr[i].vchar; + vtExtended : global_s64real := arr[i].VExtended^; + vtString : global_bigstring := arr[i].VString^; + vtPointer : ; + vtPChar : global_ptr := arr[i].VPchar; + vtObject : ; +{ vtClass : global_class := (arr[i].VClass) as tclass1;} + vtAnsiString : ; + vtInt64 : global_s64bit := arr[i].vInt64^; + else + RunError(255); + end; + end; {endfor} + value_u8bit := b2; + end; + + + procedure proc_value_smallarray_const_2_mixed(b1: byte; arr : array of const; b2: byte);pascal; + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; +{$endif} + + + +var + failed: boolean; +Begin + {***************************** NORMAL TESTS *******************************} + clear_globals; + clear_values; + + failed:=false; + + { LOC_REGISTER } + write('Value parameter test (src : LOC_REGISTER)...'); + proc_value_u8bit(getu8bit); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + proc_value_u16bit(getu16bit); + if global_u16bit <> RESULT_U16BIT then + failed:=true; + proc_value_s32bit(gets32bit); + if global_s32bit <> RESULT_S32BIT then + failed:=true; +{$ifndef tp} + proc_value_s64bit(gets64bit); + if global_s64bit <> RESULT_S64BIT then + failed:=true; +{$endif} + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_FPUREGISTER } + clear_globals; + clear_values; + failed:=false; + write('Value parameter test (src : LOC_FPUREGISTER)...'); + proc_value_s32real(gets32real); + if trunc(global_s32real) <> trunc(RESULT_S32REAL) then + failed:=true; + proc_value_s64real(gets64real); + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed:=true; + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_MEM, LOC_REFERENCE orddef } + clear_globals; + clear_values; + value_u8bit := RESULT_U8BIT; + value_u16bit := RESULT_U16BIT; + value_s32bit := RESULT_S32BIT; +{$ifndef tp} + value_s64bit := RESULT_S64BIT; +{$endif} + value_s32real := RESULT_S32REAL; + value_s64real := RESULT_S64REAL; + + failed:=false; + + { LOC_REFERENCE } + write('Value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...'); + proc_value_u8bit(value_u8bit); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + proc_value_u16bit(value_u16bit); + if global_u16bit <> RESULT_U16BIT then + failed:=true; + proc_value_s32bit(value_s32bit); + if global_s32bit <> RESULT_S32BIT then + failed:=true; +{$ifndef tp} + proc_value_s64bit(value_s64bit); + if global_s64bit <> RESULT_S64BIT then + failed:=true; +{$endif} + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_REFERENCE } + clear_globals; + failed:=false; + write('Value parameter test (src : LOC_REFERENCE (floatdef))...'); + proc_value_s32real(value_s32real); + if trunc(global_s32real) <> trunc(RESULT_S32REAL) then + failed:=true; + proc_value_s64real(value_s64real); + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed:=true; + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Value parameter test (src : LOC_REFERENCE (pointer))...'); + clear_globals; + clear_values; + failed:=false; + value_ptr := RESULT_PCHAR; + proc_value_pointerdef(value_ptr); + if global_ptr <> value_ptr then + failed := true; + + + value_proc := {$ifndef tp}@{$endif}testprocedure; + proc_value_procvardef(value_proc); + if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then + failed := true; + +{$ifndef tp} + value_class := tclass1.create; + proc_value_classrefdef(value_class); + if value_class <> global_class then + failed := true; + value_class.destroy; +{$endif} + if failed then + fail + else + WriteLn('Passed!'); + + + + + { LOC_REFERENCE } + clear_globals; + clear_values; + failed:=false; + value_u8bit := 0; + write('Value parameter test (src : LOC_FLAGS (orddef)))...'); + proc_value_bool8bit(value_u8bit = 0); + if global_u8bit <> RESULT_BOOL8BIT then + failed:=true; +{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x + proc_value_bool16bit(value_s64bit < 0); + if global_u16bit <> RESULT_BOOL16BIT then + failed:=true; + proc_value_bool32bit(bool1 and bool2); + if global_s32bit <> RESULT_BOOL32BIT then + failed:=true;*} + if failed then + fail + else + WriteLn('Passed!'); + + + +{$ifndef tp} + clear_globals; + clear_values; + failed:=false; + write('Value parameter test (src : LOC_JUMP (orddef)))...'); + proc_value_bool8bit(value_s64bit = 0); + if global_u8bit <> RESULT_BOOL8BIT then + failed:=true; +{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x + proc_value_bool16bit(value_s64bit < 0); + if global_u16bit <> RESULT_BOOL16BIT then + failed:=true; + proc_value_bool32bit(bool1 and bool2); + if global_s32bit <> RESULT_BOOL32BIT then + failed:=true;*} + if failed then + fail + else + WriteLn('Passed!'); +{$endif} + + { arraydef, + recorddef, + objectdef, + stringdef, + setdef : all considered the same by code generator. + } + write('Value parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallrec.b := RESULT_U8BIT; + value_smallrec.w := RESULT_U16BIT; + proc_value_smallrecord(value_smallrec); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); + proc_value_largerecord(value_largerec); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Value parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallset := [A_A,A_D]; + proc_value_smallset(value_smallset); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_largeset := ['I']; + proc_value_largeset(value_largeset); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + + + write('Value parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + value_smallstring := RESULT_SMALLSTRING; + + proc_value_smallstring(value_smallstring); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_bigstring := RESULT_BIGSTRING; + proc_value_bigstring(value_bigstring); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!} + { DON'T KNOW WHY/HOW TO TEST!!!!! } + + + write('Value parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + fillchar(value_smallarray,sizeof(value_smallarray),#0); + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_value_smallarray(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + fillchar(value_smallarray,sizeof(value_smallarray),#0); + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_value_smallarray_open(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + +{$ifndef tp} + clear_globals; + clear_values; + + value_u8bit := RESULT_U8BIT; + value_ptr := RESULT_PCHAR; + value_s64bit := RESULT_S64BIT; + value_smallstring := RESULT_SMALLSTRING; + value_class := tclass1.create; + value_boolean := RESULT_BOOLEAN; + value_char := RESULT_CHAR; + value_s64real:=RESULT_S64REAL; + proc_value_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real, + value_boolean,value_class]); + + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if global_char <> RESULT_CHAR then + failed := true; + if global_boolean <> RESULT_BOOLEAN then + failed:=true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed := true; + if global_bigstring <> RESULT_SMALLSTRING then + failed := true; + if global_ptr <> value_ptr then + failed := true; +{ if value_class <> global_class then + failed := true;!!!!!!!!!!!!!!!!!!!!} + if global_s64bit <> RESULT_S64BIT then + failed := true; + if assigned(value_class) then + value_class.destroy; + + global_u8bit := 0; + proc_value_smallarray_const_2([]); + if global_u8bit <> RESULT_U8BIT then + failed := true; +{$endif fpc} + + if failed then + fail + else + WriteLn('Passed!'); + + {***************************** MIXED TESTS *******************************} + clear_globals; + clear_values; + + failed:=false; + + { LOC_REGISTER } + write('Mixed value parameter test (src : LOC_REGISTER)...'); + proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),getu8bit,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + proc_value_u16bit_mixed(byte(NOT RESULT_U8BIT),getu16bit,RESULT_U8BIT); + if global_u16bit <> RESULT_U16BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + proc_value_s32bit_mixed(byte(NOT RESULT_U8BIT),gets32bit, RESULT_U8BIT); + if global_s32bit <> RESULT_S32BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$ifndef tp} + proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT),gets64bit,RESULT_U8BIT); + if global_s64bit <> RESULT_S64BIT then + failed:=true; +{$endif} + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_FPUREGISTER } + clear_globals; + clear_values; + failed:=false; + write('Mixed value parameter test (src : LOC_FPUREGISTER)...'); + proc_value_s32real_mixed(byte(NOT RESULT_U8BIT), gets32real, RESULT_U8BIT); + if value_u8bit <> RESULT_U8BIT then + failed := true; + if trunc(global_s32real) <> trunc(RESULT_S32REAL) then + failed:=true; + proc_value_s64real_mixed(byte(NOT RESULT_U8BIT),gets64real,RESULT_U8BIT); + if value_u8bit <> RESULT_U8BIT then + failed := true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed:=true; + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_MEM, LOC_REFERENCE orddef } + clear_globals; + clear_values; + value_u8bit := RESULT_U8BIT; + value_u16bit := RESULT_U16BIT; + value_s32bit := RESULT_S32BIT; +{$ifndef tp} + value_s64bit := RESULT_S64BIT; +{$endif} + value_s32real := RESULT_S32REAL; + value_s64real := RESULT_S64REAL; + + failed:=false; + + { LOC_REFERENCE } + write('Mixed value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...'); + proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),value_u8bit, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + proc_value_u16bit_mixed(byte(NOT RESULT_U8BIT),value_u16bit, RESULT_U8BIT); + if global_u16bit <> RESULT_U16BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + proc_value_s32bit_mixed(byte(NOT RESULT_U8BIT),value_s32bit, RESULT_U8BIT); + if global_s32bit <> RESULT_S32BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$ifndef tp} + proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit, RESULT_U8BIT); + if global_s64bit <> RESULT_S64BIT then + failed:=true; +{$endif} + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_REFERENCE } + clear_globals; + failed:=false; + write('Mixed value parameter test (src : LOC_REFERENCE (floatdef))...'); + proc_value_s32real_mixed(byte(NOT RESULT_U8BIT), value_s32real, RESULT_U8BIT); + if trunc(global_s32real) <> trunc(RESULT_S32REAL) then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + proc_value_s64real_mixed(byte(NOT RESULT_U8BIT), value_s64real, RESULT_U8BIT); + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Mixed value parameter test (src : LOC_REFERENCE (pointer))...'); + clear_globals; + clear_values; + failed:=false; + value_ptr := RESULT_PCHAR; + proc_value_pointerdef_mixed(byte(NOT RESULT_U8BIT), value_ptr, RESULT_U8BIT); + if global_ptr <> value_ptr then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + + value_proc := {$ifndef tp}@{$endif}testprocedure; + proc_value_procvardef_mixed(byte(NOT RESULT_U8BIT), value_proc, RESULT_U8BIT); + if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then + failed := true; + +{$ifndef tp} + value_class := tclass1.create; + proc_value_classrefdef_mixed(byte(NOT RESULT_U8BIT), value_class, RESULT_U8BIT); + if value_class <> global_class then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + value_class.destroy; +{$endif} + if failed then + fail + else + WriteLn('Passed!'); + + + + + { LOC_REFERENCE } + clear_globals; + clear_values; + failed:=false; + value_u8bit := 0; + write('Mixed value parameter test (src : LOC_FLAGS (orddef)))...'); + proc_value_bool8bit_mixed(byte(NOT RESULT_U8BIT), value_u8bit = 0, RESULT_U8BIT); + if global_u8bit <> RESULT_BOOL8BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x + proc_value_bool16bit(value_s64bit < 0); + if global_u16bit <> RESULT_BOOL16BIT then + failed:=true; + proc_value_bool32bit(bool1 and bool2); + if global_s32bit <> RESULT_BOOL32BIT then + failed:=true;*} + if failed then + fail + else + WriteLn('Passed!'); + + + +{$ifndef tp} + clear_globals; + clear_values; + failed:=false; + write('Mixed value parameter test (src : LOC_JUMP (orddef)))...'); + proc_value_bool8bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit = 0, RESULT_U8BIT); + if global_u8bit <> RESULT_BOOL8BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x + proc_value_bool16bit(value_s64bit < 0); + if global_u16bit <> RESULT_BOOL16BIT then + failed:=true; + proc_value_bool32bit(bool1 and bool2); + if global_s32bit <> RESULT_BOOL32BIT then + failed:=true;*} + if failed then + fail + else + WriteLn('Passed!'); +{$endif} + + { arraydef, + recorddef, + objectdef, + stringdef, + setdef : all considered the same by code generator. + } + write('Mixed value parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallrec.b := RESULT_U8BIT; + value_smallrec.w := RESULT_U16BIT; + proc_value_smallrecord_mixed(byte(NOT RESULT_U8BIT), value_smallrec, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); + proc_value_largerecord_mixed(byte(NOT RESULT_U8BIT), value_largerec, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Mixed value parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallset := [A_A,A_D]; + proc_value_smallset_mixed(byte(NOT RESULT_U8BIT), value_smallset, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_largeset := ['I']; + proc_value_largeset_mixed(byte(NOT RESULT_U8BIT), value_largeset, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + + + write('Mixed value parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + value_smallstring := RESULT_SMALLSTRING; + + proc_value_smallstring_mixed(byte(NOT RESULT_U8BIT), value_smallstring, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_bigstring := RESULT_BIGSTRING; + proc_value_bigstring_mixed(byte(NOT RESULT_U8BIT), value_bigstring, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!} + { DON'T KNOW WHY/HOW TO TEST!!!!! } + + + write('Mixed value parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + fillchar(value_smallarray,sizeof(value_smallarray),#0); + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_value_smallarray_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + fillchar(value_smallarray,sizeof(value_smallarray),#0); + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_value_smallarray_open_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + +{$ifndef tp} + clear_globals; + clear_values; + + value_u8bit := RESULT_U8BIT; + value_ptr := RESULT_PCHAR; + value_s64bit := RESULT_S64BIT; + value_smallstring := RESULT_SMALLSTRING; + value_class := tclass1.create; + value_boolean := RESULT_BOOLEAN; + value_char := RESULT_CHAR; + value_s64real:=RESULT_S64REAL; + proc_value_smallarray_const_1_mixed(byte(NOT RESULT_U8BIT), [value_u8bit,value_ptr,value_s64bit,value_char, + value_smallstring,value_s64real,value_boolean,value_class], + RESULT_U8BIT); + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if global_char <> RESULT_CHAR then + failed := true; + if global_boolean <> RESULT_BOOLEAN then + failed:=true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed := true; + if global_bigstring <> RESULT_SMALLSTRING then + failed := true; + if global_ptr <> value_ptr then + failed := true; +{ if value_class <> global_class then + failed := true;!!!!!!!!!!!!!!!!!!!!} + if global_s64bit <> RESULT_S64BIT then + failed := true; + if assigned(value_class) then + value_class.destroy; + + global_u8bit := 0; + proc_value_smallarray_const_2_mixed(byte(NOT RESULT_U8BIT), [], RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$endif} + + if failed then + fail + else + WriteLn('Passed!'); + +end. + + +{ $Log$ - Revision 1.4 2002-09-22 09:08:41 carl - * gets64bit was not returning an int64! - - Revision 1.3 2002/09/07 15:40:55 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:49:45 carl - + value parameter passing for different calling conventions - - Revision 1.1 2002/04/10 16:33:18 carl - + first tries at first calln testing - -} + Revision 1.5 2003-04-22 10:24:29 florian + * fixed defines for powerpc + + Revision 1.4 2002/09/22 09:08:41 carl + * gets64bit was not returning an int64! + + Revision 1.3 2002/09/07 15:40:55 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:49:45 carl + + value parameter passing for different calling conventions + + Revision 1.1 2002/04/10 16:33:18 carl + + first tries at first calln testing + +} diff --git a/tests/test/cg/tcalval4.pp b/tests/test/cg/tcalval4.pp index c3a1a5d615..53d38121e1 100644 --- a/tests/test/cg/tcalval4.pp +++ b/tests/test/cg/tcalval4.pp @@ -1,1157 +1,1159 @@ -{****************************************************************} -{ 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 } -{ (value parameters with cdecl calling convention) } -{****************************************************************} -program tcalval4; - -{$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; - {$endif} - {$ifdef cpui386} - 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_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; -{$ifndef tp} - global_s64bit := 0; - global_class := nil; -{$endif} - 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; -{$ifndef tp} - value_s64bit := 0; - value_class := nil; -{$endif} - end; - - - procedure testprocedure; - begin - end; - - function getu8bit : byte; - begin - getu8bit:=RESULT_U8BIT; - end; - - function getu16bit: word; - begin - getu16bit:=RESULT_U16BIT; - end; - - function gets32bit: longint; - begin - gets32bit:=RESULT_S32BIT; - end; - - function gets64bit: int64; - begin - gets64bit:=RESULT_S64BIT; - end; - - - function gets32real: single; - begin - gets32real:=RESULT_S32REAL; - end; - - function gets64real: double; - begin - gets64real:=RESULT_S64REAL; - end; - -{ ***************************************************************** } -{ VALUE PARAMETERS } -{ ***************************************************************** } - - procedure proc_value_u8bit(v: byte);cdecl; - begin - global_u8bit := v; - end; - - - procedure proc_value_u16bit(v: word);cdecl; - begin - global_u16bit := v; - end; - - - procedure proc_value_s32bit(v : longint);cdecl; - begin - global_s32bit := v; - end; - - - - - procedure proc_value_bool8bit(v: boolean);cdecl; - begin - { boolean should be 8-bit always! } - if sizeof(boolean) <> 1 then RunError(255); - global_u8bit := byte(v); - end; - - - procedure proc_value_bool16bit(v: wordbool);cdecl; - begin - global_u16bit := word(v); - end; - - - procedure proc_value_bool32bit(v : longbool);cdecl; - begin - global_s32bit := longint(v); - end; - - - procedure proc_value_s32real(v : single);cdecl; - begin - global_s32real := v; - end; - - procedure proc_value_s64real(v: double);cdecl; - begin - global_s64real:= v; - end; - - - procedure proc_value_pointerdef(p : pchar);cdecl; - begin - global_ptr:=p; - end; - - - procedure proc_value_procvardef(p : tprocedure);cdecl; - begin - global_proc:=p; - end; - - - - - procedure proc_value_smallrecord(smallrec : tsmallrecord);cdecl; - begin - if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_value_largerecord(largerec : tlargerecord);cdecl; - begin - if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_value_smallset(smallset : tsmallset);cdecl; - begin - if A_D in smallset then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_value_largeset(largeset : tlargeset);cdecl; - begin - if 'I' in largeset then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_value_smallstring(s:tsmallstring);cdecl; - begin - if s = RESULT_SMALLSTRING then - global_u8bit := RESULT_u8BIT; - end; - - - procedure proc_value_bigstring(s:shortstring);cdecl; - begin - if s = RESULT_BIGSTRING then - global_u8bit := RESULT_u8BIT; - end; - - - procedure proc_value_smallarray(arr : tsmallarray);cdecl; - begin - if arr[SMALL_INDEX] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_value_smallarray_open(arr : array of byte);cdecl; - begin - { form 0 to N-1 indexes in open arrays } - if arr[SMALL_INDEX-1] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - end; - -{$ifndef tp} - procedure proc_value_classrefdef(obj : tclass1);cdecl; - begin - global_class:=obj; - end; - - - procedure proc_value_s64bit(v: int64);cdecl; - begin - global_s64bit:= v; - end; -{$endif} - - {********************************* MIXED PARAMETERS *************************} - - procedure proc_value_u8bit_mixed(b1 : byte; v: byte; b2: byte);cdecl; - begin - global_u8bit := v; - value_u8bit := b2; - end; - - - procedure proc_value_u16bit_mixed(b1: byte; v: word; b2: byte);cdecl; - begin - global_u16bit := v; - value_u8bit := b2; - end; - - - procedure proc_value_s32bit_mixed(b1 : byte; v : longint; b2: byte);cdecl; - begin - global_s32bit := v; - value_u8bit := b2; - end; - - - - - procedure proc_value_bool8bit_mixed(b1: byte; v: boolean; b2: byte);cdecl; - begin - { boolean should be 8-bit always! } - if sizeof(boolean) <> 1 then RunError(255); - global_u8bit := byte(v); - value_u8bit := b2; - end; - - - procedure proc_value_bool16bit_mixed(b1 : byte; v: wordbool; b2: byte);cdecl; - begin - global_u16bit := word(v); - value_u8bit := b2; - end; - - - procedure proc_value_bool32bit_mixed(b1 : byte; v : longbool; b2: byte);cdecl; - begin - global_s32bit := longint(v); - value_u8bit := b2; - end; - - - procedure proc_value_s32real_mixed(b1: byte; v : single; b2: byte);cdecl; - begin - global_s32real := v; - value_u8bit := b2; - end; - - procedure proc_value_s64real_mixed(b1: byte; v: double; b2: byte);cdecl; - begin - global_s64real:= v; - value_u8bit := b2; - end; - - - procedure proc_value_pointerdef_mixed(b1: byte; p : pchar; b2: byte);cdecl; - begin - global_ptr:=p; - value_u8bit := b2; - end; - - - procedure proc_value_procvardef_mixed(b1: byte; p : tprocedure; b2: byte);cdecl; - begin - global_proc:=p; - value_u8bit := b2; - end; - - - - - procedure proc_value_smallrecord_mixed(b1: byte; smallrec : tsmallrecord; b2: byte);cdecl; - begin - if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - procedure proc_value_largerecord_mixed(b1: byte; largerec : tlargerecord; b2: byte);cdecl; - begin - if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - procedure proc_value_smallset_mixed(b1: byte; smallset : tsmallset; b2: byte);cdecl; - begin - if A_D in smallset then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - procedure proc_value_largeset_mixed(b1: byte; largeset : tlargeset; b2: byte);cdecl; - begin - if 'I' in largeset then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - procedure proc_value_smallstring_mixed(b1: byte; s:tsmallstring; b2: byte);cdecl; - begin - if s = RESULT_SMALLSTRING then - global_u8bit := RESULT_u8BIT; - value_u8bit := b2; - end; - - - procedure proc_value_bigstring_mixed(b1: byte; s:shortstring; b2: byte);cdecl; - begin - if s = RESULT_BIGSTRING then - global_u8bit := RESULT_u8BIT; - value_u8bit := b2; - end; - - - procedure proc_value_smallarray_mixed(b1: byte; arr : tsmallarray; b2: byte);cdecl; - begin - if arr[SMALL_INDEX] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - procedure proc_value_smallarray_open_mixed(b1: byte; arr : array of byte; b2: byte);cdecl; - begin - { form 0 to N-1 indexes in open arrays } - if arr[SMALL_INDEX-1] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - -{$ifndef tp} - procedure proc_value_classrefdef_mixed(b1: byte; obj : tclass1; b2: byte);cdecl; - begin - global_class:=obj; - value_u8bit := b2; - end; - - - procedure proc_value_s64bit_mixed(b1 : byte; v: int64; b2: byte);cdecl; - begin - global_s64bit:= v; - value_u8bit := b2; - end; - - -{$endif} - - - -var - failed: boolean; -Begin - {***************************** NORMAL TESTS *******************************} - clear_globals; - clear_values; - - failed:=false; - - { LOC_REGISTER } - write('Value parameter test (src : LOC_REGISTER)...'); - proc_value_u8bit(getu8bit); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - proc_value_u16bit(getu16bit); - if global_u16bit <> RESULT_U16BIT then - failed:=true; - proc_value_s32bit(gets32bit); - if global_s32bit <> RESULT_S32BIT then - failed:=true; -{$ifndef tp} - proc_value_s64bit(gets64bit); - if global_s64bit <> RESULT_S64BIT then - failed:=true; -{$endif} - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_FPUREGISTER } - clear_globals; - clear_values; - failed:=false; - write('Value parameter test (src : LOC_FPUREGISTER)...'); - proc_value_s32real(gets32real); - if trunc(global_s32real) <> trunc(RESULT_S32REAL) then - failed:=true; - proc_value_s64real(gets64real); - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed:=true; - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_MEM, LOC_REFERENCE orddef } - clear_globals; - clear_values; - value_u8bit := RESULT_U8BIT; - value_u16bit := RESULT_U16BIT; - value_s32bit := RESULT_S32BIT; -{$ifndef tp} - value_s64bit := RESULT_S64BIT; -{$endif} - value_s32real := RESULT_S32REAL; - value_s64real := RESULT_S64REAL; - - failed:=false; - - { LOC_REFERENCE } - write('Value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...'); - proc_value_u8bit(value_u8bit); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - proc_value_u16bit(value_u16bit); - if global_u16bit <> RESULT_U16BIT then - failed:=true; - proc_value_s32bit(value_s32bit); - if global_s32bit <> RESULT_S32BIT then - failed:=true; -{$ifndef tp} - proc_value_s64bit(value_s64bit); - if global_s64bit <> RESULT_S64BIT then - failed:=true; -{$endif} - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_REFERENCE } - clear_globals; - failed:=false; - write('Value parameter test (src : LOC_REFERENCE (floatdef))...'); - proc_value_s32real(value_s32real); - if trunc(global_s32real) <> trunc(RESULT_S32REAL) then - failed:=true; - proc_value_s64real(value_s64real); - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed:=true; - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Value parameter test (src : LOC_REFERENCE (pointer))...'); - clear_globals; - clear_values; - failed:=false; - value_ptr := RESULT_PCHAR; - proc_value_pointerdef(value_ptr); - if global_ptr <> value_ptr then - failed := true; - - - value_proc := {$ifndef tp}@{$endif}testprocedure; - proc_value_procvardef(value_proc); - if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then - failed := true; - -{$ifndef tp} - value_class := tclass1.create; - proc_value_classrefdef(value_class); - if value_class <> global_class then - failed := true; - value_class.destroy; -{$endif} - if failed then - fail - else - WriteLn('Passed!'); - - - - - { LOC_REFERENCE } - clear_globals; - clear_values; - failed:=false; - value_u8bit := 0; - write('Value parameter test (src : LOC_FLAGS (orddef)))...'); - proc_value_bool8bit(value_u8bit = 0); - if global_u8bit <> RESULT_BOOL8BIT then - failed:=true; -{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x - proc_value_bool16bit(value_s64bit < 0); - if global_u16bit <> RESULT_BOOL16BIT then - failed:=true; - proc_value_bool32bit(bool1 and bool2); - if global_s32bit <> RESULT_BOOL32BIT then - failed:=true;*} - if failed then - fail - else - WriteLn('Passed!'); - - - -{$ifndef tp} - clear_globals; - clear_values; - failed:=false; - write('Value parameter test (src : LOC_JUMP (orddef)))...'); - proc_value_bool8bit(value_s64bit = 0); - if global_u8bit <> RESULT_BOOL8BIT then - failed:=true; -{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x - proc_value_bool16bit(value_s64bit < 0); - if global_u16bit <> RESULT_BOOL16BIT then - failed:=true; - proc_value_bool32bit(bool1 and bool2); - if global_s32bit <> RESULT_BOOL32BIT then - failed:=true;*} - if failed then - fail - else - WriteLn('Passed!'); -{$endif} - - { arraydef, - recorddef, - objectdef, - stringdef, - setdef : all considered the same by code generator. - } - write('Value parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallrec.b := RESULT_U8BIT; - value_smallrec.w := RESULT_U16BIT; - proc_value_smallrecord(value_smallrec); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); - proc_value_largerecord(value_largerec); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Value parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallset := [A_A,A_D]; - proc_value_smallset(value_smallset); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_largeset := ['I']; - proc_value_largeset(value_largeset); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - - - write('Value parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - value_smallstring := RESULT_SMALLSTRING; - - proc_value_smallstring(value_smallstring); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_bigstring := RESULT_BIGSTRING; - proc_value_bigstring(value_bigstring); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!} - { DON'T KNOW WHY/HOW TO TEST!!!!! } - - - write('Value parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - fillchar(value_smallarray,sizeof(value_smallarray),#0); - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_value_smallarray(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - fillchar(value_smallarray,sizeof(value_smallarray),#0); - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_value_smallarray_open(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - {***************************** MIXED TESTS *******************************} - clear_globals; - clear_values; - - failed:=false; - - { LOC_REGISTER } - write('Mixed value parameter test (src : LOC_REGISTER)...'); - proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),getu8bit,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - proc_value_u16bit_mixed(byte(NOT RESULT_U8BIT),getu16bit,RESULT_U8BIT); - if global_u16bit <> RESULT_U16BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - proc_value_s32bit_mixed(byte(NOT RESULT_U8BIT),gets32bit, RESULT_U8BIT); - if global_s32bit <> RESULT_S32BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$ifndef tp} - proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT),gets64bit,RESULT_U8BIT); - if global_s64bit <> RESULT_S64BIT then - failed:=true; -{$endif} - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_FPUREGISTER } - clear_globals; - clear_values; - failed:=false; - write('Mixed value parameter test (src : LOC_FPUREGISTER)...'); - proc_value_s32real_mixed(byte(NOT RESULT_U8BIT), gets32real, RESULT_U8BIT); - if value_u8bit <> RESULT_U8BIT then - failed := true; - if trunc(global_s32real) <> trunc(RESULT_S32REAL) then - failed:=true; - proc_value_s64real_mixed(byte(NOT RESULT_U8BIT),gets64real,RESULT_U8BIT); - if value_u8bit <> RESULT_U8BIT then - failed := true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed:=true; - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_MEM, LOC_REFERENCE orddef } - clear_globals; - clear_values; - value_u8bit := RESULT_U8BIT; - value_u16bit := RESULT_U16BIT; - value_s32bit := RESULT_S32BIT; -{$ifndef tp} - value_s64bit := RESULT_S64BIT; -{$endif} - value_s32real := RESULT_S32REAL; - value_s64real := RESULT_S64REAL; - - failed:=false; - - { LOC_REFERENCE } - write('Mixed value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...'); - proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),value_u8bit, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - proc_value_u16bit_mixed(byte(NOT RESULT_U8BIT),value_u16bit, RESULT_U8BIT); - if global_u16bit <> RESULT_U16BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - proc_value_s32bit_mixed(byte(NOT RESULT_U8BIT),value_s32bit, RESULT_U8BIT); - if global_s32bit <> RESULT_S32BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$ifndef tp} - proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit, RESULT_U8BIT); - if global_s64bit <> RESULT_S64BIT then - failed:=true; -{$endif} - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_REFERENCE } - clear_globals; - failed:=false; - write('Mixed value parameter test (src : LOC_REFERENCE (floatdef))...'); - proc_value_s32real_mixed(byte(NOT RESULT_U8BIT), value_s32real, RESULT_U8BIT); - if trunc(global_s32real) <> trunc(RESULT_S32REAL) then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - proc_value_s64real_mixed(byte(NOT RESULT_U8BIT), value_s64real, RESULT_U8BIT); - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Mixed value parameter test (src : LOC_REFERENCE (pointer))...'); - clear_globals; - clear_values; - failed:=false; - value_ptr := RESULT_PCHAR; - proc_value_pointerdef_mixed(byte(NOT RESULT_U8BIT), value_ptr, RESULT_U8BIT); - if global_ptr <> value_ptr then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - - value_proc := {$ifndef tp}@{$endif}testprocedure; - proc_value_procvardef_mixed(byte(NOT RESULT_U8BIT), value_proc, RESULT_U8BIT); - if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then - failed := true; - -{$ifndef tp} - value_class := tclass1.create; - proc_value_classrefdef_mixed(byte(NOT RESULT_U8BIT), value_class, RESULT_U8BIT); - if value_class <> global_class then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - value_class.destroy; -{$endif} - if failed then - fail - else - WriteLn('Passed!'); - - - - - { LOC_REFERENCE } - clear_globals; - clear_values; - failed:=false; - value_u8bit := 0; - write('Mixed value parameter test (src : LOC_FLAGS (orddef)))...'); - proc_value_bool8bit_mixed(byte(NOT RESULT_U8BIT), value_u8bit = 0, RESULT_U8BIT); - if global_u8bit <> RESULT_BOOL8BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x - proc_value_bool16bit(value_s64bit < 0); - if global_u16bit <> RESULT_BOOL16BIT then - failed:=true; - proc_value_bool32bit(bool1 and bool2); - if global_s32bit <> RESULT_BOOL32BIT then - failed:=true;*} - if failed then - fail - else - WriteLn('Passed!'); - - - -{$ifndef tp} - clear_globals; - clear_values; - failed:=false; - write('Mixed value parameter test (src : LOC_JUMP (orddef)))...'); - proc_value_bool8bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit = 0, RESULT_U8BIT); - if global_u8bit <> RESULT_BOOL8BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x - proc_value_bool16bit(value_s64bit < 0); - if global_u16bit <> RESULT_BOOL16BIT then - failed:=true; - proc_value_bool32bit(bool1 and bool2); - if global_s32bit <> RESULT_BOOL32BIT then - failed:=true;*} - if failed then - fail - else - WriteLn('Passed!'); -{$endif} - - { arraydef, - recorddef, - objectdef, - stringdef, - setdef : all considered the same by code generator. - } - write('Mixed value parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallrec.b := RESULT_U8BIT; - value_smallrec.w := RESULT_U16BIT; - proc_value_smallrecord_mixed(byte(NOT RESULT_U8BIT), value_smallrec, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); - proc_value_largerecord_mixed(byte(NOT RESULT_U8BIT), value_largerec, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Mixed value parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallset := [A_A,A_D]; - proc_value_smallset_mixed(byte(NOT RESULT_U8BIT), value_smallset, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_largeset := ['I']; - proc_value_largeset_mixed(byte(NOT RESULT_U8BIT), value_largeset, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - - - write('Mixed value parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - value_smallstring := RESULT_SMALLSTRING; - - proc_value_smallstring_mixed(byte(NOT RESULT_U8BIT), value_smallstring, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_bigstring := RESULT_BIGSTRING; - proc_value_bigstring_mixed(byte(NOT RESULT_U8BIT), value_bigstring, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!} - { DON'T KNOW WHY/HOW TO TEST!!!!! } - - - write('Mixed value parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - fillchar(value_smallarray,sizeof(value_smallarray),#0); - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_value_smallarray_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - fillchar(value_smallarray,sizeof(value_smallarray),#0); - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_value_smallarray_open_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT 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 } +{ (value parameters with cdecl calling convention) } +{****************************************************************} +program tcalval4; + +{$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_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; +{$ifndef tp} + global_s64bit := 0; + global_class := nil; +{$endif} + 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; +{$ifndef tp} + value_s64bit := 0; + value_class := nil; +{$endif} + end; + + + procedure testprocedure; + begin + end; + + function getu8bit : byte; + begin + getu8bit:=RESULT_U8BIT; + end; + + function getu16bit: word; + begin + getu16bit:=RESULT_U16BIT; + end; + + function gets32bit: longint; + begin + gets32bit:=RESULT_S32BIT; + end; + + function gets64bit: int64; + begin + gets64bit:=RESULT_S64BIT; + end; + + + function gets32real: single; + begin + gets32real:=RESULT_S32REAL; + end; + + function gets64real: double; + begin + gets64real:=RESULT_S64REAL; + end; + +{ ***************************************************************** } +{ VALUE PARAMETERS } +{ ***************************************************************** } + + procedure proc_value_u8bit(v: byte);cdecl; + begin + global_u8bit := v; + end; + + + procedure proc_value_u16bit(v: word);cdecl; + begin + global_u16bit := v; + end; + + + procedure proc_value_s32bit(v : longint);cdecl; + begin + global_s32bit := v; + end; + + + + + procedure proc_value_bool8bit(v: boolean);cdecl; + begin + { boolean should be 8-bit always! } + if sizeof(boolean) <> 1 then RunError(255); + global_u8bit := byte(v); + end; + + + procedure proc_value_bool16bit(v: wordbool);cdecl; + begin + global_u16bit := word(v); + end; + + + procedure proc_value_bool32bit(v : longbool);cdecl; + begin + global_s32bit := longint(v); + end; + + + procedure proc_value_s32real(v : single);cdecl; + begin + global_s32real := v; + end; + + procedure proc_value_s64real(v: double);cdecl; + begin + global_s64real:= v; + end; + + + procedure proc_value_pointerdef(p : pchar);cdecl; + begin + global_ptr:=p; + end; + + + procedure proc_value_procvardef(p : tprocedure);cdecl; + begin + global_proc:=p; + end; + + + + + procedure proc_value_smallrecord(smallrec : tsmallrecord);cdecl; + begin + if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_value_largerecord(largerec : tlargerecord);cdecl; + begin + if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_value_smallset(smallset : tsmallset);cdecl; + begin + if A_D in smallset then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_value_largeset(largeset : tlargeset);cdecl; + begin + if 'I' in largeset then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_value_smallstring(s:tsmallstring);cdecl; + begin + if s = RESULT_SMALLSTRING then + global_u8bit := RESULT_u8BIT; + end; + + + procedure proc_value_bigstring(s:shortstring);cdecl; + begin + if s = RESULT_BIGSTRING then + global_u8bit := RESULT_u8BIT; + end; + + + procedure proc_value_smallarray(arr : tsmallarray);cdecl; + begin + if arr[SMALL_INDEX] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_value_smallarray_open(arr : array of byte);cdecl; + begin + { form 0 to N-1 indexes in open arrays } + if arr[SMALL_INDEX-1] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + end; + +{$ifndef tp} + procedure proc_value_classrefdef(obj : tclass1);cdecl; + begin + global_class:=obj; + end; + + + procedure proc_value_s64bit(v: int64);cdecl; + begin + global_s64bit:= v; + end; +{$endif} + + {********************************* MIXED PARAMETERS *************************} + + procedure proc_value_u8bit_mixed(b1 : byte; v: byte; b2: byte);cdecl; + begin + global_u8bit := v; + value_u8bit := b2; + end; + + + procedure proc_value_u16bit_mixed(b1: byte; v: word; b2: byte);cdecl; + begin + global_u16bit := v; + value_u8bit := b2; + end; + + + procedure proc_value_s32bit_mixed(b1 : byte; v : longint; b2: byte);cdecl; + begin + global_s32bit := v; + value_u8bit := b2; + end; + + + + + procedure proc_value_bool8bit_mixed(b1: byte; v: boolean; b2: byte);cdecl; + begin + { boolean should be 8-bit always! } + if sizeof(boolean) <> 1 then RunError(255); + global_u8bit := byte(v); + value_u8bit := b2; + end; + + + procedure proc_value_bool16bit_mixed(b1 : byte; v: wordbool; b2: byte);cdecl; + begin + global_u16bit := word(v); + value_u8bit := b2; + end; + + + procedure proc_value_bool32bit_mixed(b1 : byte; v : longbool; b2: byte);cdecl; + begin + global_s32bit := longint(v); + value_u8bit := b2; + end; + + + procedure proc_value_s32real_mixed(b1: byte; v : single; b2: byte);cdecl; + begin + global_s32real := v; + value_u8bit := b2; + end; + + procedure proc_value_s64real_mixed(b1: byte; v: double; b2: byte);cdecl; + begin + global_s64real:= v; + value_u8bit := b2; + end; + + + procedure proc_value_pointerdef_mixed(b1: byte; p : pchar; b2: byte);cdecl; + begin + global_ptr:=p; + value_u8bit := b2; + end; + + + procedure proc_value_procvardef_mixed(b1: byte; p : tprocedure; b2: byte);cdecl; + begin + global_proc:=p; + value_u8bit := b2; + end; + + + + + procedure proc_value_smallrecord_mixed(b1: byte; smallrec : tsmallrecord; b2: byte);cdecl; + begin + if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + procedure proc_value_largerecord_mixed(b1: byte; largerec : tlargerecord; b2: byte);cdecl; + begin + if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + procedure proc_value_smallset_mixed(b1: byte; smallset : tsmallset; b2: byte);cdecl; + begin + if A_D in smallset then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + procedure proc_value_largeset_mixed(b1: byte; largeset : tlargeset; b2: byte);cdecl; + begin + if 'I' in largeset then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + procedure proc_value_smallstring_mixed(b1: byte; s:tsmallstring; b2: byte);cdecl; + begin + if s = RESULT_SMALLSTRING then + global_u8bit := RESULT_u8BIT; + value_u8bit := b2; + end; + + + procedure proc_value_bigstring_mixed(b1: byte; s:shortstring; b2: byte);cdecl; + begin + if s = RESULT_BIGSTRING then + global_u8bit := RESULT_u8BIT; + value_u8bit := b2; + end; + + + procedure proc_value_smallarray_mixed(b1: byte; arr : tsmallarray; b2: byte);cdecl; + begin + if arr[SMALL_INDEX] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + procedure proc_value_smallarray_open_mixed(b1: byte; arr : array of byte; b2: byte);cdecl; + begin + { form 0 to N-1 indexes in open arrays } + if arr[SMALL_INDEX-1] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + +{$ifndef tp} + procedure proc_value_classrefdef_mixed(b1: byte; obj : tclass1; b2: byte);cdecl; + begin + global_class:=obj; + value_u8bit := b2; + end; + + + procedure proc_value_s64bit_mixed(b1 : byte; v: int64; b2: byte);cdecl; + begin + global_s64bit:= v; + value_u8bit := b2; + end; + + +{$endif} + + + +var + failed: boolean; +Begin + {***************************** NORMAL TESTS *******************************} + clear_globals; + clear_values; + + failed:=false; + + { LOC_REGISTER } + write('Value parameter test (src : LOC_REGISTER)...'); + proc_value_u8bit(getu8bit); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + proc_value_u16bit(getu16bit); + if global_u16bit <> RESULT_U16BIT then + failed:=true; + proc_value_s32bit(gets32bit); + if global_s32bit <> RESULT_S32BIT then + failed:=true; +{$ifndef tp} + proc_value_s64bit(gets64bit); + if global_s64bit <> RESULT_S64BIT then + failed:=true; +{$endif} + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_FPUREGISTER } + clear_globals; + clear_values; + failed:=false; + write('Value parameter test (src : LOC_FPUREGISTER)...'); + proc_value_s32real(gets32real); + if trunc(global_s32real) <> trunc(RESULT_S32REAL) then + failed:=true; + proc_value_s64real(gets64real); + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed:=true; + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_MEM, LOC_REFERENCE orddef } + clear_globals; + clear_values; + value_u8bit := RESULT_U8BIT; + value_u16bit := RESULT_U16BIT; + value_s32bit := RESULT_S32BIT; +{$ifndef tp} + value_s64bit := RESULT_S64BIT; +{$endif} + value_s32real := RESULT_S32REAL; + value_s64real := RESULT_S64REAL; + + failed:=false; + + { LOC_REFERENCE } + write('Value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...'); + proc_value_u8bit(value_u8bit); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + proc_value_u16bit(value_u16bit); + if global_u16bit <> RESULT_U16BIT then + failed:=true; + proc_value_s32bit(value_s32bit); + if global_s32bit <> RESULT_S32BIT then + failed:=true; +{$ifndef tp} + proc_value_s64bit(value_s64bit); + if global_s64bit <> RESULT_S64BIT then + failed:=true; +{$endif} + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_REFERENCE } + clear_globals; + failed:=false; + write('Value parameter test (src : LOC_REFERENCE (floatdef))...'); + proc_value_s32real(value_s32real); + if trunc(global_s32real) <> trunc(RESULT_S32REAL) then + failed:=true; + proc_value_s64real(value_s64real); + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed:=true; + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Value parameter test (src : LOC_REFERENCE (pointer))...'); + clear_globals; + clear_values; + failed:=false; + value_ptr := RESULT_PCHAR; + proc_value_pointerdef(value_ptr); + if global_ptr <> value_ptr then + failed := true; + + + value_proc := {$ifndef tp}@{$endif}testprocedure; + proc_value_procvardef(value_proc); + if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then + failed := true; + +{$ifndef tp} + value_class := tclass1.create; + proc_value_classrefdef(value_class); + if value_class <> global_class then + failed := true; + value_class.destroy; +{$endif} + if failed then + fail + else + WriteLn('Passed!'); + + + + + { LOC_REFERENCE } + clear_globals; + clear_values; + failed:=false; + value_u8bit := 0; + write('Value parameter test (src : LOC_FLAGS (orddef)))...'); + proc_value_bool8bit(value_u8bit = 0); + if global_u8bit <> RESULT_BOOL8BIT then + failed:=true; +{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x + proc_value_bool16bit(value_s64bit < 0); + if global_u16bit <> RESULT_BOOL16BIT then + failed:=true; + proc_value_bool32bit(bool1 and bool2); + if global_s32bit <> RESULT_BOOL32BIT then + failed:=true;*} + if failed then + fail + else + WriteLn('Passed!'); + + + +{$ifndef tp} + clear_globals; + clear_values; + failed:=false; + write('Value parameter test (src : LOC_JUMP (orddef)))...'); + proc_value_bool8bit(value_s64bit = 0); + if global_u8bit <> RESULT_BOOL8BIT then + failed:=true; +{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x + proc_value_bool16bit(value_s64bit < 0); + if global_u16bit <> RESULT_BOOL16BIT then + failed:=true; + proc_value_bool32bit(bool1 and bool2); + if global_s32bit <> RESULT_BOOL32BIT then + failed:=true;*} + if failed then + fail + else + WriteLn('Passed!'); +{$endif} + + { arraydef, + recorddef, + objectdef, + stringdef, + setdef : all considered the same by code generator. + } + write('Value parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallrec.b := RESULT_U8BIT; + value_smallrec.w := RESULT_U16BIT; + proc_value_smallrecord(value_smallrec); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); + proc_value_largerecord(value_largerec); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Value parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallset := [A_A,A_D]; + proc_value_smallset(value_smallset); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_largeset := ['I']; + proc_value_largeset(value_largeset); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + + + write('Value parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + value_smallstring := RESULT_SMALLSTRING; + + proc_value_smallstring(value_smallstring); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_bigstring := RESULT_BIGSTRING; + proc_value_bigstring(value_bigstring); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!} + { DON'T KNOW WHY/HOW TO TEST!!!!! } + + + write('Value parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + fillchar(value_smallarray,sizeof(value_smallarray),#0); + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_value_smallarray(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + fillchar(value_smallarray,sizeof(value_smallarray),#0); + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_value_smallarray_open(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + {***************************** MIXED TESTS *******************************} + clear_globals; + clear_values; + + failed:=false; + + { LOC_REGISTER } + write('Mixed value parameter test (src : LOC_REGISTER)...'); + proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),getu8bit,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + proc_value_u16bit_mixed(byte(NOT RESULT_U8BIT),getu16bit,RESULT_U8BIT); + if global_u16bit <> RESULT_U16BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + proc_value_s32bit_mixed(byte(NOT RESULT_U8BIT),gets32bit, RESULT_U8BIT); + if global_s32bit <> RESULT_S32BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$ifndef tp} + proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT),gets64bit,RESULT_U8BIT); + if global_s64bit <> RESULT_S64BIT then + failed:=true; +{$endif} + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_FPUREGISTER } + clear_globals; + clear_values; + failed:=false; + write('Mixed value parameter test (src : LOC_FPUREGISTER)...'); + proc_value_s32real_mixed(byte(NOT RESULT_U8BIT), gets32real, RESULT_U8BIT); + if value_u8bit <> RESULT_U8BIT then + failed := true; + if trunc(global_s32real) <> trunc(RESULT_S32REAL) then + failed:=true; + proc_value_s64real_mixed(byte(NOT RESULT_U8BIT),gets64real,RESULT_U8BIT); + if value_u8bit <> RESULT_U8BIT then + failed := true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed:=true; + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_MEM, LOC_REFERENCE orddef } + clear_globals; + clear_values; + value_u8bit := RESULT_U8BIT; + value_u16bit := RESULT_U16BIT; + value_s32bit := RESULT_S32BIT; +{$ifndef tp} + value_s64bit := RESULT_S64BIT; +{$endif} + value_s32real := RESULT_S32REAL; + value_s64real := RESULT_S64REAL; + + failed:=false; + + { LOC_REFERENCE } + write('Mixed value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...'); + proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),value_u8bit, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + proc_value_u16bit_mixed(byte(NOT RESULT_U8BIT),value_u16bit, RESULT_U8BIT); + if global_u16bit <> RESULT_U16BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + proc_value_s32bit_mixed(byte(NOT RESULT_U8BIT),value_s32bit, RESULT_U8BIT); + if global_s32bit <> RESULT_S32BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$ifndef tp} + proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit, RESULT_U8BIT); + if global_s64bit <> RESULT_S64BIT then + failed:=true; +{$endif} + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_REFERENCE } + clear_globals; + failed:=false; + write('Mixed value parameter test (src : LOC_REFERENCE (floatdef))...'); + proc_value_s32real_mixed(byte(NOT RESULT_U8BIT), value_s32real, RESULT_U8BIT); + if trunc(global_s32real) <> trunc(RESULT_S32REAL) then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + proc_value_s64real_mixed(byte(NOT RESULT_U8BIT), value_s64real, RESULT_U8BIT); + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Mixed value parameter test (src : LOC_REFERENCE (pointer))...'); + clear_globals; + clear_values; + failed:=false; + value_ptr := RESULT_PCHAR; + proc_value_pointerdef_mixed(byte(NOT RESULT_U8BIT), value_ptr, RESULT_U8BIT); + if global_ptr <> value_ptr then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + + value_proc := {$ifndef tp}@{$endif}testprocedure; + proc_value_procvardef_mixed(byte(NOT RESULT_U8BIT), value_proc, RESULT_U8BIT); + if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then + failed := true; + +{$ifndef tp} + value_class := tclass1.create; + proc_value_classrefdef_mixed(byte(NOT RESULT_U8BIT), value_class, RESULT_U8BIT); + if value_class <> global_class then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + value_class.destroy; +{$endif} + if failed then + fail + else + WriteLn('Passed!'); + + + + + { LOC_REFERENCE } + clear_globals; + clear_values; + failed:=false; + value_u8bit := 0; + write('Mixed value parameter test (src : LOC_FLAGS (orddef)))...'); + proc_value_bool8bit_mixed(byte(NOT RESULT_U8BIT), value_u8bit = 0, RESULT_U8BIT); + if global_u8bit <> RESULT_BOOL8BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x + proc_value_bool16bit(value_s64bit < 0); + if global_u16bit <> RESULT_BOOL16BIT then + failed:=true; + proc_value_bool32bit(bool1 and bool2); + if global_s32bit <> RESULT_BOOL32BIT then + failed:=true;*} + if failed then + fail + else + WriteLn('Passed!'); + + + +{$ifndef tp} + clear_globals; + clear_values; + failed:=false; + write('Mixed value parameter test (src : LOC_JUMP (orddef)))...'); + proc_value_bool8bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit = 0, RESULT_U8BIT); + if global_u8bit <> RESULT_BOOL8BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x + proc_value_bool16bit(value_s64bit < 0); + if global_u16bit <> RESULT_BOOL16BIT then + failed:=true; + proc_value_bool32bit(bool1 and bool2); + if global_s32bit <> RESULT_BOOL32BIT then + failed:=true;*} + if failed then + fail + else + WriteLn('Passed!'); +{$endif} + + { arraydef, + recorddef, + objectdef, + stringdef, + setdef : all considered the same by code generator. + } + write('Mixed value parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallrec.b := RESULT_U8BIT; + value_smallrec.w := RESULT_U16BIT; + proc_value_smallrecord_mixed(byte(NOT RESULT_U8BIT), value_smallrec, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); + proc_value_largerecord_mixed(byte(NOT RESULT_U8BIT), value_largerec, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Mixed value parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallset := [A_A,A_D]; + proc_value_smallset_mixed(byte(NOT RESULT_U8BIT), value_smallset, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_largeset := ['I']; + proc_value_largeset_mixed(byte(NOT RESULT_U8BIT), value_largeset, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + + + write('Mixed value parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + value_smallstring := RESULT_SMALLSTRING; + + proc_value_smallstring_mixed(byte(NOT RESULT_U8BIT), value_smallstring, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_bigstring := RESULT_BIGSTRING; + proc_value_bigstring_mixed(byte(NOT RESULT_U8BIT), value_bigstring, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!} + { DON'T KNOW WHY/HOW TO TEST!!!!! } + + + write('Mixed value parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + fillchar(value_smallarray,sizeof(value_smallarray),#0); + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_value_smallarray_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + fillchar(value_smallarray,sizeof(value_smallarray),#0); + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_value_smallarray_open_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + +end. + + +{ $Log$ - Revision 1.5 2002-11-09 21:47:37 carl - + updated tests for correct parsing (array of const now allowed with high!) - - Revision 1.4 2002/09/22 09:08:41 carl - * gets64bit was not returning an int64! - - Revision 1.3 2002/09/07 15:40:55 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:49:45 carl - + value parameter passing for different calling conventions - -} + Revision 1.6 2003-04-22 10:24:29 florian + * fixed defines for powerpc + + Revision 1.5 2002/11/09 21:47:37 carl + + updated tests for correct parsing (array of const now allowed with high!) + + Revision 1.4 2002/09/22 09:08:41 carl + * gets64bit was not returning an int64! + + Revision 1.3 2002/09/07 15:40:55 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:49:45 carl + + value parameter passing for different calling conventions + +} diff --git a/tests/test/cg/tcalval5.pp b/tests/test/cg/tcalval5.pp index 71dc12bbb3..17f954b290 100644 --- a/tests/test/cg/tcalval5.pp +++ b/tests/test/cg/tcalval5.pp @@ -1,1306 +1,1308 @@ -{****************************************************************} -{ 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 } -{ (value parameters with popstack calling convention) } -{****************************************************************} -program tcalval5; - -{$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; - {$endif} - {$ifdef cpui386} - 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_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; -{$ifndef tp} - global_s64bit := 0; - global_class := nil; -{$endif} - 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; -{$ifndef tp} - value_s64bit := 0; - value_class := nil; -{$endif} - end; - - - procedure testprocedure; - begin - end; - - function getu8bit : byte; - begin - getu8bit:=RESULT_U8BIT; - end; - - function getu16bit: word; - begin - getu16bit:=RESULT_U16BIT; - end; - - function gets32bit: longint; - begin - gets32bit:=RESULT_S32BIT; - end; - - function gets64bit: int64; - begin - gets64bit:=RESULT_S64BIT; - end; - - - function gets32real: single; - begin - gets32real:=RESULT_S32REAL; - end; - - function gets64real: double; - begin - gets64real:=RESULT_S64REAL; - end; - -{ ***************************************************************** } -{ VALUE PARAMETERS } -{ ***************************************************************** } - - procedure proc_value_u8bit(v: byte);popstack; - begin - global_u8bit := v; - end; - - - procedure proc_value_u16bit(v: word);popstack; - begin - global_u16bit := v; - end; - - - procedure proc_value_s32bit(v : longint);popstack; - begin - global_s32bit := v; - end; - - - - - procedure proc_value_bool8bit(v: boolean);popstack; - begin - { boolean should be 8-bit always! } - if sizeof(boolean) <> 1 then RunError(255); - global_u8bit := byte(v); - end; - - - procedure proc_value_bool16bit(v: wordbool);popstack; - begin - global_u16bit := word(v); - end; - - - procedure proc_value_bool32bit(v : longbool);popstack; - begin - global_s32bit := longint(v); - end; - - - procedure proc_value_s32real(v : single);popstack; - begin - global_s32real := v; - end; - - procedure proc_value_s64real(v: double);popstack; - begin - global_s64real:= v; - end; - - - procedure proc_value_pointerdef(p : pchar);popstack; - begin - global_ptr:=p; - end; - - - procedure proc_value_procvardef(p : tprocedure);popstack; - begin - global_proc:=p; - end; - - - - - procedure proc_value_smallrecord(smallrec : tsmallrecord);popstack; - begin - if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_value_largerecord(largerec : tlargerecord);popstack; - begin - if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_value_smallset(smallset : tsmallset);popstack; - begin - if A_D in smallset then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_value_largeset(largeset : tlargeset);popstack; - begin - if 'I' in largeset then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_value_smallstring(s:tsmallstring);popstack; - begin - if s = RESULT_SMALLSTRING then - global_u8bit := RESULT_u8BIT; - end; - - - procedure proc_value_bigstring(s:shortstring);popstack; - begin - if s = RESULT_BIGSTRING then - global_u8bit := RESULT_u8BIT; - end; - - - procedure proc_value_smallarray(arr : tsmallarray);popstack; - begin - if arr[SMALL_INDEX] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_value_smallarray_open(arr : array of byte);popstack; - begin - { form 0 to N-1 indexes in open arrays } - if arr[SMALL_INDEX-1] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - end; - -{$ifndef tp} - procedure proc_value_classrefdef(obj : tclass1);popstack; - begin - global_class:=obj; - end; - - - procedure proc_value_smallarray_const_1(arr : array of const);popstack; - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : global_u8bit := arr[i].vinteger and $ff; - vtBoolean : global_boolean := arr[i].vboolean; - vtChar : global_char := arr[i].vchar; - vtExtended : global_s64real := arr[i].VExtended^; - vtString : global_bigstring := arr[i].VString^; - vtPointer : ; - vtPChar : global_ptr := arr[i].VPchar; - vtObject : ; -{ vtClass : global_class := (arr[i].VClass) as tclass1;} - vtAnsiString : ; - vtInt64 : global_s64bit := arr[i].vInt64^; - else - RunError(255); - end; - end; {endfor} - end; - - - procedure proc_value_smallarray_const_2(arr : array of const);popstack; - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_value_s64bit(v: int64);popstack; - begin - global_s64bit:= v; - end; -{$endif} - - {********************************* MIXED PARAMETERS *************************} - - procedure proc_value_u8bit_mixed(b1 : byte; v: byte; b2: byte);popstack; - begin - global_u8bit := v; - value_u8bit := b2; - end; - - - procedure proc_value_u16bit_mixed(b1: byte; v: word; b2: byte);popstack; - begin - global_u16bit := v; - value_u8bit := b2; - end; - - - procedure proc_value_s32bit_mixed(b1 : byte; v : longint; b2: byte);popstack; - begin - global_s32bit := v; - value_u8bit := b2; - end; - - - - - procedure proc_value_bool8bit_mixed(b1: byte; v: boolean; b2: byte);popstack; - begin - { boolean should be 8-bit always! } - if sizeof(boolean) <> 1 then RunError(255); - global_u8bit := byte(v); - value_u8bit := b2; - end; - - - procedure proc_value_bool16bit_mixed(b1 : byte; v: wordbool; b2: byte);popstack; - begin - global_u16bit := word(v); - value_u8bit := b2; - end; - - - procedure proc_value_bool32bit_mixed(b1 : byte; v : longbool; b2: byte);popstack; - begin - global_s32bit := longint(v); - value_u8bit := b2; - end; - - - procedure proc_value_s32real_mixed(b1: byte; v : single; b2: byte);popstack; - begin - global_s32real := v; - value_u8bit := b2; - end; - - procedure proc_value_s64real_mixed(b1: byte; v: double; b2: byte);popstack; - begin - global_s64real:= v; - value_u8bit := b2; - end; - - - procedure proc_value_pointerdef_mixed(b1: byte; p : pchar; b2: byte);popstack; - begin - global_ptr:=p; - value_u8bit := b2; - end; - - - procedure proc_value_procvardef_mixed(b1: byte; p : tprocedure; b2: byte);popstack; - begin - global_proc:=p; - value_u8bit := b2; - end; - - - - - procedure proc_value_smallrecord_mixed(b1: byte; smallrec : tsmallrecord; b2: byte);popstack; - begin - if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - procedure proc_value_largerecord_mixed(b1: byte; largerec : tlargerecord; b2: byte);popstack; - begin - if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - procedure proc_value_smallset_mixed(b1: byte; smallset : tsmallset; b2: byte);popstack; - begin - if A_D in smallset then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - procedure proc_value_largeset_mixed(b1: byte; largeset : tlargeset; b2: byte);popstack; - begin - if 'I' in largeset then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - procedure proc_value_smallstring_mixed(b1: byte; s:tsmallstring; b2: byte);popstack; - begin - if s = RESULT_SMALLSTRING then - global_u8bit := RESULT_u8BIT; - value_u8bit := b2; - end; - - - procedure proc_value_bigstring_mixed(b1: byte; s:shortstring; b2: byte);popstack; - begin - if s = RESULT_BIGSTRING then - global_u8bit := RESULT_u8BIT; - value_u8bit := b2; - end; - - - procedure proc_value_smallarray_mixed(b1: byte; arr : tsmallarray; b2: byte);popstack; - begin - if arr[SMALL_INDEX] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - procedure proc_value_smallarray_open_mixed(b1: byte; arr : array of byte; b2: byte);popstack; - begin - { form 0 to N-1 indexes in open arrays } - if arr[SMALL_INDEX-1] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - -{$ifndef tp} - procedure proc_value_classrefdef_mixed(b1: byte; obj : tclass1; b2: byte);popstack; - begin - global_class:=obj; - value_u8bit := b2; - end; - - - procedure proc_value_s64bit_mixed(b1 : byte; v: int64; b2: byte);popstack; - begin - global_s64bit:= v; - value_u8bit := b2; - end; - - - procedure proc_value_smallarray_const_1_mixed(b1: byte; arr : array of const; b2: byte);popstack; - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : global_u8bit := arr[i].vinteger and $ff; - vtBoolean : global_boolean := arr[i].vboolean; - vtChar : global_char := arr[i].vchar; - vtExtended : global_s64real := arr[i].VExtended^; - vtString : global_bigstring := arr[i].VString^; - vtPointer : ; - vtPChar : global_ptr := arr[i].VPchar; - vtObject : ; -{ vtClass : global_class := (arr[i].VClass) as tclass1;} - vtAnsiString : ; - vtInt64 : global_s64bit := arr[i].vInt64^; - else - RunError(255); - end; - end; {endfor} - value_u8bit := b2; - end; - - - procedure proc_value_smallarray_const_2_mixed(b1: byte; arr : array of const; b2: byte);popstack; - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; -{$endif} - - - -var - failed: boolean; -Begin - {***************************** NORMAL TESTS *******************************} - clear_globals; - clear_values; - - failed:=false; - - { LOC_REGISTER } - write('Value parameter test (src : LOC_REGISTER)...'); - proc_value_u8bit(getu8bit); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - proc_value_u16bit(getu16bit); - if global_u16bit <> RESULT_U16BIT then - failed:=true; - proc_value_s32bit(gets32bit); - if global_s32bit <> RESULT_S32BIT then - failed:=true; -{$ifndef tp} - proc_value_s64bit(gets64bit); - if global_s64bit <> RESULT_S64BIT then - failed:=true; -{$endif} - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_FPUREGISTER } - clear_globals; - clear_values; - failed:=false; - write('Value parameter test (src : LOC_FPUREGISTER)...'); - proc_value_s32real(gets32real); - if trunc(global_s32real) <> trunc(RESULT_S32REAL) then - failed:=true; - proc_value_s64real(gets64real); - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed:=true; - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_MEM, LOC_REFERENCE orddef } - clear_globals; - clear_values; - value_u8bit := RESULT_U8BIT; - value_u16bit := RESULT_U16BIT; - value_s32bit := RESULT_S32BIT; -{$ifndef tp} - value_s64bit := RESULT_S64BIT; -{$endif} - value_s32real := RESULT_S32REAL; - value_s64real := RESULT_S64REAL; - - failed:=false; - - { LOC_REFERENCE } - write('Value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...'); - proc_value_u8bit(value_u8bit); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - proc_value_u16bit(value_u16bit); - if global_u16bit <> RESULT_U16BIT then - failed:=true; - proc_value_s32bit(value_s32bit); - if global_s32bit <> RESULT_S32BIT then - failed:=true; -{$ifndef tp} - proc_value_s64bit(value_s64bit); - if global_s64bit <> RESULT_S64BIT then - failed:=true; -{$endif} - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_REFERENCE } - clear_globals; - failed:=false; - write('Value parameter test (src : LOC_REFERENCE (floatdef))...'); - proc_value_s32real(value_s32real); - if trunc(global_s32real) <> trunc(RESULT_S32REAL) then - failed:=true; - proc_value_s64real(value_s64real); - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed:=true; - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Value parameter test (src : LOC_REFERENCE (pointer))...'); - clear_globals; - clear_values; - failed:=false; - value_ptr := RESULT_PCHAR; - proc_value_pointerdef(value_ptr); - if global_ptr <> value_ptr then - failed := true; - - - value_proc := {$ifndef tp}@{$endif}testprocedure; - proc_value_procvardef(value_proc); - if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then - failed := true; - -{$ifndef tp} - value_class := tclass1.create; - proc_value_classrefdef(value_class); - if value_class <> global_class then - failed := true; - value_class.destroy; -{$endif} - if failed then - fail - else - WriteLn('Passed!'); - - - - - { LOC_REFERENCE } - clear_globals; - clear_values; - failed:=false; - value_u8bit := 0; - write('Value parameter test (src : LOC_FLAGS (orddef)))...'); - proc_value_bool8bit(value_u8bit = 0); - if global_u8bit <> RESULT_BOOL8BIT then - failed:=true; -{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x - proc_value_bool16bit(value_s64bit < 0); - if global_u16bit <> RESULT_BOOL16BIT then - failed:=true; - proc_value_bool32bit(bool1 and bool2); - if global_s32bit <> RESULT_BOOL32BIT then - failed:=true;*} - if failed then - fail - else - WriteLn('Passed!'); - - - -{$ifndef tp} - clear_globals; - clear_values; - failed:=false; - write('Value parameter test (src : LOC_JUMP (orddef)))...'); - proc_value_bool8bit(value_s64bit = 0); - if global_u8bit <> RESULT_BOOL8BIT then - failed:=true; -{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x - proc_value_bool16bit(value_s64bit < 0); - if global_u16bit <> RESULT_BOOL16BIT then - failed:=true; - proc_value_bool32bit(bool1 and bool2); - if global_s32bit <> RESULT_BOOL32BIT then - failed:=true;*} - if failed then - fail - else - WriteLn('Passed!'); -{$endif} - - { arraydef, - recorddef, - objectdef, - stringdef, - setdef : all considered the same by code generator. - } - write('Value parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallrec.b := RESULT_U8BIT; - value_smallrec.w := RESULT_U16BIT; - proc_value_smallrecord(value_smallrec); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); - proc_value_largerecord(value_largerec); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Value parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallset := [A_A,A_D]; - proc_value_smallset(value_smallset); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_largeset := ['I']; - proc_value_largeset(value_largeset); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - - - write('Value parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - value_smallstring := RESULT_SMALLSTRING; - - proc_value_smallstring(value_smallstring); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_bigstring := RESULT_BIGSTRING; - proc_value_bigstring(value_bigstring); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!} - { DON'T KNOW WHY/HOW TO TEST!!!!! } - - - write('Value parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - fillchar(value_smallarray,sizeof(value_smallarray),#0); - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_value_smallarray(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - fillchar(value_smallarray,sizeof(value_smallarray),#0); - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_value_smallarray_open(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - -{$ifndef tp} - clear_globals; - clear_values; - - value_u8bit := RESULT_U8BIT; - value_ptr := RESULT_PCHAR; - value_s64bit := RESULT_S64BIT; - value_smallstring := RESULT_SMALLSTRING; - value_class := tclass1.create; - value_boolean := RESULT_BOOLEAN; - value_char := RESULT_CHAR; - value_s64real:=RESULT_S64REAL; - proc_value_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real, - value_boolean,value_class]); - - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if global_char <> RESULT_CHAR then - failed := true; - if global_boolean <> RESULT_BOOLEAN then - failed:=true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed := true; - if global_bigstring <> RESULT_SMALLSTRING then - failed := true; - if global_ptr <> value_ptr then - failed := true; -{ if value_class <> global_class then - failed := true;!!!!!!!!!!!!!!!!!!!!} - if global_s64bit <> RESULT_S64BIT then - failed := true; - if assigned(value_class) then - value_class.destroy; - - global_u8bit := 0; - proc_value_smallarray_const_2([]); - if global_u8bit <> RESULT_U8BIT then - failed := true; -{$endif fpc} - - if failed then - fail - else - WriteLn('Passed!'); - - {***************************** MIXED TESTS *******************************} - clear_globals; - clear_values; - - failed:=false; - - { LOC_REGISTER } - write('Mixed value parameter test (src : LOC_REGISTER)...'); - proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),getu8bit,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - proc_value_u16bit_mixed(byte(NOT RESULT_U8BIT),getu16bit,RESULT_U8BIT); - if global_u16bit <> RESULT_U16BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - proc_value_s32bit_mixed(byte(NOT RESULT_U8BIT),gets32bit, RESULT_U8BIT); - if global_s32bit <> RESULT_S32BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$ifndef tp} - proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT),gets64bit,RESULT_U8BIT); - if global_s64bit <> RESULT_S64BIT then - failed:=true; -{$endif} - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_FPUREGISTER } - clear_globals; - clear_values; - failed:=false; - write('Mixed value parameter test (src : LOC_FPUREGISTER)...'); - proc_value_s32real_mixed(byte(NOT RESULT_U8BIT), gets32real, RESULT_U8BIT); - if value_u8bit <> RESULT_U8BIT then - failed := true; - if trunc(global_s32real) <> trunc(RESULT_S32REAL) then - failed:=true; - proc_value_s64real_mixed(byte(NOT RESULT_U8BIT),gets64real,RESULT_U8BIT); - if value_u8bit <> RESULT_U8BIT then - failed := true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed:=true; - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_MEM, LOC_REFERENCE orddef } - clear_globals; - clear_values; - value_u8bit := RESULT_U8BIT; - value_u16bit := RESULT_U16BIT; - value_s32bit := RESULT_S32BIT; -{$ifndef tp} - value_s64bit := RESULT_S64BIT; -{$endif} - value_s32real := RESULT_S32REAL; - value_s64real := RESULT_S64REAL; - - failed:=false; - - { LOC_REFERENCE } - write('Mixed value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...'); - proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),value_u8bit, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - proc_value_u16bit_mixed(byte(NOT RESULT_U8BIT),value_u16bit, RESULT_U8BIT); - if global_u16bit <> RESULT_U16BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - proc_value_s32bit_mixed(byte(NOT RESULT_U8BIT),value_s32bit, RESULT_U8BIT); - if global_s32bit <> RESULT_S32BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$ifndef tp} - proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit, RESULT_U8BIT); - if global_s64bit <> RESULT_S64BIT then - failed:=true; -{$endif} - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_REFERENCE } - clear_globals; - failed:=false; - write('Mixed value parameter test (src : LOC_REFERENCE (floatdef))...'); - proc_value_s32real_mixed(byte(NOT RESULT_U8BIT), value_s32real, RESULT_U8BIT); - if trunc(global_s32real) <> trunc(RESULT_S32REAL) then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - proc_value_s64real_mixed(byte(NOT RESULT_U8BIT), value_s64real, RESULT_U8BIT); - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Mixed value parameter test (src : LOC_REFERENCE (pointer))...'); - clear_globals; - clear_values; - failed:=false; - value_ptr := RESULT_PCHAR; - proc_value_pointerdef_mixed(byte(NOT RESULT_U8BIT), value_ptr, RESULT_U8BIT); - if global_ptr <> value_ptr then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - - value_proc := {$ifndef tp}@{$endif}testprocedure; - proc_value_procvardef_mixed(byte(NOT RESULT_U8BIT), value_proc, RESULT_U8BIT); - if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then - failed := true; - -{$ifndef tp} - value_class := tclass1.create; - proc_value_classrefdef_mixed(byte(NOT RESULT_U8BIT), value_class, RESULT_U8BIT); - if value_class <> global_class then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - value_class.destroy; -{$endif} - if failed then - fail - else - WriteLn('Passed!'); - - - - - { LOC_REFERENCE } - clear_globals; - clear_values; - failed:=false; - value_u8bit := 0; - write('Mixed value parameter test (src : LOC_FLAGS (orddef)))...'); - proc_value_bool8bit_mixed(byte(NOT RESULT_U8BIT), value_u8bit = 0, RESULT_U8BIT); - if global_u8bit <> RESULT_BOOL8BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x - proc_value_bool16bit(value_s64bit < 0); - if global_u16bit <> RESULT_BOOL16BIT then - failed:=true; - proc_value_bool32bit(bool1 and bool2); - if global_s32bit <> RESULT_BOOL32BIT then - failed:=true;*} - if failed then - fail - else - WriteLn('Passed!'); - - - -{$ifndef tp} - clear_globals; - clear_values; - failed:=false; - write('Mixed value parameter test (src : LOC_JUMP (orddef)))...'); - proc_value_bool8bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit = 0, RESULT_U8BIT); - if global_u8bit <> RESULT_BOOL8BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x - proc_value_bool16bit(value_s64bit < 0); - if global_u16bit <> RESULT_BOOL16BIT then - failed:=true; - proc_value_bool32bit(bool1 and bool2); - if global_s32bit <> RESULT_BOOL32BIT then - failed:=true;*} - if failed then - fail - else - WriteLn('Passed!'); -{$endif} - - { arraydef, - recorddef, - objectdef, - stringdef, - setdef : all considered the same by code generator. - } - write('Mixed value parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallrec.b := RESULT_U8BIT; - value_smallrec.w := RESULT_U16BIT; - proc_value_smallrecord_mixed(byte(NOT RESULT_U8BIT), value_smallrec, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); - proc_value_largerecord_mixed(byte(NOT RESULT_U8BIT), value_largerec, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Mixed value parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallset := [A_A,A_D]; - proc_value_smallset_mixed(byte(NOT RESULT_U8BIT), value_smallset, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_largeset := ['I']; - proc_value_largeset_mixed(byte(NOT RESULT_U8BIT), value_largeset, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - - - write('Mixed value parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - value_smallstring := RESULT_SMALLSTRING; - - proc_value_smallstring_mixed(byte(NOT RESULT_U8BIT), value_smallstring, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_bigstring := RESULT_BIGSTRING; - proc_value_bigstring_mixed(byte(NOT RESULT_U8BIT), value_bigstring, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!} - { DON'T KNOW WHY/HOW TO TEST!!!!! } - - - write('Mixed value parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - fillchar(value_smallarray,sizeof(value_smallarray),#0); - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_value_smallarray_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - fillchar(value_smallarray,sizeof(value_smallarray),#0); - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_value_smallarray_open_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - -{$ifndef tp} - clear_globals; - clear_values; - - value_u8bit := RESULT_U8BIT; - value_ptr := RESULT_PCHAR; - value_s64bit := RESULT_S64BIT; - value_smallstring := RESULT_SMALLSTRING; - value_class := tclass1.create; - value_boolean := RESULT_BOOLEAN; - value_char := RESULT_CHAR; - value_s64real:=RESULT_S64REAL; - proc_value_smallarray_const_1_mixed(byte(NOT RESULT_U8BIT), [value_u8bit,value_ptr,value_s64bit,value_char, - value_smallstring,value_s64real,value_boolean,value_class], - RESULT_U8BIT); - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if global_char <> RESULT_CHAR then - failed := true; - if global_boolean <> RESULT_BOOLEAN then - failed:=true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed := true; - if global_bigstring <> RESULT_SMALLSTRING then - failed := true; - if global_ptr <> value_ptr then - failed := true; -{ if value_class <> global_class then - failed := true;!!!!!!!!!!!!!!!!!!!!} - if global_s64bit <> RESULT_S64BIT then - failed := true; - if assigned(value_class) then - value_class.destroy; - - global_u8bit := 0; - proc_value_smallarray_const_2_mixed(byte(NOT RESULT_U8BIT), [], RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$endif} - - 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 } +{ (value parameters with popstack calling convention) } +{****************************************************************} +program tcalval5; + +{$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_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; +{$ifndef tp} + global_s64bit := 0; + global_class := nil; +{$endif} + 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; +{$ifndef tp} + value_s64bit := 0; + value_class := nil; +{$endif} + end; + + + procedure testprocedure; + begin + end; + + function getu8bit : byte; + begin + getu8bit:=RESULT_U8BIT; + end; + + function getu16bit: word; + begin + getu16bit:=RESULT_U16BIT; + end; + + function gets32bit: longint; + begin + gets32bit:=RESULT_S32BIT; + end; + + function gets64bit: int64; + begin + gets64bit:=RESULT_S64BIT; + end; + + + function gets32real: single; + begin + gets32real:=RESULT_S32REAL; + end; + + function gets64real: double; + begin + gets64real:=RESULT_S64REAL; + end; + +{ ***************************************************************** } +{ VALUE PARAMETERS } +{ ***************************************************************** } + + procedure proc_value_u8bit(v: byte);popstack; + begin + global_u8bit := v; + end; + + + procedure proc_value_u16bit(v: word);popstack; + begin + global_u16bit := v; + end; + + + procedure proc_value_s32bit(v : longint);popstack; + begin + global_s32bit := v; + end; + + + + + procedure proc_value_bool8bit(v: boolean);popstack; + begin + { boolean should be 8-bit always! } + if sizeof(boolean) <> 1 then RunError(255); + global_u8bit := byte(v); + end; + + + procedure proc_value_bool16bit(v: wordbool);popstack; + begin + global_u16bit := word(v); + end; + + + procedure proc_value_bool32bit(v : longbool);popstack; + begin + global_s32bit := longint(v); + end; + + + procedure proc_value_s32real(v : single);popstack; + begin + global_s32real := v; + end; + + procedure proc_value_s64real(v: double);popstack; + begin + global_s64real:= v; + end; + + + procedure proc_value_pointerdef(p : pchar);popstack; + begin + global_ptr:=p; + end; + + + procedure proc_value_procvardef(p : tprocedure);popstack; + begin + global_proc:=p; + end; + + + + + procedure proc_value_smallrecord(smallrec : tsmallrecord);popstack; + begin + if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_value_largerecord(largerec : tlargerecord);popstack; + begin + if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_value_smallset(smallset : tsmallset);popstack; + begin + if A_D in smallset then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_value_largeset(largeset : tlargeset);popstack; + begin + if 'I' in largeset then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_value_smallstring(s:tsmallstring);popstack; + begin + if s = RESULT_SMALLSTRING then + global_u8bit := RESULT_u8BIT; + end; + + + procedure proc_value_bigstring(s:shortstring);popstack; + begin + if s = RESULT_BIGSTRING then + global_u8bit := RESULT_u8BIT; + end; + + + procedure proc_value_smallarray(arr : tsmallarray);popstack; + begin + if arr[SMALL_INDEX] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_value_smallarray_open(arr : array of byte);popstack; + begin + { form 0 to N-1 indexes in open arrays } + if arr[SMALL_INDEX-1] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + end; + +{$ifndef tp} + procedure proc_value_classrefdef(obj : tclass1);popstack; + begin + global_class:=obj; + end; + + + procedure proc_value_smallarray_const_1(arr : array of const);popstack; + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : global_u8bit := arr[i].vinteger and $ff; + vtBoolean : global_boolean := arr[i].vboolean; + vtChar : global_char := arr[i].vchar; + vtExtended : global_s64real := arr[i].VExtended^; + vtString : global_bigstring := arr[i].VString^; + vtPointer : ; + vtPChar : global_ptr := arr[i].VPchar; + vtObject : ; +{ vtClass : global_class := (arr[i].VClass) as tclass1;} + vtAnsiString : ; + vtInt64 : global_s64bit := arr[i].vInt64^; + else + RunError(255); + end; + end; {endfor} + end; + + + procedure proc_value_smallarray_const_2(arr : array of const);popstack; + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_value_s64bit(v: int64);popstack; + begin + global_s64bit:= v; + end; +{$endif} + + {********************************* MIXED PARAMETERS *************************} + + procedure proc_value_u8bit_mixed(b1 : byte; v: byte; b2: byte);popstack; + begin + global_u8bit := v; + value_u8bit := b2; + end; + + + procedure proc_value_u16bit_mixed(b1: byte; v: word; b2: byte);popstack; + begin + global_u16bit := v; + value_u8bit := b2; + end; + + + procedure proc_value_s32bit_mixed(b1 : byte; v : longint; b2: byte);popstack; + begin + global_s32bit := v; + value_u8bit := b2; + end; + + + + + procedure proc_value_bool8bit_mixed(b1: byte; v: boolean; b2: byte);popstack; + begin + { boolean should be 8-bit always! } + if sizeof(boolean) <> 1 then RunError(255); + global_u8bit := byte(v); + value_u8bit := b2; + end; + + + procedure proc_value_bool16bit_mixed(b1 : byte; v: wordbool; b2: byte);popstack; + begin + global_u16bit := word(v); + value_u8bit := b2; + end; + + + procedure proc_value_bool32bit_mixed(b1 : byte; v : longbool; b2: byte);popstack; + begin + global_s32bit := longint(v); + value_u8bit := b2; + end; + + + procedure proc_value_s32real_mixed(b1: byte; v : single; b2: byte);popstack; + begin + global_s32real := v; + value_u8bit := b2; + end; + + procedure proc_value_s64real_mixed(b1: byte; v: double; b2: byte);popstack; + begin + global_s64real:= v; + value_u8bit := b2; + end; + + + procedure proc_value_pointerdef_mixed(b1: byte; p : pchar; b2: byte);popstack; + begin + global_ptr:=p; + value_u8bit := b2; + end; + + + procedure proc_value_procvardef_mixed(b1: byte; p : tprocedure; b2: byte);popstack; + begin + global_proc:=p; + value_u8bit := b2; + end; + + + + + procedure proc_value_smallrecord_mixed(b1: byte; smallrec : tsmallrecord; b2: byte);popstack; + begin + if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + procedure proc_value_largerecord_mixed(b1: byte; largerec : tlargerecord; b2: byte);popstack; + begin + if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + procedure proc_value_smallset_mixed(b1: byte; smallset : tsmallset; b2: byte);popstack; + begin + if A_D in smallset then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + procedure proc_value_largeset_mixed(b1: byte; largeset : tlargeset; b2: byte);popstack; + begin + if 'I' in largeset then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + procedure proc_value_smallstring_mixed(b1: byte; s:tsmallstring; b2: byte);popstack; + begin + if s = RESULT_SMALLSTRING then + global_u8bit := RESULT_u8BIT; + value_u8bit := b2; + end; + + + procedure proc_value_bigstring_mixed(b1: byte; s:shortstring; b2: byte);popstack; + begin + if s = RESULT_BIGSTRING then + global_u8bit := RESULT_u8BIT; + value_u8bit := b2; + end; + + + procedure proc_value_smallarray_mixed(b1: byte; arr : tsmallarray; b2: byte);popstack; + begin + if arr[SMALL_INDEX] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + procedure proc_value_smallarray_open_mixed(b1: byte; arr : array of byte; b2: byte);popstack; + begin + { form 0 to N-1 indexes in open arrays } + if arr[SMALL_INDEX-1] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + +{$ifndef tp} + procedure proc_value_classrefdef_mixed(b1: byte; obj : tclass1; b2: byte);popstack; + begin + global_class:=obj; + value_u8bit := b2; + end; + + + procedure proc_value_s64bit_mixed(b1 : byte; v: int64; b2: byte);popstack; + begin + global_s64bit:= v; + value_u8bit := b2; + end; + + + procedure proc_value_smallarray_const_1_mixed(b1: byte; arr : array of const; b2: byte);popstack; + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : global_u8bit := arr[i].vinteger and $ff; + vtBoolean : global_boolean := arr[i].vboolean; + vtChar : global_char := arr[i].vchar; + vtExtended : global_s64real := arr[i].VExtended^; + vtString : global_bigstring := arr[i].VString^; + vtPointer : ; + vtPChar : global_ptr := arr[i].VPchar; + vtObject : ; +{ vtClass : global_class := (arr[i].VClass) as tclass1;} + vtAnsiString : ; + vtInt64 : global_s64bit := arr[i].vInt64^; + else + RunError(255); + end; + end; {endfor} + value_u8bit := b2; + end; + + + procedure proc_value_smallarray_const_2_mixed(b1: byte; arr : array of const; b2: byte);popstack; + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; +{$endif} + + + +var + failed: boolean; +Begin + {***************************** NORMAL TESTS *******************************} + clear_globals; + clear_values; + + failed:=false; + + { LOC_REGISTER } + write('Value parameter test (src : LOC_REGISTER)...'); + proc_value_u8bit(getu8bit); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + proc_value_u16bit(getu16bit); + if global_u16bit <> RESULT_U16BIT then + failed:=true; + proc_value_s32bit(gets32bit); + if global_s32bit <> RESULT_S32BIT then + failed:=true; +{$ifndef tp} + proc_value_s64bit(gets64bit); + if global_s64bit <> RESULT_S64BIT then + failed:=true; +{$endif} + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_FPUREGISTER } + clear_globals; + clear_values; + failed:=false; + write('Value parameter test (src : LOC_FPUREGISTER)...'); + proc_value_s32real(gets32real); + if trunc(global_s32real) <> trunc(RESULT_S32REAL) then + failed:=true; + proc_value_s64real(gets64real); + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed:=true; + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_MEM, LOC_REFERENCE orddef } + clear_globals; + clear_values; + value_u8bit := RESULT_U8BIT; + value_u16bit := RESULT_U16BIT; + value_s32bit := RESULT_S32BIT; +{$ifndef tp} + value_s64bit := RESULT_S64BIT; +{$endif} + value_s32real := RESULT_S32REAL; + value_s64real := RESULT_S64REAL; + + failed:=false; + + { LOC_REFERENCE } + write('Value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...'); + proc_value_u8bit(value_u8bit); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + proc_value_u16bit(value_u16bit); + if global_u16bit <> RESULT_U16BIT then + failed:=true; + proc_value_s32bit(value_s32bit); + if global_s32bit <> RESULT_S32BIT then + failed:=true; +{$ifndef tp} + proc_value_s64bit(value_s64bit); + if global_s64bit <> RESULT_S64BIT then + failed:=true; +{$endif} + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_REFERENCE } + clear_globals; + failed:=false; + write('Value parameter test (src : LOC_REFERENCE (floatdef))...'); + proc_value_s32real(value_s32real); + if trunc(global_s32real) <> trunc(RESULT_S32REAL) then + failed:=true; + proc_value_s64real(value_s64real); + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed:=true; + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Value parameter test (src : LOC_REFERENCE (pointer))...'); + clear_globals; + clear_values; + failed:=false; + value_ptr := RESULT_PCHAR; + proc_value_pointerdef(value_ptr); + if global_ptr <> value_ptr then + failed := true; + + + value_proc := {$ifndef tp}@{$endif}testprocedure; + proc_value_procvardef(value_proc); + if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then + failed := true; + +{$ifndef tp} + value_class := tclass1.create; + proc_value_classrefdef(value_class); + if value_class <> global_class then + failed := true; + value_class.destroy; +{$endif} + if failed then + fail + else + WriteLn('Passed!'); + + + + + { LOC_REFERENCE } + clear_globals; + clear_values; + failed:=false; + value_u8bit := 0; + write('Value parameter test (src : LOC_FLAGS (orddef)))...'); + proc_value_bool8bit(value_u8bit = 0); + if global_u8bit <> RESULT_BOOL8BIT then + failed:=true; +{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x + proc_value_bool16bit(value_s64bit < 0); + if global_u16bit <> RESULT_BOOL16BIT then + failed:=true; + proc_value_bool32bit(bool1 and bool2); + if global_s32bit <> RESULT_BOOL32BIT then + failed:=true;*} + if failed then + fail + else + WriteLn('Passed!'); + + + +{$ifndef tp} + clear_globals; + clear_values; + failed:=false; + write('Value parameter test (src : LOC_JUMP (orddef)))...'); + proc_value_bool8bit(value_s64bit = 0); + if global_u8bit <> RESULT_BOOL8BIT then + failed:=true; +{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x + proc_value_bool16bit(value_s64bit < 0); + if global_u16bit <> RESULT_BOOL16BIT then + failed:=true; + proc_value_bool32bit(bool1 and bool2); + if global_s32bit <> RESULT_BOOL32BIT then + failed:=true;*} + if failed then + fail + else + WriteLn('Passed!'); +{$endif} + + { arraydef, + recorddef, + objectdef, + stringdef, + setdef : all considered the same by code generator. + } + write('Value parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallrec.b := RESULT_U8BIT; + value_smallrec.w := RESULT_U16BIT; + proc_value_smallrecord(value_smallrec); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); + proc_value_largerecord(value_largerec); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Value parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallset := [A_A,A_D]; + proc_value_smallset(value_smallset); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_largeset := ['I']; + proc_value_largeset(value_largeset); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + + + write('Value parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + value_smallstring := RESULT_SMALLSTRING; + + proc_value_smallstring(value_smallstring); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_bigstring := RESULT_BIGSTRING; + proc_value_bigstring(value_bigstring); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!} + { DON'T KNOW WHY/HOW TO TEST!!!!! } + + + write('Value parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + fillchar(value_smallarray,sizeof(value_smallarray),#0); + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_value_smallarray(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + fillchar(value_smallarray,sizeof(value_smallarray),#0); + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_value_smallarray_open(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + +{$ifndef tp} + clear_globals; + clear_values; + + value_u8bit := RESULT_U8BIT; + value_ptr := RESULT_PCHAR; + value_s64bit := RESULT_S64BIT; + value_smallstring := RESULT_SMALLSTRING; + value_class := tclass1.create; + value_boolean := RESULT_BOOLEAN; + value_char := RESULT_CHAR; + value_s64real:=RESULT_S64REAL; + proc_value_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real, + value_boolean,value_class]); + + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if global_char <> RESULT_CHAR then + failed := true; + if global_boolean <> RESULT_BOOLEAN then + failed:=true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed := true; + if global_bigstring <> RESULT_SMALLSTRING then + failed := true; + if global_ptr <> value_ptr then + failed := true; +{ if value_class <> global_class then + failed := true;!!!!!!!!!!!!!!!!!!!!} + if global_s64bit <> RESULT_S64BIT then + failed := true; + if assigned(value_class) then + value_class.destroy; + + global_u8bit := 0; + proc_value_smallarray_const_2([]); + if global_u8bit <> RESULT_U8BIT then + failed := true; +{$endif fpc} + + if failed then + fail + else + WriteLn('Passed!'); + + {***************************** MIXED TESTS *******************************} + clear_globals; + clear_values; + + failed:=false; + + { LOC_REGISTER } + write('Mixed value parameter test (src : LOC_REGISTER)...'); + proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),getu8bit,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + proc_value_u16bit_mixed(byte(NOT RESULT_U8BIT),getu16bit,RESULT_U8BIT); + if global_u16bit <> RESULT_U16BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + proc_value_s32bit_mixed(byte(NOT RESULT_U8BIT),gets32bit, RESULT_U8BIT); + if global_s32bit <> RESULT_S32BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$ifndef tp} + proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT),gets64bit,RESULT_U8BIT); + if global_s64bit <> RESULT_S64BIT then + failed:=true; +{$endif} + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_FPUREGISTER } + clear_globals; + clear_values; + failed:=false; + write('Mixed value parameter test (src : LOC_FPUREGISTER)...'); + proc_value_s32real_mixed(byte(NOT RESULT_U8BIT), gets32real, RESULT_U8BIT); + if value_u8bit <> RESULT_U8BIT then + failed := true; + if trunc(global_s32real) <> trunc(RESULT_S32REAL) then + failed:=true; + proc_value_s64real_mixed(byte(NOT RESULT_U8BIT),gets64real,RESULT_U8BIT); + if value_u8bit <> RESULT_U8BIT then + failed := true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed:=true; + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_MEM, LOC_REFERENCE orddef } + clear_globals; + clear_values; + value_u8bit := RESULT_U8BIT; + value_u16bit := RESULT_U16BIT; + value_s32bit := RESULT_S32BIT; +{$ifndef tp} + value_s64bit := RESULT_S64BIT; +{$endif} + value_s32real := RESULT_S32REAL; + value_s64real := RESULT_S64REAL; + + failed:=false; + + { LOC_REFERENCE } + write('Mixed value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...'); + proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),value_u8bit, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + proc_value_u16bit_mixed(byte(NOT RESULT_U8BIT),value_u16bit, RESULT_U8BIT); + if global_u16bit <> RESULT_U16BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + proc_value_s32bit_mixed(byte(NOT RESULT_U8BIT),value_s32bit, RESULT_U8BIT); + if global_s32bit <> RESULT_S32BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$ifndef tp} + proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit, RESULT_U8BIT); + if global_s64bit <> RESULT_S64BIT then + failed:=true; +{$endif} + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_REFERENCE } + clear_globals; + failed:=false; + write('Mixed value parameter test (src : LOC_REFERENCE (floatdef))...'); + proc_value_s32real_mixed(byte(NOT RESULT_U8BIT), value_s32real, RESULT_U8BIT); + if trunc(global_s32real) <> trunc(RESULT_S32REAL) then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + proc_value_s64real_mixed(byte(NOT RESULT_U8BIT), value_s64real, RESULT_U8BIT); + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Mixed value parameter test (src : LOC_REFERENCE (pointer))...'); + clear_globals; + clear_values; + failed:=false; + value_ptr := RESULT_PCHAR; + proc_value_pointerdef_mixed(byte(NOT RESULT_U8BIT), value_ptr, RESULT_U8BIT); + if global_ptr <> value_ptr then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + + value_proc := {$ifndef tp}@{$endif}testprocedure; + proc_value_procvardef_mixed(byte(NOT RESULT_U8BIT), value_proc, RESULT_U8BIT); + if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then + failed := true; + +{$ifndef tp} + value_class := tclass1.create; + proc_value_classrefdef_mixed(byte(NOT RESULT_U8BIT), value_class, RESULT_U8BIT); + if value_class <> global_class then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + value_class.destroy; +{$endif} + if failed then + fail + else + WriteLn('Passed!'); + + + + + { LOC_REFERENCE } + clear_globals; + clear_values; + failed:=false; + value_u8bit := 0; + write('Mixed value parameter test (src : LOC_FLAGS (orddef)))...'); + proc_value_bool8bit_mixed(byte(NOT RESULT_U8BIT), value_u8bit = 0, RESULT_U8BIT); + if global_u8bit <> RESULT_BOOL8BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x + proc_value_bool16bit(value_s64bit < 0); + if global_u16bit <> RESULT_BOOL16BIT then + failed:=true; + proc_value_bool32bit(bool1 and bool2); + if global_s32bit <> RESULT_BOOL32BIT then + failed:=true;*} + if failed then + fail + else + WriteLn('Passed!'); + + + +{$ifndef tp} + clear_globals; + clear_values; + failed:=false; + write('Mixed value parameter test (src : LOC_JUMP (orddef)))...'); + proc_value_bool8bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit = 0, RESULT_U8BIT); + if global_u8bit <> RESULT_BOOL8BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x + proc_value_bool16bit(value_s64bit < 0); + if global_u16bit <> RESULT_BOOL16BIT then + failed:=true; + proc_value_bool32bit(bool1 and bool2); + if global_s32bit <> RESULT_BOOL32BIT then + failed:=true;*} + if failed then + fail + else + WriteLn('Passed!'); +{$endif} + + { arraydef, + recorddef, + objectdef, + stringdef, + setdef : all considered the same by code generator. + } + write('Mixed value parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallrec.b := RESULT_U8BIT; + value_smallrec.w := RESULT_U16BIT; + proc_value_smallrecord_mixed(byte(NOT RESULT_U8BIT), value_smallrec, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); + proc_value_largerecord_mixed(byte(NOT RESULT_U8BIT), value_largerec, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Mixed value parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallset := [A_A,A_D]; + proc_value_smallset_mixed(byte(NOT RESULT_U8BIT), value_smallset, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_largeset := ['I']; + proc_value_largeset_mixed(byte(NOT RESULT_U8BIT), value_largeset, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + + + write('Mixed value parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + value_smallstring := RESULT_SMALLSTRING; + + proc_value_smallstring_mixed(byte(NOT RESULT_U8BIT), value_smallstring, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_bigstring := RESULT_BIGSTRING; + proc_value_bigstring_mixed(byte(NOT RESULT_U8BIT), value_bigstring, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!} + { DON'T KNOW WHY/HOW TO TEST!!!!! } + + + write('Mixed value parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + fillchar(value_smallarray,sizeof(value_smallarray),#0); + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_value_smallarray_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + fillchar(value_smallarray,sizeof(value_smallarray),#0); + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_value_smallarray_open_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + +{$ifndef tp} + clear_globals; + clear_values; + + value_u8bit := RESULT_U8BIT; + value_ptr := RESULT_PCHAR; + value_s64bit := RESULT_S64BIT; + value_smallstring := RESULT_SMALLSTRING; + value_class := tclass1.create; + value_boolean := RESULT_BOOLEAN; + value_char := RESULT_CHAR; + value_s64real:=RESULT_S64REAL; + proc_value_smallarray_const_1_mixed(byte(NOT RESULT_U8BIT), [value_u8bit,value_ptr,value_s64bit,value_char, + value_smallstring,value_s64real,value_boolean,value_class], + RESULT_U8BIT); + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if global_char <> RESULT_CHAR then + failed := true; + if global_boolean <> RESULT_BOOLEAN then + failed:=true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed := true; + if global_bigstring <> RESULT_SMALLSTRING then + failed := true; + if global_ptr <> value_ptr then + failed := true; +{ if value_class <> global_class then + failed := true;!!!!!!!!!!!!!!!!!!!!} + if global_s64bit <> RESULT_S64BIT then + failed := true; + if assigned(value_class) then + value_class.destroy; + + global_u8bit := 0; + proc_value_smallarray_const_2_mixed(byte(NOT RESULT_U8BIT), [], RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$endif} + + if failed then + fail + else + WriteLn('Passed!'); + +end. + + +{ $Log$ - Revision 1.4 2002-09-22 09:08:41 carl - * gets64bit was not returning an int64! - - Revision 1.3 2002/09/07 15:40:55 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:49:45 carl - + value parameter passing for different calling conventions - -} + Revision 1.5 2003-04-22 10:24:29 florian + * fixed defines for powerpc + + Revision 1.4 2002/09/22 09:08:41 carl + * gets64bit was not returning an int64! + + Revision 1.3 2002/09/07 15:40:55 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:49:45 carl + + value parameter passing for different calling conventions + +} diff --git a/tests/test/cg/tcalval6.pp b/tests/test/cg/tcalval6.pp index 8e260ebb5c..9b8bde120b 100644 --- a/tests/test/cg/tcalval6.pp +++ b/tests/test/cg/tcalval6.pp @@ -1,1306 +1,1308 @@ -{****************************************************************} -{ 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 } -{ (value parameters with safecall calling convention) } -{****************************************************************} -program tcalval6; - -{$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; - {$endif} - {$ifdef cpui386} - 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_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; -{$ifndef tp} - global_s64bit := 0; - global_class := nil; -{$endif} - 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; -{$ifndef tp} - value_s64bit := 0; - value_class := nil; -{$endif} - end; - - - procedure testprocedure; - begin - end; - - function getu8bit : byte; - begin - getu8bit:=RESULT_U8BIT; - end; - - function getu16bit: word; - begin - getu16bit:=RESULT_U16BIT; - end; - - function gets32bit: longint; - begin - gets32bit:=RESULT_S32BIT; - end; - - function gets64bit: int64; - begin - gets64bit:=RESULT_S64BIT; - end; - - - function gets32real: single; - begin - gets32real:=RESULT_S32REAL; - end; - - function gets64real: double; - begin - gets64real:=RESULT_S64REAL; - end; - -{ ***************************************************************** } -{ VALUE PARAMETERS } -{ ***************************************************************** } - - procedure proc_value_u8bit(v: byte);safecall; - begin - global_u8bit := v; - end; - - - procedure proc_value_u16bit(v: word);safecall; - begin - global_u16bit := v; - end; - - - procedure proc_value_s32bit(v : longint);safecall; - begin - global_s32bit := v; - end; - - - - - procedure proc_value_bool8bit(v: boolean);safecall; - begin - { boolean should be 8-bit always! } - if sizeof(boolean) <> 1 then RunError(255); - global_u8bit := byte(v); - end; - - - procedure proc_value_bool16bit(v: wordbool);safecall; - begin - global_u16bit := word(v); - end; - - - procedure proc_value_bool32bit(v : longbool);safecall; - begin - global_s32bit := longint(v); - end; - - - procedure proc_value_s32real(v : single);safecall; - begin - global_s32real := v; - end; - - procedure proc_value_s64real(v: double);safecall; - begin - global_s64real:= v; - end; - - - procedure proc_value_pointerdef(p : pchar);safecall; - begin - global_ptr:=p; - end; - - - procedure proc_value_procvardef(p : tprocedure);safecall; - begin - global_proc:=p; - end; - - - - - procedure proc_value_smallrecord(smallrec : tsmallrecord);safecall; - begin - if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_value_largerecord(largerec : tlargerecord);safecall; - begin - if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_value_smallset(smallset : tsmallset);safecall; - begin - if A_D in smallset then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_value_largeset(largeset : tlargeset);safecall; - begin - if 'I' in largeset then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_value_smallstring(s:tsmallstring);safecall; - begin - if s = RESULT_SMALLSTRING then - global_u8bit := RESULT_u8BIT; - end; - - - procedure proc_value_bigstring(s:shortstring);safecall; - begin - if s = RESULT_BIGSTRING then - global_u8bit := RESULT_u8BIT; - end; - - - procedure proc_value_smallarray(arr : tsmallarray);safecall; - begin - if arr[SMALL_INDEX] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_value_smallarray_open(arr : array of byte);safecall; - begin - { form 0 to N-1 indexes in open arrays } - if arr[SMALL_INDEX-1] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - end; - -{$ifndef tp} - procedure proc_value_classrefdef(obj : tclass1);safecall; - begin - global_class:=obj; - end; - - - procedure proc_value_smallarray_const_1(arr : array of const);safecall; - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : global_u8bit := arr[i].vinteger and $ff; - vtBoolean : global_boolean := arr[i].vboolean; - vtChar : global_char := arr[i].vchar; - vtExtended : global_s64real := arr[i].VExtended^; - vtString : global_bigstring := arr[i].VString^; - vtPointer : ; - vtPChar : global_ptr := arr[i].VPchar; - vtObject : ; -{ vtClass : global_class := (arr[i].VClass) as tclass1;} - vtAnsiString : ; - vtInt64 : global_s64bit := arr[i].vInt64^; - else - RunError(255); - end; - end; {endfor} - end; - - - procedure proc_value_smallarray_const_2(arr : array of const);safecall; - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_value_s64bit(v: int64);safecall; - begin - global_s64bit:= v; - end; -{$endif} - - {********************************* MIXED PARAMETERS *************************} - - procedure proc_value_u8bit_mixed(b1 : byte; v: byte; b2: byte);safecall; - begin - global_u8bit := v; - value_u8bit := b2; - end; - - - procedure proc_value_u16bit_mixed(b1: byte; v: word; b2: byte);safecall; - begin - global_u16bit := v; - value_u8bit := b2; - end; - - - procedure proc_value_s32bit_mixed(b1 : byte; v : longint; b2: byte);safecall; - begin - global_s32bit := v; - value_u8bit := b2; - end; - - - - - procedure proc_value_bool8bit_mixed(b1: byte; v: boolean; b2: byte);safecall; - begin - { boolean should be 8-bit always! } - if sizeof(boolean) <> 1 then RunError(255); - global_u8bit := byte(v); - value_u8bit := b2; - end; - - - procedure proc_value_bool16bit_mixed(b1 : byte; v: wordbool; b2: byte);safecall; - begin - global_u16bit := word(v); - value_u8bit := b2; - end; - - - procedure proc_value_bool32bit_mixed(b1 : byte; v : longbool; b2: byte);safecall; - begin - global_s32bit := longint(v); - value_u8bit := b2; - end; - - - procedure proc_value_s32real_mixed(b1: byte; v : single; b2: byte);safecall; - begin - global_s32real := v; - value_u8bit := b2; - end; - - procedure proc_value_s64real_mixed(b1: byte; v: double; b2: byte);safecall; - begin - global_s64real:= v; - value_u8bit := b2; - end; - - - procedure proc_value_pointerdef_mixed(b1: byte; p : pchar; b2: byte);safecall; - begin - global_ptr:=p; - value_u8bit := b2; - end; - - - procedure proc_value_procvardef_mixed(b1: byte; p : tprocedure; b2: byte);safecall; - begin - global_proc:=p; - value_u8bit := b2; - end; - - - - - procedure proc_value_smallrecord_mixed(b1: byte; smallrec : tsmallrecord; b2: byte);safecall; - begin - if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - procedure proc_value_largerecord_mixed(b1: byte; largerec : tlargerecord; b2: byte);safecall; - begin - if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - procedure proc_value_smallset_mixed(b1: byte; smallset : tsmallset; b2: byte);safecall; - begin - if A_D in smallset then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - procedure proc_value_largeset_mixed(b1: byte; largeset : tlargeset; b2: byte);safecall; - begin - if 'I' in largeset then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - procedure proc_value_smallstring_mixed(b1: byte; s:tsmallstring; b2: byte);safecall; - begin - if s = RESULT_SMALLSTRING then - global_u8bit := RESULT_u8BIT; - value_u8bit := b2; - end; - - - procedure proc_value_bigstring_mixed(b1: byte; s:shortstring; b2: byte);safecall; - begin - if s = RESULT_BIGSTRING then - global_u8bit := RESULT_u8BIT; - value_u8bit := b2; - end; - - - procedure proc_value_smallarray_mixed(b1: byte; arr : tsmallarray; b2: byte);safecall; - begin - if arr[SMALL_INDEX] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - procedure proc_value_smallarray_open_mixed(b1: byte; arr : array of byte; b2: byte);safecall; - begin - { form 0 to N-1 indexes in open arrays } - if arr[SMALL_INDEX-1] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - -{$ifndef tp} - procedure proc_value_classrefdef_mixed(b1: byte; obj : tclass1; b2: byte);safecall; - begin - global_class:=obj; - value_u8bit := b2; - end; - - - procedure proc_value_s64bit_mixed(b1 : byte; v: int64; b2: byte);safecall; - begin - global_s64bit:= v; - value_u8bit := b2; - end; - - - procedure proc_value_smallarray_const_1_mixed(b1: byte; arr : array of const; b2: byte);safecall; - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : global_u8bit := arr[i].vinteger and $ff; - vtBoolean : global_boolean := arr[i].vboolean; - vtChar : global_char := arr[i].vchar; - vtExtended : global_s64real := arr[i].VExtended^; - vtString : global_bigstring := arr[i].VString^; - vtPointer : ; - vtPChar : global_ptr := arr[i].VPchar; - vtObject : ; -{ vtClass : global_class := (arr[i].VClass) as tclass1;} - vtAnsiString : ; - vtInt64 : global_s64bit := arr[i].vInt64^; - else - RunError(255); - end; - end; {endfor} - value_u8bit := b2; - end; - - - procedure proc_value_smallarray_const_2_mixed(b1: byte; arr : array of const; b2: byte);safecall; - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; -{$endif} - - - -var - failed: boolean; -Begin - {***************************** NORMAL TESTS *******************************} - clear_globals; - clear_values; - - failed:=false; - - { LOC_REGISTER } - write('Value parameter test (src : LOC_REGISTER)...'); - proc_value_u8bit(getu8bit); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - proc_value_u16bit(getu16bit); - if global_u16bit <> RESULT_U16BIT then - failed:=true; - proc_value_s32bit(gets32bit); - if global_s32bit <> RESULT_S32BIT then - failed:=true; -{$ifndef tp} - proc_value_s64bit(gets64bit); - if global_s64bit <> RESULT_S64BIT then - failed:=true; -{$endif} - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_FPUREGISTER } - clear_globals; - clear_values; - failed:=false; - write('Value parameter test (src : LOC_FPUREGISTER)...'); - proc_value_s32real(gets32real); - if trunc(global_s32real) <> trunc(RESULT_S32REAL) then - failed:=true; - proc_value_s64real(gets64real); - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed:=true; - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_MEM, LOC_REFERENCE orddef } - clear_globals; - clear_values; - value_u8bit := RESULT_U8BIT; - value_u16bit := RESULT_U16BIT; - value_s32bit := RESULT_S32BIT; -{$ifndef tp} - value_s64bit := RESULT_S64BIT; -{$endif} - value_s32real := RESULT_S32REAL; - value_s64real := RESULT_S64REAL; - - failed:=false; - - { LOC_REFERENCE } - write('Value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...'); - proc_value_u8bit(value_u8bit); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - proc_value_u16bit(value_u16bit); - if global_u16bit <> RESULT_U16BIT then - failed:=true; - proc_value_s32bit(value_s32bit); - if global_s32bit <> RESULT_S32BIT then - failed:=true; -{$ifndef tp} - proc_value_s64bit(value_s64bit); - if global_s64bit <> RESULT_S64BIT then - failed:=true; -{$endif} - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_REFERENCE } - clear_globals; - failed:=false; - write('Value parameter test (src : LOC_REFERENCE (floatdef))...'); - proc_value_s32real(value_s32real); - if trunc(global_s32real) <> trunc(RESULT_S32REAL) then - failed:=true; - proc_value_s64real(value_s64real); - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed:=true; - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Value parameter test (src : LOC_REFERENCE (pointer))...'); - clear_globals; - clear_values; - failed:=false; - value_ptr := RESULT_PCHAR; - proc_value_pointerdef(value_ptr); - if global_ptr <> value_ptr then - failed := true; - - - value_proc := {$ifndef tp}@{$endif}testprocedure; - proc_value_procvardef(value_proc); - if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then - failed := true; - -{$ifndef tp} - value_class := tclass1.create; - proc_value_classrefdef(value_class); - if value_class <> global_class then - failed := true; - value_class.destroy; -{$endif} - if failed then - fail - else - WriteLn('Passed!'); - - - - - { LOC_REFERENCE } - clear_globals; - clear_values; - failed:=false; - value_u8bit := 0; - write('Value parameter test (src : LOC_FLAGS (orddef)))...'); - proc_value_bool8bit(value_u8bit = 0); - if global_u8bit <> RESULT_BOOL8BIT then - failed:=true; -{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x - proc_value_bool16bit(value_s64bit < 0); - if global_u16bit <> RESULT_BOOL16BIT then - failed:=true; - proc_value_bool32bit(bool1 and bool2); - if global_s32bit <> RESULT_BOOL32BIT then - failed:=true;*} - if failed then - fail - else - WriteLn('Passed!'); - - - -{$ifndef tp} - clear_globals; - clear_values; - failed:=false; - write('Value parameter test (src : LOC_JUMP (orddef)))...'); - proc_value_bool8bit(value_s64bit = 0); - if global_u8bit <> RESULT_BOOL8BIT then - failed:=true; -{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x - proc_value_bool16bit(value_s64bit < 0); - if global_u16bit <> RESULT_BOOL16BIT then - failed:=true; - proc_value_bool32bit(bool1 and bool2); - if global_s32bit <> RESULT_BOOL32BIT then - failed:=true;*} - if failed then - fail - else - WriteLn('Passed!'); -{$endif} - - { arraydef, - recorddef, - objectdef, - stringdef, - setdef : all considered the same by code generator. - } - write('Value parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallrec.b := RESULT_U8BIT; - value_smallrec.w := RESULT_U16BIT; - proc_value_smallrecord(value_smallrec); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); - proc_value_largerecord(value_largerec); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Value parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallset := [A_A,A_D]; - proc_value_smallset(value_smallset); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_largeset := ['I']; - proc_value_largeset(value_largeset); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - - - write('Value parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - value_smallstring := RESULT_SMALLSTRING; - - proc_value_smallstring(value_smallstring); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_bigstring := RESULT_BIGSTRING; - proc_value_bigstring(value_bigstring); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!} - { DON'T KNOW WHY/HOW TO TEST!!!!! } - - - write('Value parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - fillchar(value_smallarray,sizeof(value_smallarray),#0); - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_value_smallarray(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - fillchar(value_smallarray,sizeof(value_smallarray),#0); - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_value_smallarray_open(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - -{$ifndef tp} - clear_globals; - clear_values; - - value_u8bit := RESULT_U8BIT; - value_ptr := RESULT_PCHAR; - value_s64bit := RESULT_S64BIT; - value_smallstring := RESULT_SMALLSTRING; - value_class := tclass1.create; - value_boolean := RESULT_BOOLEAN; - value_char := RESULT_CHAR; - value_s64real:=RESULT_S64REAL; - proc_value_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real, - value_boolean,value_class]); - - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if global_char <> RESULT_CHAR then - failed := true; - if global_boolean <> RESULT_BOOLEAN then - failed:=true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed := true; - if global_bigstring <> RESULT_SMALLSTRING then - failed := true; - if global_ptr <> value_ptr then - failed := true; -{ if value_class <> global_class then - failed := true;!!!!!!!!!!!!!!!!!!!!} - if global_s64bit <> RESULT_S64BIT then - failed := true; - if assigned(value_class) then - value_class.destroy; - - global_u8bit := 0; - proc_value_smallarray_const_2([]); - if global_u8bit <> RESULT_U8BIT then - failed := true; -{$endif fpc} - - if failed then - fail - else - WriteLn('Passed!'); - - {***************************** MIXED TESTS *******************************} - clear_globals; - clear_values; - - failed:=false; - - { LOC_REGISTER } - write('Mixed value parameter test (src : LOC_REGISTER)...'); - proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),getu8bit,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - proc_value_u16bit_mixed(byte(NOT RESULT_U8BIT),getu16bit,RESULT_U8BIT); - if global_u16bit <> RESULT_U16BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - proc_value_s32bit_mixed(byte(NOT RESULT_U8BIT),gets32bit, RESULT_U8BIT); - if global_s32bit <> RESULT_S32BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$ifndef tp} - proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT),gets64bit,RESULT_U8BIT); - if global_s64bit <> RESULT_S64BIT then - failed:=true; -{$endif} - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_FPUREGISTER } - clear_globals; - clear_values; - failed:=false; - write('Mixed value parameter test (src : LOC_FPUREGISTER)...'); - proc_value_s32real_mixed(byte(NOT RESULT_U8BIT), gets32real, RESULT_U8BIT); - if value_u8bit <> RESULT_U8BIT then - failed := true; - if trunc(global_s32real) <> trunc(RESULT_S32REAL) then - failed:=true; - proc_value_s64real_mixed(byte(NOT RESULT_U8BIT),gets64real,RESULT_U8BIT); - if value_u8bit <> RESULT_U8BIT then - failed := true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed:=true; - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_MEM, LOC_REFERENCE orddef } - clear_globals; - clear_values; - value_u8bit := RESULT_U8BIT; - value_u16bit := RESULT_U16BIT; - value_s32bit := RESULT_S32BIT; -{$ifndef tp} - value_s64bit := RESULT_S64BIT; -{$endif} - value_s32real := RESULT_S32REAL; - value_s64real := RESULT_S64REAL; - - failed:=false; - - { LOC_REFERENCE } - write('Mixed value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...'); - proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),value_u8bit, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - proc_value_u16bit_mixed(byte(NOT RESULT_U8BIT),value_u16bit, RESULT_U8BIT); - if global_u16bit <> RESULT_U16BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - proc_value_s32bit_mixed(byte(NOT RESULT_U8BIT),value_s32bit, RESULT_U8BIT); - if global_s32bit <> RESULT_S32BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$ifndef tp} - proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit, RESULT_U8BIT); - if global_s64bit <> RESULT_S64BIT then - failed:=true; -{$endif} - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_REFERENCE } - clear_globals; - failed:=false; - write('Mixed value parameter test (src : LOC_REFERENCE (floatdef))...'); - proc_value_s32real_mixed(byte(NOT RESULT_U8BIT), value_s32real, RESULT_U8BIT); - if trunc(global_s32real) <> trunc(RESULT_S32REAL) then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - proc_value_s64real_mixed(byte(NOT RESULT_U8BIT), value_s64real, RESULT_U8BIT); - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Mixed value parameter test (src : LOC_REFERENCE (pointer))...'); - clear_globals; - clear_values; - failed:=false; - value_ptr := RESULT_PCHAR; - proc_value_pointerdef_mixed(byte(NOT RESULT_U8BIT), value_ptr, RESULT_U8BIT); - if global_ptr <> value_ptr then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - - value_proc := {$ifndef tp}@{$endif}testprocedure; - proc_value_procvardef_mixed(byte(NOT RESULT_U8BIT), value_proc, RESULT_U8BIT); - if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then - failed := true; - -{$ifndef tp} - value_class := tclass1.create; - proc_value_classrefdef_mixed(byte(NOT RESULT_U8BIT), value_class, RESULT_U8BIT); - if value_class <> global_class then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - value_class.destroy; -{$endif} - if failed then - fail - else - WriteLn('Passed!'); - - - - - { LOC_REFERENCE } - clear_globals; - clear_values; - failed:=false; - value_u8bit := 0; - write('Mixed value parameter test (src : LOC_FLAGS (orddef)))...'); - proc_value_bool8bit_mixed(byte(NOT RESULT_U8BIT), value_u8bit = 0, RESULT_U8BIT); - if global_u8bit <> RESULT_BOOL8BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x - proc_value_bool16bit(value_s64bit < 0); - if global_u16bit <> RESULT_BOOL16BIT then - failed:=true; - proc_value_bool32bit(bool1 and bool2); - if global_s32bit <> RESULT_BOOL32BIT then - failed:=true;*} - if failed then - fail - else - WriteLn('Passed!'); - - - -{$ifndef tp} - clear_globals; - clear_values; - failed:=false; - write('Mixed value parameter test (src : LOC_JUMP (orddef)))...'); - proc_value_bool8bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit = 0, RESULT_U8BIT); - if global_u8bit <> RESULT_BOOL8BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x - proc_value_bool16bit(value_s64bit < 0); - if global_u16bit <> RESULT_BOOL16BIT then - failed:=true; - proc_value_bool32bit(bool1 and bool2); - if global_s32bit <> RESULT_BOOL32BIT then - failed:=true;*} - if failed then - fail - else - WriteLn('Passed!'); -{$endif} - - { arraydef, - recorddef, - objectdef, - stringdef, - setdef : all considered the same by code generator. - } - write('Mixed value parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallrec.b := RESULT_U8BIT; - value_smallrec.w := RESULT_U16BIT; - proc_value_smallrecord_mixed(byte(NOT RESULT_U8BIT), value_smallrec, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); - proc_value_largerecord_mixed(byte(NOT RESULT_U8BIT), value_largerec, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Mixed value parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallset := [A_A,A_D]; - proc_value_smallset_mixed(byte(NOT RESULT_U8BIT), value_smallset, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_largeset := ['I']; - proc_value_largeset_mixed(byte(NOT RESULT_U8BIT), value_largeset, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - - - write('Mixed value parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - value_smallstring := RESULT_SMALLSTRING; - - proc_value_smallstring_mixed(byte(NOT RESULT_U8BIT), value_smallstring, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_bigstring := RESULT_BIGSTRING; - proc_value_bigstring_mixed(byte(NOT RESULT_U8BIT), value_bigstring, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!} - { DON'T KNOW WHY/HOW TO TEST!!!!! } - - - write('Mixed value parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - fillchar(value_smallarray,sizeof(value_smallarray),#0); - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_value_smallarray_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - fillchar(value_smallarray,sizeof(value_smallarray),#0); - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_value_smallarray_open_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - -{$ifndef tp} - clear_globals; - clear_values; - - value_u8bit := RESULT_U8BIT; - value_ptr := RESULT_PCHAR; - value_s64bit := RESULT_S64BIT; - value_smallstring := RESULT_SMALLSTRING; - value_class := tclass1.create; - value_boolean := RESULT_BOOLEAN; - value_char := RESULT_CHAR; - value_s64real:=RESULT_S64REAL; - proc_value_smallarray_const_1_mixed(byte(NOT RESULT_U8BIT), [value_u8bit,value_ptr,value_s64bit,value_char, - value_smallstring,value_s64real,value_boolean,value_class], - RESULT_U8BIT); - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if global_char <> RESULT_CHAR then - failed := true; - if global_boolean <> RESULT_BOOLEAN then - failed:=true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed := true; - if global_bigstring <> RESULT_SMALLSTRING then - failed := true; - if global_ptr <> value_ptr then - failed := true; -{ if value_class <> global_class then - failed := true;!!!!!!!!!!!!!!!!!!!!} - if global_s64bit <> RESULT_S64BIT then - failed := true; - if assigned(value_class) then - value_class.destroy; - - global_u8bit := 0; - proc_value_smallarray_const_2_mixed(byte(NOT RESULT_U8BIT), [], RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$endif} - - 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 } +{ (value parameters with safecall calling convention) } +{****************************************************************} +program tcalval6; + +{$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_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; +{$ifndef tp} + global_s64bit := 0; + global_class := nil; +{$endif} + 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; +{$ifndef tp} + value_s64bit := 0; + value_class := nil; +{$endif} + end; + + + procedure testprocedure; + begin + end; + + function getu8bit : byte; + begin + getu8bit:=RESULT_U8BIT; + end; + + function getu16bit: word; + begin + getu16bit:=RESULT_U16BIT; + end; + + function gets32bit: longint; + begin + gets32bit:=RESULT_S32BIT; + end; + + function gets64bit: int64; + begin + gets64bit:=RESULT_S64BIT; + end; + + + function gets32real: single; + begin + gets32real:=RESULT_S32REAL; + end; + + function gets64real: double; + begin + gets64real:=RESULT_S64REAL; + end; + +{ ***************************************************************** } +{ VALUE PARAMETERS } +{ ***************************************************************** } + + procedure proc_value_u8bit(v: byte);safecall; + begin + global_u8bit := v; + end; + + + procedure proc_value_u16bit(v: word);safecall; + begin + global_u16bit := v; + end; + + + procedure proc_value_s32bit(v : longint);safecall; + begin + global_s32bit := v; + end; + + + + + procedure proc_value_bool8bit(v: boolean);safecall; + begin + { boolean should be 8-bit always! } + if sizeof(boolean) <> 1 then RunError(255); + global_u8bit := byte(v); + end; + + + procedure proc_value_bool16bit(v: wordbool);safecall; + begin + global_u16bit := word(v); + end; + + + procedure proc_value_bool32bit(v : longbool);safecall; + begin + global_s32bit := longint(v); + end; + + + procedure proc_value_s32real(v : single);safecall; + begin + global_s32real := v; + end; + + procedure proc_value_s64real(v: double);safecall; + begin + global_s64real:= v; + end; + + + procedure proc_value_pointerdef(p : pchar);safecall; + begin + global_ptr:=p; + end; + + + procedure proc_value_procvardef(p : tprocedure);safecall; + begin + global_proc:=p; + end; + + + + + procedure proc_value_smallrecord(smallrec : tsmallrecord);safecall; + begin + if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_value_largerecord(largerec : tlargerecord);safecall; + begin + if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_value_smallset(smallset : tsmallset);safecall; + begin + if A_D in smallset then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_value_largeset(largeset : tlargeset);safecall; + begin + if 'I' in largeset then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_value_smallstring(s:tsmallstring);safecall; + begin + if s = RESULT_SMALLSTRING then + global_u8bit := RESULT_u8BIT; + end; + + + procedure proc_value_bigstring(s:shortstring);safecall; + begin + if s = RESULT_BIGSTRING then + global_u8bit := RESULT_u8BIT; + end; + + + procedure proc_value_smallarray(arr : tsmallarray);safecall; + begin + if arr[SMALL_INDEX] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_value_smallarray_open(arr : array of byte);safecall; + begin + { form 0 to N-1 indexes in open arrays } + if arr[SMALL_INDEX-1] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + end; + +{$ifndef tp} + procedure proc_value_classrefdef(obj : tclass1);safecall; + begin + global_class:=obj; + end; + + + procedure proc_value_smallarray_const_1(arr : array of const);safecall; + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : global_u8bit := arr[i].vinteger and $ff; + vtBoolean : global_boolean := arr[i].vboolean; + vtChar : global_char := arr[i].vchar; + vtExtended : global_s64real := arr[i].VExtended^; + vtString : global_bigstring := arr[i].VString^; + vtPointer : ; + vtPChar : global_ptr := arr[i].VPchar; + vtObject : ; +{ vtClass : global_class := (arr[i].VClass) as tclass1;} + vtAnsiString : ; + vtInt64 : global_s64bit := arr[i].vInt64^; + else + RunError(255); + end; + end; {endfor} + end; + + + procedure proc_value_smallarray_const_2(arr : array of const);safecall; + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_value_s64bit(v: int64);safecall; + begin + global_s64bit:= v; + end; +{$endif} + + {********************************* MIXED PARAMETERS *************************} + + procedure proc_value_u8bit_mixed(b1 : byte; v: byte; b2: byte);safecall; + begin + global_u8bit := v; + value_u8bit := b2; + end; + + + procedure proc_value_u16bit_mixed(b1: byte; v: word; b2: byte);safecall; + begin + global_u16bit := v; + value_u8bit := b2; + end; + + + procedure proc_value_s32bit_mixed(b1 : byte; v : longint; b2: byte);safecall; + begin + global_s32bit := v; + value_u8bit := b2; + end; + + + + + procedure proc_value_bool8bit_mixed(b1: byte; v: boolean; b2: byte);safecall; + begin + { boolean should be 8-bit always! } + if sizeof(boolean) <> 1 then RunError(255); + global_u8bit := byte(v); + value_u8bit := b2; + end; + + + procedure proc_value_bool16bit_mixed(b1 : byte; v: wordbool; b2: byte);safecall; + begin + global_u16bit := word(v); + value_u8bit := b2; + end; + + + procedure proc_value_bool32bit_mixed(b1 : byte; v : longbool; b2: byte);safecall; + begin + global_s32bit := longint(v); + value_u8bit := b2; + end; + + + procedure proc_value_s32real_mixed(b1: byte; v : single; b2: byte);safecall; + begin + global_s32real := v; + value_u8bit := b2; + end; + + procedure proc_value_s64real_mixed(b1: byte; v: double; b2: byte);safecall; + begin + global_s64real:= v; + value_u8bit := b2; + end; + + + procedure proc_value_pointerdef_mixed(b1: byte; p : pchar; b2: byte);safecall; + begin + global_ptr:=p; + value_u8bit := b2; + end; + + + procedure proc_value_procvardef_mixed(b1: byte; p : tprocedure; b2: byte);safecall; + begin + global_proc:=p; + value_u8bit := b2; + end; + + + + + procedure proc_value_smallrecord_mixed(b1: byte; smallrec : tsmallrecord; b2: byte);safecall; + begin + if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + procedure proc_value_largerecord_mixed(b1: byte; largerec : tlargerecord; b2: byte);safecall; + begin + if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + procedure proc_value_smallset_mixed(b1: byte; smallset : tsmallset; b2: byte);safecall; + begin + if A_D in smallset then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + procedure proc_value_largeset_mixed(b1: byte; largeset : tlargeset; b2: byte);safecall; + begin + if 'I' in largeset then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + procedure proc_value_smallstring_mixed(b1: byte; s:tsmallstring; b2: byte);safecall; + begin + if s = RESULT_SMALLSTRING then + global_u8bit := RESULT_u8BIT; + value_u8bit := b2; + end; + + + procedure proc_value_bigstring_mixed(b1: byte; s:shortstring; b2: byte);safecall; + begin + if s = RESULT_BIGSTRING then + global_u8bit := RESULT_u8BIT; + value_u8bit := b2; + end; + + + procedure proc_value_smallarray_mixed(b1: byte; arr : tsmallarray; b2: byte);safecall; + begin + if arr[SMALL_INDEX] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + procedure proc_value_smallarray_open_mixed(b1: byte; arr : array of byte; b2: byte);safecall; + begin + { form 0 to N-1 indexes in open arrays } + if arr[SMALL_INDEX-1] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + +{$ifndef tp} + procedure proc_value_classrefdef_mixed(b1: byte; obj : tclass1; b2: byte);safecall; + begin + global_class:=obj; + value_u8bit := b2; + end; + + + procedure proc_value_s64bit_mixed(b1 : byte; v: int64; b2: byte);safecall; + begin + global_s64bit:= v; + value_u8bit := b2; + end; + + + procedure proc_value_smallarray_const_1_mixed(b1: byte; arr : array of const; b2: byte);safecall; + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : global_u8bit := arr[i].vinteger and $ff; + vtBoolean : global_boolean := arr[i].vboolean; + vtChar : global_char := arr[i].vchar; + vtExtended : global_s64real := arr[i].VExtended^; + vtString : global_bigstring := arr[i].VString^; + vtPointer : ; + vtPChar : global_ptr := arr[i].VPchar; + vtObject : ; +{ vtClass : global_class := (arr[i].VClass) as tclass1;} + vtAnsiString : ; + vtInt64 : global_s64bit := arr[i].vInt64^; + else + RunError(255); + end; + end; {endfor} + value_u8bit := b2; + end; + + + procedure proc_value_smallarray_const_2_mixed(b1: byte; arr : array of const; b2: byte);safecall; + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; +{$endif} + + + +var + failed: boolean; +Begin + {***************************** NORMAL TESTS *******************************} + clear_globals; + clear_values; + + failed:=false; + + { LOC_REGISTER } + write('Value parameter test (src : LOC_REGISTER)...'); + proc_value_u8bit(getu8bit); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + proc_value_u16bit(getu16bit); + if global_u16bit <> RESULT_U16BIT then + failed:=true; + proc_value_s32bit(gets32bit); + if global_s32bit <> RESULT_S32BIT then + failed:=true; +{$ifndef tp} + proc_value_s64bit(gets64bit); + if global_s64bit <> RESULT_S64BIT then + failed:=true; +{$endif} + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_FPUREGISTER } + clear_globals; + clear_values; + failed:=false; + write('Value parameter test (src : LOC_FPUREGISTER)...'); + proc_value_s32real(gets32real); + if trunc(global_s32real) <> trunc(RESULT_S32REAL) then + failed:=true; + proc_value_s64real(gets64real); + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed:=true; + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_MEM, LOC_REFERENCE orddef } + clear_globals; + clear_values; + value_u8bit := RESULT_U8BIT; + value_u16bit := RESULT_U16BIT; + value_s32bit := RESULT_S32BIT; +{$ifndef tp} + value_s64bit := RESULT_S64BIT; +{$endif} + value_s32real := RESULT_S32REAL; + value_s64real := RESULT_S64REAL; + + failed:=false; + + { LOC_REFERENCE } + write('Value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...'); + proc_value_u8bit(value_u8bit); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + proc_value_u16bit(value_u16bit); + if global_u16bit <> RESULT_U16BIT then + failed:=true; + proc_value_s32bit(value_s32bit); + if global_s32bit <> RESULT_S32BIT then + failed:=true; +{$ifndef tp} + proc_value_s64bit(value_s64bit); + if global_s64bit <> RESULT_S64BIT then + failed:=true; +{$endif} + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_REFERENCE } + clear_globals; + failed:=false; + write('Value parameter test (src : LOC_REFERENCE (floatdef))...'); + proc_value_s32real(value_s32real); + if trunc(global_s32real) <> trunc(RESULT_S32REAL) then + failed:=true; + proc_value_s64real(value_s64real); + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed:=true; + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Value parameter test (src : LOC_REFERENCE (pointer))...'); + clear_globals; + clear_values; + failed:=false; + value_ptr := RESULT_PCHAR; + proc_value_pointerdef(value_ptr); + if global_ptr <> value_ptr then + failed := true; + + + value_proc := {$ifndef tp}@{$endif}testprocedure; + proc_value_procvardef(value_proc); + if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then + failed := true; + +{$ifndef tp} + value_class := tclass1.create; + proc_value_classrefdef(value_class); + if value_class <> global_class then + failed := true; + value_class.destroy; +{$endif} + if failed then + fail + else + WriteLn('Passed!'); + + + + + { LOC_REFERENCE } + clear_globals; + clear_values; + failed:=false; + value_u8bit := 0; + write('Value parameter test (src : LOC_FLAGS (orddef)))...'); + proc_value_bool8bit(value_u8bit = 0); + if global_u8bit <> RESULT_BOOL8BIT then + failed:=true; +{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x + proc_value_bool16bit(value_s64bit < 0); + if global_u16bit <> RESULT_BOOL16BIT then + failed:=true; + proc_value_bool32bit(bool1 and bool2); + if global_s32bit <> RESULT_BOOL32BIT then + failed:=true;*} + if failed then + fail + else + WriteLn('Passed!'); + + + +{$ifndef tp} + clear_globals; + clear_values; + failed:=false; + write('Value parameter test (src : LOC_JUMP (orddef)))...'); + proc_value_bool8bit(value_s64bit = 0); + if global_u8bit <> RESULT_BOOL8BIT then + failed:=true; +{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x + proc_value_bool16bit(value_s64bit < 0); + if global_u16bit <> RESULT_BOOL16BIT then + failed:=true; + proc_value_bool32bit(bool1 and bool2); + if global_s32bit <> RESULT_BOOL32BIT then + failed:=true;*} + if failed then + fail + else + WriteLn('Passed!'); +{$endif} + + { arraydef, + recorddef, + objectdef, + stringdef, + setdef : all considered the same by code generator. + } + write('Value parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallrec.b := RESULT_U8BIT; + value_smallrec.w := RESULT_U16BIT; + proc_value_smallrecord(value_smallrec); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); + proc_value_largerecord(value_largerec); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Value parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallset := [A_A,A_D]; + proc_value_smallset(value_smallset); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_largeset := ['I']; + proc_value_largeset(value_largeset); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + + + write('Value parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + value_smallstring := RESULT_SMALLSTRING; + + proc_value_smallstring(value_smallstring); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_bigstring := RESULT_BIGSTRING; + proc_value_bigstring(value_bigstring); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!} + { DON'T KNOW WHY/HOW TO TEST!!!!! } + + + write('Value parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + fillchar(value_smallarray,sizeof(value_smallarray),#0); + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_value_smallarray(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + fillchar(value_smallarray,sizeof(value_smallarray),#0); + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_value_smallarray_open(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + +{$ifndef tp} + clear_globals; + clear_values; + + value_u8bit := RESULT_U8BIT; + value_ptr := RESULT_PCHAR; + value_s64bit := RESULT_S64BIT; + value_smallstring := RESULT_SMALLSTRING; + value_class := tclass1.create; + value_boolean := RESULT_BOOLEAN; + value_char := RESULT_CHAR; + value_s64real:=RESULT_S64REAL; + proc_value_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real, + value_boolean,value_class]); + + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if global_char <> RESULT_CHAR then + failed := true; + if global_boolean <> RESULT_BOOLEAN then + failed:=true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed := true; + if global_bigstring <> RESULT_SMALLSTRING then + failed := true; + if global_ptr <> value_ptr then + failed := true; +{ if value_class <> global_class then + failed := true;!!!!!!!!!!!!!!!!!!!!} + if global_s64bit <> RESULT_S64BIT then + failed := true; + if assigned(value_class) then + value_class.destroy; + + global_u8bit := 0; + proc_value_smallarray_const_2([]); + if global_u8bit <> RESULT_U8BIT then + failed := true; +{$endif fpc} + + if failed then + fail + else + WriteLn('Passed!'); + + {***************************** MIXED TESTS *******************************} + clear_globals; + clear_values; + + failed:=false; + + { LOC_REGISTER } + write('Mixed value parameter test (src : LOC_REGISTER)...'); + proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),getu8bit,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + proc_value_u16bit_mixed(byte(NOT RESULT_U8BIT),getu16bit,RESULT_U8BIT); + if global_u16bit <> RESULT_U16BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + proc_value_s32bit_mixed(byte(NOT RESULT_U8BIT),gets32bit, RESULT_U8BIT); + if global_s32bit <> RESULT_S32BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$ifndef tp} + proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT),gets64bit,RESULT_U8BIT); + if global_s64bit <> RESULT_S64BIT then + failed:=true; +{$endif} + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_FPUREGISTER } + clear_globals; + clear_values; + failed:=false; + write('Mixed value parameter test (src : LOC_FPUREGISTER)...'); + proc_value_s32real_mixed(byte(NOT RESULT_U8BIT), gets32real, RESULT_U8BIT); + if value_u8bit <> RESULT_U8BIT then + failed := true; + if trunc(global_s32real) <> trunc(RESULT_S32REAL) then + failed:=true; + proc_value_s64real_mixed(byte(NOT RESULT_U8BIT),gets64real,RESULT_U8BIT); + if value_u8bit <> RESULT_U8BIT then + failed := true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed:=true; + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_MEM, LOC_REFERENCE orddef } + clear_globals; + clear_values; + value_u8bit := RESULT_U8BIT; + value_u16bit := RESULT_U16BIT; + value_s32bit := RESULT_S32BIT; +{$ifndef tp} + value_s64bit := RESULT_S64BIT; +{$endif} + value_s32real := RESULT_S32REAL; + value_s64real := RESULT_S64REAL; + + failed:=false; + + { LOC_REFERENCE } + write('Mixed value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...'); + proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),value_u8bit, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + proc_value_u16bit_mixed(byte(NOT RESULT_U8BIT),value_u16bit, RESULT_U8BIT); + if global_u16bit <> RESULT_U16BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + proc_value_s32bit_mixed(byte(NOT RESULT_U8BIT),value_s32bit, RESULT_U8BIT); + if global_s32bit <> RESULT_S32BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$ifndef tp} + proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit, RESULT_U8BIT); + if global_s64bit <> RESULT_S64BIT then + failed:=true; +{$endif} + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_REFERENCE } + clear_globals; + failed:=false; + write('Mixed value parameter test (src : LOC_REFERENCE (floatdef))...'); + proc_value_s32real_mixed(byte(NOT RESULT_U8BIT), value_s32real, RESULT_U8BIT); + if trunc(global_s32real) <> trunc(RESULT_S32REAL) then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + proc_value_s64real_mixed(byte(NOT RESULT_U8BIT), value_s64real, RESULT_U8BIT); + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Mixed value parameter test (src : LOC_REFERENCE (pointer))...'); + clear_globals; + clear_values; + failed:=false; + value_ptr := RESULT_PCHAR; + proc_value_pointerdef_mixed(byte(NOT RESULT_U8BIT), value_ptr, RESULT_U8BIT); + if global_ptr <> value_ptr then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + + value_proc := {$ifndef tp}@{$endif}testprocedure; + proc_value_procvardef_mixed(byte(NOT RESULT_U8BIT), value_proc, RESULT_U8BIT); + if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then + failed := true; + +{$ifndef tp} + value_class := tclass1.create; + proc_value_classrefdef_mixed(byte(NOT RESULT_U8BIT), value_class, RESULT_U8BIT); + if value_class <> global_class then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + value_class.destroy; +{$endif} + if failed then + fail + else + WriteLn('Passed!'); + + + + + { LOC_REFERENCE } + clear_globals; + clear_values; + failed:=false; + value_u8bit := 0; + write('Mixed value parameter test (src : LOC_FLAGS (orddef)))...'); + proc_value_bool8bit_mixed(byte(NOT RESULT_U8BIT), value_u8bit = 0, RESULT_U8BIT); + if global_u8bit <> RESULT_BOOL8BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x + proc_value_bool16bit(value_s64bit < 0); + if global_u16bit <> RESULT_BOOL16BIT then + failed:=true; + proc_value_bool32bit(bool1 and bool2); + if global_s32bit <> RESULT_BOOL32BIT then + failed:=true;*} + if failed then + fail + else + WriteLn('Passed!'); + + + +{$ifndef tp} + clear_globals; + clear_values; + failed:=false; + write('Mixed value parameter test (src : LOC_JUMP (orddef)))...'); + proc_value_bool8bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit = 0, RESULT_U8BIT); + if global_u8bit <> RESULT_BOOL8BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x + proc_value_bool16bit(value_s64bit < 0); + if global_u16bit <> RESULT_BOOL16BIT then + failed:=true; + proc_value_bool32bit(bool1 and bool2); + if global_s32bit <> RESULT_BOOL32BIT then + failed:=true;*} + if failed then + fail + else + WriteLn('Passed!'); +{$endif} + + { arraydef, + recorddef, + objectdef, + stringdef, + setdef : all considered the same by code generator. + } + write('Mixed value parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallrec.b := RESULT_U8BIT; + value_smallrec.w := RESULT_U16BIT; + proc_value_smallrecord_mixed(byte(NOT RESULT_U8BIT), value_smallrec, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); + proc_value_largerecord_mixed(byte(NOT RESULT_U8BIT), value_largerec, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Mixed value parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallset := [A_A,A_D]; + proc_value_smallset_mixed(byte(NOT RESULT_U8BIT), value_smallset, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_largeset := ['I']; + proc_value_largeset_mixed(byte(NOT RESULT_U8BIT), value_largeset, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + + + write('Mixed value parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + value_smallstring := RESULT_SMALLSTRING; + + proc_value_smallstring_mixed(byte(NOT RESULT_U8BIT), value_smallstring, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_bigstring := RESULT_BIGSTRING; + proc_value_bigstring_mixed(byte(NOT RESULT_U8BIT), value_bigstring, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!} + { DON'T KNOW WHY/HOW TO TEST!!!!! } + + + write('Mixed value parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + fillchar(value_smallarray,sizeof(value_smallarray),#0); + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_value_smallarray_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + fillchar(value_smallarray,sizeof(value_smallarray),#0); + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_value_smallarray_open_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + +{$ifndef tp} + clear_globals; + clear_values; + + value_u8bit := RESULT_U8BIT; + value_ptr := RESULT_PCHAR; + value_s64bit := RESULT_S64BIT; + value_smallstring := RESULT_SMALLSTRING; + value_class := tclass1.create; + value_boolean := RESULT_BOOLEAN; + value_char := RESULT_CHAR; + value_s64real:=RESULT_S64REAL; + proc_value_smallarray_const_1_mixed(byte(NOT RESULT_U8BIT), [value_u8bit,value_ptr,value_s64bit,value_char, + value_smallstring,value_s64real,value_boolean,value_class], + RESULT_U8BIT); + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if global_char <> RESULT_CHAR then + failed := true; + if global_boolean <> RESULT_BOOLEAN then + failed:=true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed := true; + if global_bigstring <> RESULT_SMALLSTRING then + failed := true; + if global_ptr <> value_ptr then + failed := true; +{ if value_class <> global_class then + failed := true;!!!!!!!!!!!!!!!!!!!!} + if global_s64bit <> RESULT_S64BIT then + failed := true; + if assigned(value_class) then + value_class.destroy; + + global_u8bit := 0; + proc_value_smallarray_const_2_mixed(byte(NOT RESULT_U8BIT), [], RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$endif} + + if failed then + fail + else + WriteLn('Passed!'); + +end. + + +{ $Log$ - Revision 1.4 2002-09-22 09:08:41 carl - * gets64bit was not returning an int64! - - Revision 1.3 2002/09/07 15:40:55 peter - * old logs removed and tabs fixed - - Revision 1.2 2002/05/13 13:45:38 peter - * updated to compile tests with kylix - - Revision 1.1 2002/04/13 17:49:45 carl - + value parameter passing for different calling conventions - -} + Revision 1.5 2003-04-22 10:24:29 florian + * fixed defines for powerpc + + Revision 1.4 2002/09/22 09:08:41 carl + * gets64bit was not returning an int64! + + Revision 1.3 2002/09/07 15:40:55 peter + * old logs removed and tabs fixed + + Revision 1.2 2002/05/13 13:45:38 peter + * updated to compile tests with kylix + + Revision 1.1 2002/04/13 17:49:45 carl + + value parameter passing for different calling conventions + +} diff --git a/tests/test/cg/tcalval7.pp b/tests/test/cg/tcalval7.pp index 74abb22454..dd55ef5895 100644 --- a/tests/test/cg/tcalval7.pp +++ b/tests/test/cg/tcalval7.pp @@ -1,1306 +1,1308 @@ -{****************************************************************} -{ 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 } -{ (value parameters with register calling convention) } -{****************************************************************} -program tcalval7; - -{$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; - {$endif} - {$ifdef cpui386} - 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_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; -{$ifndef tp} - global_s64bit := 0; - global_class := nil; -{$endif} - 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; -{$ifndef tp} - value_s64bit := 0; - value_class := nil; -{$endif} - end; - - - procedure testprocedure; - begin - end; - - function getu8bit : byte; - begin - getu8bit:=RESULT_U8BIT; - end; - - function getu16bit: word; - begin - getu16bit:=RESULT_U16BIT; - end; - - function gets32bit: longint; - begin - gets32bit:=RESULT_S32BIT; - end; - - function gets64bit: int64; - begin - gets64bit:=RESULT_S64BIT; - end; - - - function gets32real: single; - begin - gets32real:=RESULT_S32REAL; - end; - - function gets64real: double; - begin - gets64real:=RESULT_S64REAL; - end; - -{ ***************************************************************** } -{ VALUE PARAMETERS } -{ ***************************************************************** } - - procedure proc_value_u8bit(v: byte);register; - begin - global_u8bit := v; - end; - - - procedure proc_value_u16bit(v: word);register; - begin - global_u16bit := v; - end; - - - procedure proc_value_s32bit(v : longint);register; - begin - global_s32bit := v; - end; - - - - - procedure proc_value_bool8bit(v: boolean);register; - begin - { boolean should be 8-bit always! } - if sizeof(boolean) <> 1 then RunError(255); - global_u8bit := byte(v); - end; - - - procedure proc_value_bool16bit(v: wordbool);register; - begin - global_u16bit := word(v); - end; - - - procedure proc_value_bool32bit(v : longbool);register; - begin - global_s32bit := longint(v); - end; - - - procedure proc_value_s32real(v : single);register; - begin - global_s32real := v; - end; - - procedure proc_value_s64real(v: double);register; - begin - global_s64real:= v; - end; - - - procedure proc_value_pointerdef(p : pchar);register; - begin - global_ptr:=p; - end; - - - procedure proc_value_procvardef(p : tprocedure);register; - begin - global_proc:=p; - end; - - - - - procedure proc_value_smallrecord(smallrec : tsmallrecord);register; - begin - if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_value_largerecord(largerec : tlargerecord);register; - begin - if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_value_smallset(smallset : tsmallset);register; - begin - if A_D in smallset then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_value_largeset(largeset : tlargeset);register; - begin - if 'I' in largeset then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_value_smallstring(s:tsmallstring);register; - begin - if s = RESULT_SMALLSTRING then - global_u8bit := RESULT_u8BIT; - end; - - - procedure proc_value_bigstring(s:shortstring);register; - begin - if s = RESULT_BIGSTRING then - global_u8bit := RESULT_u8BIT; - end; - - - procedure proc_value_smallarray(arr : tsmallarray);register; - begin - if arr[SMALL_INDEX] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_value_smallarray_open(arr : array of byte);register; - begin - { form 0 to N-1 indexes in open arrays } - if arr[SMALL_INDEX-1] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - end; - -{$ifndef tp} - procedure proc_value_classrefdef(obj : tclass1);register; - begin - global_class:=obj; - end; - - - procedure proc_value_smallarray_const_1(arr : array of const);register; - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : global_u8bit := arr[i].vinteger and $ff; - vtBoolean : global_boolean := arr[i].vboolean; - vtChar : global_char := arr[i].vchar; - vtExtended : global_s64real := arr[i].VExtended^; - vtString : global_bigstring := arr[i].VString^; - vtPointer : ; - vtPChar : global_ptr := arr[i].VPchar; - vtObject : ; -{ vtClass : global_class := (arr[i].VClass) as tclass1;} - vtAnsiString : ; - vtInt64 : global_s64bit := arr[i].vInt64^; - else - RunError(255); - end; - end; {endfor} - end; - - - procedure proc_value_smallarray_const_2(arr : array of const);register; - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_value_s64bit(v: int64);register; - begin - global_s64bit:= v; - end; -{$endif} - - {********************************* MIXED PARAMETERS *************************} - - procedure proc_value_u8bit_mixed(b1 : byte; v: byte; b2: byte);register; - begin - global_u8bit := v; - value_u8bit := b2; - end; - - - procedure proc_value_u16bit_mixed(b1: byte; v: word; b2: byte);register; - begin - global_u16bit := v; - value_u8bit := b2; - end; - - - procedure proc_value_s32bit_mixed(b1 : byte; v : longint; b2: byte);register; - begin - global_s32bit := v; - value_u8bit := b2; - end; - - - - - procedure proc_value_bool8bit_mixed(b1: byte; v: boolean; b2: byte);register; - begin - { boolean should be 8-bit always! } - if sizeof(boolean) <> 1 then RunError(255); - global_u8bit := byte(v); - value_u8bit := b2; - end; - - - procedure proc_value_bool16bit_mixed(b1 : byte; v: wordbool; b2: byte);register; - begin - global_u16bit := word(v); - value_u8bit := b2; - end; - - - procedure proc_value_bool32bit_mixed(b1 : byte; v : longbool; b2: byte);register; - begin - global_s32bit := longint(v); - value_u8bit := b2; - end; - - - procedure proc_value_s32real_mixed(b1: byte; v : single; b2: byte);register; - begin - global_s32real := v; - value_u8bit := b2; - end; - - procedure proc_value_s64real_mixed(b1: byte; v: double; b2: byte);register; - begin - global_s64real:= v; - value_u8bit := b2; - end; - - - procedure proc_value_pointerdef_mixed(b1: byte; p : pchar; b2: byte);register; - begin - global_ptr:=p; - value_u8bit := b2; - end; - - - procedure proc_value_procvardef_mixed(b1: byte; p : tprocedure; b2: byte);register; - begin - global_proc:=p; - value_u8bit := b2; - end; - - - - - procedure proc_value_smallrecord_mixed(b1: byte; smallrec : tsmallrecord; b2: byte);register; - begin - if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - procedure proc_value_largerecord_mixed(b1: byte; largerec : tlargerecord; b2: byte);register; - begin - if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - procedure proc_value_smallset_mixed(b1: byte; smallset : tsmallset; b2: byte);register; - begin - if A_D in smallset then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - procedure proc_value_largeset_mixed(b1: byte; largeset : tlargeset; b2: byte);register; - begin - if 'I' in largeset then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - procedure proc_value_smallstring_mixed(b1: byte; s:tsmallstring; b2: byte);register; - begin - if s = RESULT_SMALLSTRING then - global_u8bit := RESULT_u8BIT; - value_u8bit := b2; - end; - - - procedure proc_value_bigstring_mixed(b1: byte; s:shortstring; b2: byte);register; - begin - if s = RESULT_BIGSTRING then - global_u8bit := RESULT_u8BIT; - value_u8bit := b2; - end; - - - procedure proc_value_smallarray_mixed(b1: byte; arr : tsmallarray; b2: byte);register; - begin - if arr[SMALL_INDEX] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - procedure proc_value_smallarray_open_mixed(b1: byte; arr : array of byte; b2: byte);register; - begin - { form 0 to N-1 indexes in open arrays } - if arr[SMALL_INDEX-1] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - -{$ifndef tp} - procedure proc_value_classrefdef_mixed(b1: byte; obj : tclass1; b2: byte);register; - begin - global_class:=obj; - value_u8bit := b2; - end; - - - procedure proc_value_s64bit_mixed(b1 : byte; v: int64; b2: byte);register; - begin - global_s64bit:= v; - value_u8bit := b2; - end; - - - procedure proc_value_smallarray_const_1_mixed(b1: byte; arr : array of const; b2: byte);register; - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : global_u8bit := arr[i].vinteger and $ff; - vtBoolean : global_boolean := arr[i].vboolean; - vtChar : global_char := arr[i].vchar; - vtExtended : global_s64real := arr[i].VExtended^; - vtString : global_bigstring := arr[i].VString^; - vtPointer : ; - vtPChar : global_ptr := arr[i].VPchar; - vtObject : ; -{ vtClass : global_class := (arr[i].VClass) as tclass1;} - vtAnsiString : ; - vtInt64 : global_s64bit := arr[i].vInt64^; - else - RunError(255); - end; - end; {endfor} - value_u8bit := b2; - end; - - - procedure proc_value_smallarray_const_2_mixed(b1: byte; arr : array of const; b2: byte);register; - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; -{$endif} - - - -var - failed: boolean; -Begin - {***************************** NORMAL TESTS *******************************} - clear_globals; - clear_values; - - failed:=false; - - { LOC_REGISTER } - write('Value parameter test (src : LOC_REGISTER)...'); - proc_value_u8bit(getu8bit); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - proc_value_u16bit(getu16bit); - if global_u16bit <> RESULT_U16BIT then - failed:=true; - proc_value_s32bit(gets32bit); - if global_s32bit <> RESULT_S32BIT then - failed:=true; -{$ifndef tp} - proc_value_s64bit(gets64bit); - if global_s64bit <> RESULT_S64BIT then - failed:=true; -{$endif} - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_FPUREGISTER } - clear_globals; - clear_values; - failed:=false; - write('Value parameter test (src : LOC_FPUREGISTER)...'); - proc_value_s32real(gets32real); - if trunc(global_s32real) <> trunc(RESULT_S32REAL) then - failed:=true; - proc_value_s64real(gets64real); - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed:=true; - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_MEM, LOC_REFERENCE orddef } - clear_globals; - clear_values; - value_u8bit := RESULT_U8BIT; - value_u16bit := RESULT_U16BIT; - value_s32bit := RESULT_S32BIT; -{$ifndef tp} - value_s64bit := RESULT_S64BIT; -{$endif} - value_s32real := RESULT_S32REAL; - value_s64real := RESULT_S64REAL; - - failed:=false; - - { LOC_REFERENCE } - write('Value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...'); - proc_value_u8bit(value_u8bit); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - proc_value_u16bit(value_u16bit); - if global_u16bit <> RESULT_U16BIT then - failed:=true; - proc_value_s32bit(value_s32bit); - if global_s32bit <> RESULT_S32BIT then - failed:=true; -{$ifndef tp} - proc_value_s64bit(value_s64bit); - if global_s64bit <> RESULT_S64BIT then - failed:=true; -{$endif} - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_REFERENCE } - clear_globals; - failed:=false; - write('Value parameter test (src : LOC_REFERENCE (floatdef))...'); - proc_value_s32real(value_s32real); - if trunc(global_s32real) <> trunc(RESULT_S32REAL) then - failed:=true; - proc_value_s64real(value_s64real); - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed:=true; - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Value parameter test (src : LOC_REFERENCE (pointer))...'); - clear_globals; - clear_values; - failed:=false; - value_ptr := RESULT_PCHAR; - proc_value_pointerdef(value_ptr); - if global_ptr <> value_ptr then - failed := true; - - - value_proc := {$ifndef tp}@{$endif}testprocedure; - proc_value_procvardef(value_proc); - if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then - failed := true; - -{$ifndef tp} - value_class := tclass1.create; - proc_value_classrefdef(value_class); - if value_class <> global_class then - failed := true; - value_class.destroy; -{$endif} - if failed then - fail - else - WriteLn('Passed!'); - - - - - { LOC_REFERENCE } - clear_globals; - clear_values; - failed:=false; - value_u8bit := 0; - write('Value parameter test (src : LOC_FLAGS (orddef)))...'); - proc_value_bool8bit(value_u8bit = 0); - if global_u8bit <> RESULT_BOOL8BIT then - failed:=true; -{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x - proc_value_bool16bit(value_s64bit < 0); - if global_u16bit <> RESULT_BOOL16BIT then - failed:=true; - proc_value_bool32bit(bool1 and bool2); - if global_s32bit <> RESULT_BOOL32BIT then - failed:=true;*} - if failed then - fail - else - WriteLn('Passed!'); - - - -{$ifndef tp} - clear_globals; - clear_values; - failed:=false; - write('Value parameter test (src : LOC_JUMP (orddef)))...'); - proc_value_bool8bit(value_s64bit = 0); - if global_u8bit <> RESULT_BOOL8BIT then - failed:=true; -{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x - proc_value_bool16bit(value_s64bit < 0); - if global_u16bit <> RESULT_BOOL16BIT then - failed:=true; - proc_value_bool32bit(bool1 and bool2); - if global_s32bit <> RESULT_BOOL32BIT then - failed:=true;*} - if failed then - fail - else - WriteLn('Passed!'); -{$endif} - - { arraydef, - recorddef, - objectdef, - stringdef, - setdef : all considered the same by code generator. - } - write('Value parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallrec.b := RESULT_U8BIT; - value_smallrec.w := RESULT_U16BIT; - proc_value_smallrecord(value_smallrec); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); - proc_value_largerecord(value_largerec); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Value parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallset := [A_A,A_D]; - proc_value_smallset(value_smallset); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_largeset := ['I']; - proc_value_largeset(value_largeset); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - - - write('Value parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - value_smallstring := RESULT_SMALLSTRING; - - proc_value_smallstring(value_smallstring); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_bigstring := RESULT_BIGSTRING; - proc_value_bigstring(value_bigstring); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!} - { DON'T KNOW WHY/HOW TO TEST!!!!! } - - - write('Value parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - fillchar(value_smallarray,sizeof(value_smallarray),#0); - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_value_smallarray(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - fillchar(value_smallarray,sizeof(value_smallarray),#0); - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_value_smallarray_open(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - -{$ifndef tp} - clear_globals; - clear_values; - - value_u8bit := RESULT_U8BIT; - value_ptr := RESULT_PCHAR; - value_s64bit := RESULT_S64BIT; - value_smallstring := RESULT_SMALLSTRING; - value_class := tclass1.create; - value_boolean := RESULT_BOOLEAN; - value_char := RESULT_CHAR; - value_s64real:=RESULT_S64REAL; - proc_value_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real, - value_boolean,value_class]); - - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if global_char <> RESULT_CHAR then - failed := true; - if global_boolean <> RESULT_BOOLEAN then - failed:=true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed := true; - if global_bigstring <> RESULT_SMALLSTRING then - failed := true; - if global_ptr <> value_ptr then - failed := true; -{ if value_class <> global_class then - failed := true;!!!!!!!!!!!!!!!!!!!!} - if global_s64bit <> RESULT_S64BIT then - failed := true; - if assigned(value_class) then - value_class.destroy; - - global_u8bit := 0; - proc_value_smallarray_const_2([]); - if global_u8bit <> RESULT_U8BIT then - failed := true; -{$endif fpc} - - if failed then - fail - else - WriteLn('Passed!'); - - {***************************** MIXED TESTS *******************************} - clear_globals; - clear_values; - - failed:=false; - - { LOC_REGISTER } - write('Mixed value parameter test (src : LOC_REGISTER)...'); - proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),getu8bit,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - proc_value_u16bit_mixed(byte(NOT RESULT_U8BIT),getu16bit,RESULT_U8BIT); - if global_u16bit <> RESULT_U16BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - proc_value_s32bit_mixed(byte(NOT RESULT_U8BIT),gets32bit, RESULT_U8BIT); - if global_s32bit <> RESULT_S32BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$ifndef tp} - proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT),gets64bit,RESULT_U8BIT); - if global_s64bit <> RESULT_S64BIT then - failed:=true; -{$endif} - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_FPUREGISTER } - clear_globals; - clear_values; - failed:=false; - write('Mixed value parameter test (src : LOC_FPUREGISTER)...'); - proc_value_s32real_mixed(byte(NOT RESULT_U8BIT), gets32real, RESULT_U8BIT); - if value_u8bit <> RESULT_U8BIT then - failed := true; - if trunc(global_s32real) <> trunc(RESULT_S32REAL) then - failed:=true; - proc_value_s64real_mixed(byte(NOT RESULT_U8BIT),gets64real,RESULT_U8BIT); - if value_u8bit <> RESULT_U8BIT then - failed := true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed:=true; - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_MEM, LOC_REFERENCE orddef } - clear_globals; - clear_values; - value_u8bit := RESULT_U8BIT; - value_u16bit := RESULT_U16BIT; - value_s32bit := RESULT_S32BIT; -{$ifndef tp} - value_s64bit := RESULT_S64BIT; -{$endif} - value_s32real := RESULT_S32REAL; - value_s64real := RESULT_S64REAL; - - failed:=false; - - { LOC_REFERENCE } - write('Mixed value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...'); - proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),value_u8bit, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - proc_value_u16bit_mixed(byte(NOT RESULT_U8BIT),value_u16bit, RESULT_U8BIT); - if global_u16bit <> RESULT_U16BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - proc_value_s32bit_mixed(byte(NOT RESULT_U8BIT),value_s32bit, RESULT_U8BIT); - if global_s32bit <> RESULT_S32BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$ifndef tp} - proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit, RESULT_U8BIT); - if global_s64bit <> RESULT_S64BIT then - failed:=true; -{$endif} - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_REFERENCE } - clear_globals; - failed:=false; - write('Mixed value parameter test (src : LOC_REFERENCE (floatdef))...'); - proc_value_s32real_mixed(byte(NOT RESULT_U8BIT), value_s32real, RESULT_U8BIT); - if trunc(global_s32real) <> trunc(RESULT_S32REAL) then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - proc_value_s64real_mixed(byte(NOT RESULT_U8BIT), value_s64real, RESULT_U8BIT); - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Mixed value parameter test (src : LOC_REFERENCE (pointer))...'); - clear_globals; - clear_values; - failed:=false; - value_ptr := RESULT_PCHAR; - proc_value_pointerdef_mixed(byte(NOT RESULT_U8BIT), value_ptr, RESULT_U8BIT); - if global_ptr <> value_ptr then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - - value_proc := {$ifndef tp}@{$endif}testprocedure; - proc_value_procvardef_mixed(byte(NOT RESULT_U8BIT), value_proc, RESULT_U8BIT); - if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then - failed := true; - -{$ifndef tp} - value_class := tclass1.create; - proc_value_classrefdef_mixed(byte(NOT RESULT_U8BIT), value_class, RESULT_U8BIT); - if value_class <> global_class then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - value_class.destroy; -{$endif} - if failed then - fail - else - WriteLn('Passed!'); - - - - - { LOC_REFERENCE } - clear_globals; - clear_values; - failed:=false; - value_u8bit := 0; - write('Mixed value parameter test (src : LOC_FLAGS (orddef)))...'); - proc_value_bool8bit_mixed(byte(NOT RESULT_U8BIT), value_u8bit = 0, RESULT_U8BIT); - if global_u8bit <> RESULT_BOOL8BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x - proc_value_bool16bit(value_s64bit < 0); - if global_u16bit <> RESULT_BOOL16BIT then - failed:=true; - proc_value_bool32bit(bool1 and bool2); - if global_s32bit <> RESULT_BOOL32BIT then - failed:=true;*} - if failed then - fail - else - WriteLn('Passed!'); - - - -{$ifndef tp} - clear_globals; - clear_values; - failed:=false; - write('Mixed value parameter test (src : LOC_JUMP (orddef)))...'); - proc_value_bool8bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit = 0, RESULT_U8BIT); - if global_u8bit <> RESULT_BOOL8BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x - proc_value_bool16bit(value_s64bit < 0); - if global_u16bit <> RESULT_BOOL16BIT then - failed:=true; - proc_value_bool32bit(bool1 and bool2); - if global_s32bit <> RESULT_BOOL32BIT then - failed:=true;*} - if failed then - fail - else - WriteLn('Passed!'); -{$endif} - - { arraydef, - recorddef, - objectdef, - stringdef, - setdef : all considered the same by code generator. - } - write('Mixed value parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallrec.b := RESULT_U8BIT; - value_smallrec.w := RESULT_U16BIT; - proc_value_smallrecord_mixed(byte(NOT RESULT_U8BIT), value_smallrec, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); - proc_value_largerecord_mixed(byte(NOT RESULT_U8BIT), value_largerec, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Mixed value parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallset := [A_A,A_D]; - proc_value_smallset_mixed(byte(NOT RESULT_U8BIT), value_smallset, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_largeset := ['I']; - proc_value_largeset_mixed(byte(NOT RESULT_U8BIT), value_largeset, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - - - write('Mixed value parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - value_smallstring := RESULT_SMALLSTRING; - - proc_value_smallstring_mixed(byte(NOT RESULT_U8BIT), value_smallstring, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_bigstring := RESULT_BIGSTRING; - proc_value_bigstring_mixed(byte(NOT RESULT_U8BIT), value_bigstring, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!} - { DON'T KNOW WHY/HOW TO TEST!!!!! } - - - write('Mixed value parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - fillchar(value_smallarray,sizeof(value_smallarray),#0); - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_value_smallarray_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - fillchar(value_smallarray,sizeof(value_smallarray),#0); - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_value_smallarray_open_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - -{$ifndef tp} - clear_globals; - clear_values; - - value_u8bit := RESULT_U8BIT; - value_ptr := RESULT_PCHAR; - value_s64bit := RESULT_S64BIT; - value_smallstring := RESULT_SMALLSTRING; - value_class := tclass1.create; - value_boolean := RESULT_BOOLEAN; - value_char := RESULT_CHAR; - value_s64real:=RESULT_S64REAL; - proc_value_smallarray_const_1_mixed(byte(NOT RESULT_U8BIT), [value_u8bit,value_ptr,value_s64bit,value_char, - value_smallstring,value_s64real,value_boolean,value_class], - RESULT_U8BIT); - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if global_char <> RESULT_CHAR then - failed := true; - if global_boolean <> RESULT_BOOLEAN then - failed:=true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed := true; - if global_bigstring <> RESULT_SMALLSTRING then - failed := true; - if global_ptr <> value_ptr then - failed := true; -{ if value_class <> global_class then - failed := true;!!!!!!!!!!!!!!!!!!!!} - if global_s64bit <> RESULT_S64BIT then - failed := true; - if assigned(value_class) then - value_class.destroy; - - global_u8bit := 0; - proc_value_smallarray_const_2_mixed(byte(NOT RESULT_U8BIT), [], RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$endif} - - 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 } +{ (value parameters with register calling convention) } +{****************************************************************} +program tcalval7; + +{$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_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; +{$ifndef tp} + global_s64bit := 0; + global_class := nil; +{$endif} + 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; +{$ifndef tp} + value_s64bit := 0; + value_class := nil; +{$endif} + end; + + + procedure testprocedure; + begin + end; + + function getu8bit : byte; + begin + getu8bit:=RESULT_U8BIT; + end; + + function getu16bit: word; + begin + getu16bit:=RESULT_U16BIT; + end; + + function gets32bit: longint; + begin + gets32bit:=RESULT_S32BIT; + end; + + function gets64bit: int64; + begin + gets64bit:=RESULT_S64BIT; + end; + + + function gets32real: single; + begin + gets32real:=RESULT_S32REAL; + end; + + function gets64real: double; + begin + gets64real:=RESULT_S64REAL; + end; + +{ ***************************************************************** } +{ VALUE PARAMETERS } +{ ***************************************************************** } + + procedure proc_value_u8bit(v: byte);register; + begin + global_u8bit := v; + end; + + + procedure proc_value_u16bit(v: word);register; + begin + global_u16bit := v; + end; + + + procedure proc_value_s32bit(v : longint);register; + begin + global_s32bit := v; + end; + + + + + procedure proc_value_bool8bit(v: boolean);register; + begin + { boolean should be 8-bit always! } + if sizeof(boolean) <> 1 then RunError(255); + global_u8bit := byte(v); + end; + + + procedure proc_value_bool16bit(v: wordbool);register; + begin + global_u16bit := word(v); + end; + + + procedure proc_value_bool32bit(v : longbool);register; + begin + global_s32bit := longint(v); + end; + + + procedure proc_value_s32real(v : single);register; + begin + global_s32real := v; + end; + + procedure proc_value_s64real(v: double);register; + begin + global_s64real:= v; + end; + + + procedure proc_value_pointerdef(p : pchar);register; + begin + global_ptr:=p; + end; + + + procedure proc_value_procvardef(p : tprocedure);register; + begin + global_proc:=p; + end; + + + + + procedure proc_value_smallrecord(smallrec : tsmallrecord);register; + begin + if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_value_largerecord(largerec : tlargerecord);register; + begin + if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_value_smallset(smallset : tsmallset);register; + begin + if A_D in smallset then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_value_largeset(largeset : tlargeset);register; + begin + if 'I' in largeset then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_value_smallstring(s:tsmallstring);register; + begin + if s = RESULT_SMALLSTRING then + global_u8bit := RESULT_u8BIT; + end; + + + procedure proc_value_bigstring(s:shortstring);register; + begin + if s = RESULT_BIGSTRING then + global_u8bit := RESULT_u8BIT; + end; + + + procedure proc_value_smallarray(arr : tsmallarray);register; + begin + if arr[SMALL_INDEX] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_value_smallarray_open(arr : array of byte);register; + begin + { form 0 to N-1 indexes in open arrays } + if arr[SMALL_INDEX-1] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + end; + +{$ifndef tp} + procedure proc_value_classrefdef(obj : tclass1);register; + begin + global_class:=obj; + end; + + + procedure proc_value_smallarray_const_1(arr : array of const);register; + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : global_u8bit := arr[i].vinteger and $ff; + vtBoolean : global_boolean := arr[i].vboolean; + vtChar : global_char := arr[i].vchar; + vtExtended : global_s64real := arr[i].VExtended^; + vtString : global_bigstring := arr[i].VString^; + vtPointer : ; + vtPChar : global_ptr := arr[i].VPchar; + vtObject : ; +{ vtClass : global_class := (arr[i].VClass) as tclass1;} + vtAnsiString : ; + vtInt64 : global_s64bit := arr[i].vInt64^; + else + RunError(255); + end; + end; {endfor} + end; + + + procedure proc_value_smallarray_const_2(arr : array of const);register; + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_value_s64bit(v: int64);register; + begin + global_s64bit:= v; + end; +{$endif} + + {********************************* MIXED PARAMETERS *************************} + + procedure proc_value_u8bit_mixed(b1 : byte; v: byte; b2: byte);register; + begin + global_u8bit := v; + value_u8bit := b2; + end; + + + procedure proc_value_u16bit_mixed(b1: byte; v: word; b2: byte);register; + begin + global_u16bit := v; + value_u8bit := b2; + end; + + + procedure proc_value_s32bit_mixed(b1 : byte; v : longint; b2: byte);register; + begin + global_s32bit := v; + value_u8bit := b2; + end; + + + + + procedure proc_value_bool8bit_mixed(b1: byte; v: boolean; b2: byte);register; + begin + { boolean should be 8-bit always! } + if sizeof(boolean) <> 1 then RunError(255); + global_u8bit := byte(v); + value_u8bit := b2; + end; + + + procedure proc_value_bool16bit_mixed(b1 : byte; v: wordbool; b2: byte);register; + begin + global_u16bit := word(v); + value_u8bit := b2; + end; + + + procedure proc_value_bool32bit_mixed(b1 : byte; v : longbool; b2: byte);register; + begin + global_s32bit := longint(v); + value_u8bit := b2; + end; + + + procedure proc_value_s32real_mixed(b1: byte; v : single; b2: byte);register; + begin + global_s32real := v; + value_u8bit := b2; + end; + + procedure proc_value_s64real_mixed(b1: byte; v: double; b2: byte);register; + begin + global_s64real:= v; + value_u8bit := b2; + end; + + + procedure proc_value_pointerdef_mixed(b1: byte; p : pchar; b2: byte);register; + begin + global_ptr:=p; + value_u8bit := b2; + end; + + + procedure proc_value_procvardef_mixed(b1: byte; p : tprocedure; b2: byte);register; + begin + global_proc:=p; + value_u8bit := b2; + end; + + + + + procedure proc_value_smallrecord_mixed(b1: byte; smallrec : tsmallrecord; b2: byte);register; + begin + if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + procedure proc_value_largerecord_mixed(b1: byte; largerec : tlargerecord; b2: byte);register; + begin + if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + procedure proc_value_smallset_mixed(b1: byte; smallset : tsmallset; b2: byte);register; + begin + if A_D in smallset then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + procedure proc_value_largeset_mixed(b1: byte; largeset : tlargeset; b2: byte);register; + begin + if 'I' in largeset then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + procedure proc_value_smallstring_mixed(b1: byte; s:tsmallstring; b2: byte);register; + begin + if s = RESULT_SMALLSTRING then + global_u8bit := RESULT_u8BIT; + value_u8bit := b2; + end; + + + procedure proc_value_bigstring_mixed(b1: byte; s:shortstring; b2: byte);register; + begin + if s = RESULT_BIGSTRING then + global_u8bit := RESULT_u8BIT; + value_u8bit := b2; + end; + + + procedure proc_value_smallarray_mixed(b1: byte; arr : tsmallarray; b2: byte);register; + begin + if arr[SMALL_INDEX] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + procedure proc_value_smallarray_open_mixed(b1: byte; arr : array of byte; b2: byte);register; + begin + { form 0 to N-1 indexes in open arrays } + if arr[SMALL_INDEX-1] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + +{$ifndef tp} + procedure proc_value_classrefdef_mixed(b1: byte; obj : tclass1; b2: byte);register; + begin + global_class:=obj; + value_u8bit := b2; + end; + + + procedure proc_value_s64bit_mixed(b1 : byte; v: int64; b2: byte);register; + begin + global_s64bit:= v; + value_u8bit := b2; + end; + + + procedure proc_value_smallarray_const_1_mixed(b1: byte; arr : array of const; b2: byte);register; + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : global_u8bit := arr[i].vinteger and $ff; + vtBoolean : global_boolean := arr[i].vboolean; + vtChar : global_char := arr[i].vchar; + vtExtended : global_s64real := arr[i].VExtended^; + vtString : global_bigstring := arr[i].VString^; + vtPointer : ; + vtPChar : global_ptr := arr[i].VPchar; + vtObject : ; +{ vtClass : global_class := (arr[i].VClass) as tclass1;} + vtAnsiString : ; + vtInt64 : global_s64bit := arr[i].vInt64^; + else + RunError(255); + end; + end; {endfor} + value_u8bit := b2; + end; + + + procedure proc_value_smallarray_const_2_mixed(b1: byte; arr : array of const; b2: byte);register; + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; +{$endif} + + + +var + failed: boolean; +Begin + {***************************** NORMAL TESTS *******************************} + clear_globals; + clear_values; + + failed:=false; + + { LOC_REGISTER } + write('Value parameter test (src : LOC_REGISTER)...'); + proc_value_u8bit(getu8bit); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + proc_value_u16bit(getu16bit); + if global_u16bit <> RESULT_U16BIT then + failed:=true; + proc_value_s32bit(gets32bit); + if global_s32bit <> RESULT_S32BIT then + failed:=true; +{$ifndef tp} + proc_value_s64bit(gets64bit); + if global_s64bit <> RESULT_S64BIT then + failed:=true; +{$endif} + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_FPUREGISTER } + clear_globals; + clear_values; + failed:=false; + write('Value parameter test (src : LOC_FPUREGISTER)...'); + proc_value_s32real(gets32real); + if trunc(global_s32real) <> trunc(RESULT_S32REAL) then + failed:=true; + proc_value_s64real(gets64real); + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed:=true; + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_MEM, LOC_REFERENCE orddef } + clear_globals; + clear_values; + value_u8bit := RESULT_U8BIT; + value_u16bit := RESULT_U16BIT; + value_s32bit := RESULT_S32BIT; +{$ifndef tp} + value_s64bit := RESULT_S64BIT; +{$endif} + value_s32real := RESULT_S32REAL; + value_s64real := RESULT_S64REAL; + + failed:=false; + + { LOC_REFERENCE } + write('Value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...'); + proc_value_u8bit(value_u8bit); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + proc_value_u16bit(value_u16bit); + if global_u16bit <> RESULT_U16BIT then + failed:=true; + proc_value_s32bit(value_s32bit); + if global_s32bit <> RESULT_S32BIT then + failed:=true; +{$ifndef tp} + proc_value_s64bit(value_s64bit); + if global_s64bit <> RESULT_S64BIT then + failed:=true; +{$endif} + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_REFERENCE } + clear_globals; + failed:=false; + write('Value parameter test (src : LOC_REFERENCE (floatdef))...'); + proc_value_s32real(value_s32real); + if trunc(global_s32real) <> trunc(RESULT_S32REAL) then + failed:=true; + proc_value_s64real(value_s64real); + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed:=true; + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Value parameter test (src : LOC_REFERENCE (pointer))...'); + clear_globals; + clear_values; + failed:=false; + value_ptr := RESULT_PCHAR; + proc_value_pointerdef(value_ptr); + if global_ptr <> value_ptr then + failed := true; + + + value_proc := {$ifndef tp}@{$endif}testprocedure; + proc_value_procvardef(value_proc); + if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then + failed := true; + +{$ifndef tp} + value_class := tclass1.create; + proc_value_classrefdef(value_class); + if value_class <> global_class then + failed := true; + value_class.destroy; +{$endif} + if failed then + fail + else + WriteLn('Passed!'); + + + + + { LOC_REFERENCE } + clear_globals; + clear_values; + failed:=false; + value_u8bit := 0; + write('Value parameter test (src : LOC_FLAGS (orddef)))...'); + proc_value_bool8bit(value_u8bit = 0); + if global_u8bit <> RESULT_BOOL8BIT then + failed:=true; +{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x + proc_value_bool16bit(value_s64bit < 0); + if global_u16bit <> RESULT_BOOL16BIT then + failed:=true; + proc_value_bool32bit(bool1 and bool2); + if global_s32bit <> RESULT_BOOL32BIT then + failed:=true;*} + if failed then + fail + else + WriteLn('Passed!'); + + + +{$ifndef tp} + clear_globals; + clear_values; + failed:=false; + write('Value parameter test (src : LOC_JUMP (orddef)))...'); + proc_value_bool8bit(value_s64bit = 0); + if global_u8bit <> RESULT_BOOL8BIT then + failed:=true; +{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x + proc_value_bool16bit(value_s64bit < 0); + if global_u16bit <> RESULT_BOOL16BIT then + failed:=true; + proc_value_bool32bit(bool1 and bool2); + if global_s32bit <> RESULT_BOOL32BIT then + failed:=true;*} + if failed then + fail + else + WriteLn('Passed!'); +{$endif} + + { arraydef, + recorddef, + objectdef, + stringdef, + setdef : all considered the same by code generator. + } + write('Value parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallrec.b := RESULT_U8BIT; + value_smallrec.w := RESULT_U16BIT; + proc_value_smallrecord(value_smallrec); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); + proc_value_largerecord(value_largerec); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Value parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallset := [A_A,A_D]; + proc_value_smallset(value_smallset); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_largeset := ['I']; + proc_value_largeset(value_largeset); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + + + write('Value parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + value_smallstring := RESULT_SMALLSTRING; + + proc_value_smallstring(value_smallstring); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_bigstring := RESULT_BIGSTRING; + proc_value_bigstring(value_bigstring); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!} + { DON'T KNOW WHY/HOW TO TEST!!!!! } + + + write('Value parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + fillchar(value_smallarray,sizeof(value_smallarray),#0); + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_value_smallarray(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + fillchar(value_smallarray,sizeof(value_smallarray),#0); + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_value_smallarray_open(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + +{$ifndef tp} + clear_globals; + clear_values; + + value_u8bit := RESULT_U8BIT; + value_ptr := RESULT_PCHAR; + value_s64bit := RESULT_S64BIT; + value_smallstring := RESULT_SMALLSTRING; + value_class := tclass1.create; + value_boolean := RESULT_BOOLEAN; + value_char := RESULT_CHAR; + value_s64real:=RESULT_S64REAL; + proc_value_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real, + value_boolean,value_class]); + + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if global_char <> RESULT_CHAR then + failed := true; + if global_boolean <> RESULT_BOOLEAN then + failed:=true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed := true; + if global_bigstring <> RESULT_SMALLSTRING then + failed := true; + if global_ptr <> value_ptr then + failed := true; +{ if value_class <> global_class then + failed := true;!!!!!!!!!!!!!!!!!!!!} + if global_s64bit <> RESULT_S64BIT then + failed := true; + if assigned(value_class) then + value_class.destroy; + + global_u8bit := 0; + proc_value_smallarray_const_2([]); + if global_u8bit <> RESULT_U8BIT then + failed := true; +{$endif fpc} + + if failed then + fail + else + WriteLn('Passed!'); + + {***************************** MIXED TESTS *******************************} + clear_globals; + clear_values; + + failed:=false; + + { LOC_REGISTER } + write('Mixed value parameter test (src : LOC_REGISTER)...'); + proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),getu8bit,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + proc_value_u16bit_mixed(byte(NOT RESULT_U8BIT),getu16bit,RESULT_U8BIT); + if global_u16bit <> RESULT_U16BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + proc_value_s32bit_mixed(byte(NOT RESULT_U8BIT),gets32bit, RESULT_U8BIT); + if global_s32bit <> RESULT_S32BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$ifndef tp} + proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT),gets64bit,RESULT_U8BIT); + if global_s64bit <> RESULT_S64BIT then + failed:=true; +{$endif} + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_FPUREGISTER } + clear_globals; + clear_values; + failed:=false; + write('Mixed value parameter test (src : LOC_FPUREGISTER)...'); + proc_value_s32real_mixed(byte(NOT RESULT_U8BIT), gets32real, RESULT_U8BIT); + if value_u8bit <> RESULT_U8BIT then + failed := true; + if trunc(global_s32real) <> trunc(RESULT_S32REAL) then + failed:=true; + proc_value_s64real_mixed(byte(NOT RESULT_U8BIT),gets64real,RESULT_U8BIT); + if value_u8bit <> RESULT_U8BIT then + failed := true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed:=true; + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_MEM, LOC_REFERENCE orddef } + clear_globals; + clear_values; + value_u8bit := RESULT_U8BIT; + value_u16bit := RESULT_U16BIT; + value_s32bit := RESULT_S32BIT; +{$ifndef tp} + value_s64bit := RESULT_S64BIT; +{$endif} + value_s32real := RESULT_S32REAL; + value_s64real := RESULT_S64REAL; + + failed:=false; + + { LOC_REFERENCE } + write('Mixed value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...'); + proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),value_u8bit, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + proc_value_u16bit_mixed(byte(NOT RESULT_U8BIT),value_u16bit, RESULT_U8BIT); + if global_u16bit <> RESULT_U16BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + proc_value_s32bit_mixed(byte(NOT RESULT_U8BIT),value_s32bit, RESULT_U8BIT); + if global_s32bit <> RESULT_S32BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$ifndef tp} + proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit, RESULT_U8BIT); + if global_s64bit <> RESULT_S64BIT then + failed:=true; +{$endif} + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_REFERENCE } + clear_globals; + failed:=false; + write('Mixed value parameter test (src : LOC_REFERENCE (floatdef))...'); + proc_value_s32real_mixed(byte(NOT RESULT_U8BIT), value_s32real, RESULT_U8BIT); + if trunc(global_s32real) <> trunc(RESULT_S32REAL) then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + proc_value_s64real_mixed(byte(NOT RESULT_U8BIT), value_s64real, RESULT_U8BIT); + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Mixed value parameter test (src : LOC_REFERENCE (pointer))...'); + clear_globals; + clear_values; + failed:=false; + value_ptr := RESULT_PCHAR; + proc_value_pointerdef_mixed(byte(NOT RESULT_U8BIT), value_ptr, RESULT_U8BIT); + if global_ptr <> value_ptr then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + + value_proc := {$ifndef tp}@{$endif}testprocedure; + proc_value_procvardef_mixed(byte(NOT RESULT_U8BIT), value_proc, RESULT_U8BIT); + if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then + failed := true; + +{$ifndef tp} + value_class := tclass1.create; + proc_value_classrefdef_mixed(byte(NOT RESULT_U8BIT), value_class, RESULT_U8BIT); + if value_class <> global_class then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + value_class.destroy; +{$endif} + if failed then + fail + else + WriteLn('Passed!'); + + + + + { LOC_REFERENCE } + clear_globals; + clear_values; + failed:=false; + value_u8bit := 0; + write('Mixed value parameter test (src : LOC_FLAGS (orddef)))...'); + proc_value_bool8bit_mixed(byte(NOT RESULT_U8BIT), value_u8bit = 0, RESULT_U8BIT); + if global_u8bit <> RESULT_BOOL8BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x + proc_value_bool16bit(value_s64bit < 0); + if global_u16bit <> RESULT_BOOL16BIT then + failed:=true; + proc_value_bool32bit(bool1 and bool2); + if global_s32bit <> RESULT_BOOL32BIT then + failed:=true;*} + if failed then + fail + else + WriteLn('Passed!'); + + + +{$ifndef tp} + clear_globals; + clear_values; + failed:=false; + write('Mixed value parameter test (src : LOC_JUMP (orddef)))...'); + proc_value_bool8bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit = 0, RESULT_U8BIT); + if global_u8bit <> RESULT_BOOL8BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x + proc_value_bool16bit(value_s64bit < 0); + if global_u16bit <> RESULT_BOOL16BIT then + failed:=true; + proc_value_bool32bit(bool1 and bool2); + if global_s32bit <> RESULT_BOOL32BIT then + failed:=true;*} + if failed then + fail + else + WriteLn('Passed!'); +{$endif} + + { arraydef, + recorddef, + objectdef, + stringdef, + setdef : all considered the same by code generator. + } + write('Mixed value parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallrec.b := RESULT_U8BIT; + value_smallrec.w := RESULT_U16BIT; + proc_value_smallrecord_mixed(byte(NOT RESULT_U8BIT), value_smallrec, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); + proc_value_largerecord_mixed(byte(NOT RESULT_U8BIT), value_largerec, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Mixed value parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallset := [A_A,A_D]; + proc_value_smallset_mixed(byte(NOT RESULT_U8BIT), value_smallset, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_largeset := ['I']; + proc_value_largeset_mixed(byte(NOT RESULT_U8BIT), value_largeset, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + + + write('Mixed value parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + value_smallstring := RESULT_SMALLSTRING; + + proc_value_smallstring_mixed(byte(NOT RESULT_U8BIT), value_smallstring, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_bigstring := RESULT_BIGSTRING; + proc_value_bigstring_mixed(byte(NOT RESULT_U8BIT), value_bigstring, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!} + { DON'T KNOW WHY/HOW TO TEST!!!!! } + + + write('Mixed value parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + fillchar(value_smallarray,sizeof(value_smallarray),#0); + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_value_smallarray_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + fillchar(value_smallarray,sizeof(value_smallarray),#0); + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_value_smallarray_open_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + +{$ifndef tp} + clear_globals; + clear_values; + + value_u8bit := RESULT_U8BIT; + value_ptr := RESULT_PCHAR; + value_s64bit := RESULT_S64BIT; + value_smallstring := RESULT_SMALLSTRING; + value_class := tclass1.create; + value_boolean := RESULT_BOOLEAN; + value_char := RESULT_CHAR; + value_s64real:=RESULT_S64REAL; + proc_value_smallarray_const_1_mixed(byte(NOT RESULT_U8BIT), [value_u8bit,value_ptr,value_s64bit,value_char, + value_smallstring,value_s64real,value_boolean,value_class], + RESULT_U8BIT); + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if global_char <> RESULT_CHAR then + failed := true; + if global_boolean <> RESULT_BOOLEAN then + failed:=true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed := true; + if global_bigstring <> RESULT_SMALLSTRING then + failed := true; + if global_ptr <> value_ptr then + failed := true; +{ if value_class <> global_class then + failed := true;!!!!!!!!!!!!!!!!!!!!} + if global_s64bit <> RESULT_S64BIT then + failed := true; + if assigned(value_class) then + value_class.destroy; + + global_u8bit := 0; + proc_value_smallarray_const_2_mixed(byte(NOT RESULT_U8BIT), [], RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$endif} + + if failed then + fail + else + WriteLn('Passed!'); + +end. + + +{ $Log$ - Revision 1.4 2002-09-22 09:08:41 carl - * gets64bit was not returning an int64! - - Revision 1.3 2002/09/07 15:40:55 peter - * old logs removed and tabs fixed - - Revision 1.2 2002/05/13 13:45:38 peter - * updated to compile tests with kylix - - Revision 1.1 2002/04/13 17:49:45 carl - + value parameter passing for different calling conventions - -} + Revision 1.5 2003-04-22 10:24:29 florian + * fixed defines for powerpc + + Revision 1.4 2002/09/22 09:08:41 carl + * gets64bit was not returning an int64! + + Revision 1.3 2002/09/07 15:40:55 peter + * old logs removed and tabs fixed + + Revision 1.2 2002/05/13 13:45:38 peter + * updated to compile tests with kylix + + Revision 1.1 2002/04/13 17:49:45 carl + + value parameter passing for different calling conventions + +} diff --git a/tests/test/cg/tcalval8.pp b/tests/test/cg/tcalval8.pp index c28894985f..757de44562 100644 --- a/tests/test/cg/tcalval8.pp +++ b/tests/test/cg/tcalval8.pp @@ -1,1306 +1,1308 @@ -{****************************************************************} -{ 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 } -{ (value parameters with stdcall calling convention) } -{****************************************************************} -program tcalval8; - -{$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; - {$endif} - {$ifdef cpui386} - 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_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; -{$ifndef tp} - global_s64bit := 0; - global_class := nil; -{$endif} - 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; -{$ifndef tp} - value_s64bit := 0; - value_class := nil; -{$endif} - end; - - - procedure testprocedure; - begin - end; - - function getu8bit : byte; - begin - getu8bit:=RESULT_U8BIT; - end; - - function getu16bit: word; - begin - getu16bit:=RESULT_U16BIT; - end; - - function gets32bit: longint; - begin - gets32bit:=RESULT_S32BIT; - end; - - function gets64bit: int64; - begin - gets64bit:=RESULT_S64BIT; - end; - - - function gets32real: single; - begin - gets32real:=RESULT_S32REAL; - end; - - function gets64real: double; - begin - gets64real:=RESULT_S64REAL; - end; - -{ ***************************************************************** } -{ VALUE PARAMETERS } -{ ***************************************************************** } - - procedure proc_value_u8bit(v: byte);stdcall; - begin - global_u8bit := v; - end; - - - procedure proc_value_u16bit(v: word);stdcall; - begin - global_u16bit := v; - end; - - - procedure proc_value_s32bit(v : longint);stdcall; - begin - global_s32bit := v; - end; - - - - - procedure proc_value_bool8bit(v: boolean);stdcall; - begin - { boolean should be 8-bit always! } - if sizeof(boolean) <> 1 then RunError(255); - global_u8bit := byte(v); - end; - - - procedure proc_value_bool16bit(v: wordbool);stdcall; - begin - global_u16bit := word(v); - end; - - - procedure proc_value_bool32bit(v : longbool);stdcall; - begin - global_s32bit := longint(v); - end; - - - procedure proc_value_s32real(v : single);stdcall; - begin - global_s32real := v; - end; - - procedure proc_value_s64real(v: double);stdcall; - begin - global_s64real:= v; - end; - - - procedure proc_value_pointerdef(p : pchar);stdcall; - begin - global_ptr:=p; - end; - - - procedure proc_value_procvardef(p : tprocedure);stdcall; - begin - global_proc:=p; - end; - - - - - procedure proc_value_smallrecord(smallrec : tsmallrecord);stdcall; - begin - if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_value_largerecord(largerec : tlargerecord);stdcall; - begin - if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_value_smallset(smallset : tsmallset);stdcall; - begin - if A_D in smallset then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_value_largeset(largeset : tlargeset);stdcall; - begin - if 'I' in largeset then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_value_smallstring(s:tsmallstring);stdcall; - begin - if s = RESULT_SMALLSTRING then - global_u8bit := RESULT_u8BIT; - end; - - - procedure proc_value_bigstring(s:shortstring);stdcall; - begin - if s = RESULT_BIGSTRING then - global_u8bit := RESULT_u8BIT; - end; - - - procedure proc_value_smallarray(arr : tsmallarray);stdcall; - begin - if arr[SMALL_INDEX] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_value_smallarray_open(arr : array of byte);stdcall; - begin - { form 0 to N-1 indexes in open arrays } - if arr[SMALL_INDEX-1] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - end; - -{$ifndef tp} - procedure proc_value_classrefdef(obj : tclass1);stdcall; - begin - global_class:=obj; - end; - - - procedure proc_value_smallarray_const_1(arr : array of const);stdcall; - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : global_u8bit := arr[i].vinteger and $ff; - vtBoolean : global_boolean := arr[i].vboolean; - vtChar : global_char := arr[i].vchar; - vtExtended : global_s64real := arr[i].VExtended^; - vtString : global_bigstring := arr[i].VString^; - vtPointer : ; - vtPChar : global_ptr := arr[i].VPchar; - vtObject : ; -{ vtClass : global_class := (arr[i].VClass) as tclass1;} - vtAnsiString : ; - vtInt64 : global_s64bit := arr[i].vInt64^; - else - RunError(255); - end; - end; {endfor} - end; - - - procedure proc_value_smallarray_const_2(arr : array of const);stdcall; - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_value_s64bit(v: int64);stdcall; - begin - global_s64bit:= v; - end; -{$endif} - - {********************************* MIXED PARAMETERS *************************} - - procedure proc_value_u8bit_mixed(b1 : byte; v: byte; b2: byte);stdcall; - begin - global_u8bit := v; - value_u8bit := b2; - end; - - - procedure proc_value_u16bit_mixed(b1: byte; v: word; b2: byte);stdcall; - begin - global_u16bit := v; - value_u8bit := b2; - end; - - - procedure proc_value_s32bit_mixed(b1 : byte; v : longint; b2: byte);stdcall; - begin - global_s32bit := v; - value_u8bit := b2; - end; - - - - - procedure proc_value_bool8bit_mixed(b1: byte; v: boolean; b2: byte);stdcall; - begin - { boolean should be 8-bit always! } - if sizeof(boolean) <> 1 then RunError(255); - global_u8bit := byte(v); - value_u8bit := b2; - end; - - - procedure proc_value_bool16bit_mixed(b1 : byte; v: wordbool; b2: byte);stdcall; - begin - global_u16bit := word(v); - value_u8bit := b2; - end; - - - procedure proc_value_bool32bit_mixed(b1 : byte; v : longbool; b2: byte);stdcall; - begin - global_s32bit := longint(v); - value_u8bit := b2; - end; - - - procedure proc_value_s32real_mixed(b1: byte; v : single; b2: byte);stdcall; - begin - global_s32real := v; - value_u8bit := b2; - end; - - procedure proc_value_s64real_mixed(b1: byte; v: double; b2: byte);stdcall; - begin - global_s64real:= v; - value_u8bit := b2; - end; - - - procedure proc_value_pointerdef_mixed(b1: byte; p : pchar; b2: byte);stdcall; - begin - global_ptr:=p; - value_u8bit := b2; - end; - - - procedure proc_value_procvardef_mixed(b1: byte; p : tprocedure; b2: byte);stdcall; - begin - global_proc:=p; - value_u8bit := b2; - end; - - - - - procedure proc_value_smallrecord_mixed(b1: byte; smallrec : tsmallrecord; b2: byte);stdcall; - begin - if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - procedure proc_value_largerecord_mixed(b1: byte; largerec : tlargerecord; b2: byte);stdcall; - begin - if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - procedure proc_value_smallset_mixed(b1: byte; smallset : tsmallset; b2: byte);stdcall; - begin - if A_D in smallset then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - procedure proc_value_largeset_mixed(b1: byte; largeset : tlargeset; b2: byte);stdcall; - begin - if 'I' in largeset then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - procedure proc_value_smallstring_mixed(b1: byte; s:tsmallstring; b2: byte);stdcall; - begin - if s = RESULT_SMALLSTRING then - global_u8bit := RESULT_u8BIT; - value_u8bit := b2; - end; - - - procedure proc_value_bigstring_mixed(b1: byte; s:shortstring; b2: byte);stdcall; - begin - if s = RESULT_BIGSTRING then - global_u8bit := RESULT_u8BIT; - value_u8bit := b2; - end; - - - procedure proc_value_smallarray_mixed(b1: byte; arr : tsmallarray; b2: byte);stdcall; - begin - if arr[SMALL_INDEX] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - procedure proc_value_smallarray_open_mixed(b1: byte; arr : array of byte; b2: byte);stdcall; - begin - { form 0 to N-1 indexes in open arrays } - if arr[SMALL_INDEX-1] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - -{$ifndef tp} - procedure proc_value_classrefdef_mixed(b1: byte; obj : tclass1; b2: byte);stdcall; - begin - global_class:=obj; - value_u8bit := b2; - end; - - - procedure proc_value_s64bit_mixed(b1 : byte; v: int64; b2: byte);stdcall; - begin - global_s64bit:= v; - value_u8bit := b2; - end; - - - procedure proc_value_smallarray_const_1_mixed(b1: byte; arr : array of const; b2: byte);stdcall; - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : global_u8bit := arr[i].vinteger and $ff; - vtBoolean : global_boolean := arr[i].vboolean; - vtChar : global_char := arr[i].vchar; - vtExtended : global_s64real := arr[i].VExtended^; - vtString : global_bigstring := arr[i].VString^; - vtPointer : ; - vtPChar : global_ptr := arr[i].VPchar; - vtObject : ; -{ vtClass : global_class := (arr[i].VClass) as tclass1;} - vtAnsiString : ; - vtInt64 : global_s64bit := arr[i].vInt64^; - else - RunError(255); - end; - end; {endfor} - value_u8bit := b2; - end; - - - procedure proc_value_smallarray_const_2_mixed(b1: byte; arr : array of const; b2: byte);stdcall; - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; -{$endif} - - - -var - failed: boolean; -Begin - {***************************** NORMAL TESTS *******************************} - clear_globals; - clear_values; - - failed:=false; - - { LOC_REGISTER } - write('Value parameter test (src : LOC_REGISTER)...'); - proc_value_u8bit(getu8bit); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - proc_value_u16bit(getu16bit); - if global_u16bit <> RESULT_U16BIT then - failed:=true; - proc_value_s32bit(gets32bit); - if global_s32bit <> RESULT_S32BIT then - failed:=true; -{$ifndef tp} - proc_value_s64bit(gets64bit); - if global_s64bit <> RESULT_S64BIT then - failed:=true; -{$endif} - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_FPUREGISTER } - clear_globals; - clear_values; - failed:=false; - write('Value parameter test (src : LOC_FPUREGISTER)...'); - proc_value_s32real(gets32real); - if trunc(global_s32real) <> trunc(RESULT_S32REAL) then - failed:=true; - proc_value_s64real(gets64real); - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed:=true; - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_MEM, LOC_REFERENCE orddef } - clear_globals; - clear_values; - value_u8bit := RESULT_U8BIT; - value_u16bit := RESULT_U16BIT; - value_s32bit := RESULT_S32BIT; -{$ifndef tp} - value_s64bit := RESULT_S64BIT; -{$endif} - value_s32real := RESULT_S32REAL; - value_s64real := RESULT_S64REAL; - - failed:=false; - - { LOC_REFERENCE } - write('Value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...'); - proc_value_u8bit(value_u8bit); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - proc_value_u16bit(value_u16bit); - if global_u16bit <> RESULT_U16BIT then - failed:=true; - proc_value_s32bit(value_s32bit); - if global_s32bit <> RESULT_S32BIT then - failed:=true; -{$ifndef tp} - proc_value_s64bit(value_s64bit); - if global_s64bit <> RESULT_S64BIT then - failed:=true; -{$endif} - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_REFERENCE } - clear_globals; - failed:=false; - write('Value parameter test (src : LOC_REFERENCE (floatdef))...'); - proc_value_s32real(value_s32real); - if trunc(global_s32real) <> trunc(RESULT_S32REAL) then - failed:=true; - proc_value_s64real(value_s64real); - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed:=true; - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Value parameter test (src : LOC_REFERENCE (pointer))...'); - clear_globals; - clear_values; - failed:=false; - value_ptr := RESULT_PCHAR; - proc_value_pointerdef(value_ptr); - if global_ptr <> value_ptr then - failed := true; - - - value_proc := {$ifndef tp}@{$endif}testprocedure; - proc_value_procvardef(value_proc); - if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then - failed := true; - -{$ifndef tp} - value_class := tclass1.create; - proc_value_classrefdef(value_class); - if value_class <> global_class then - failed := true; - value_class.destroy; -{$endif} - if failed then - fail - else - WriteLn('Passed!'); - - - - - { LOC_REFERENCE } - clear_globals; - clear_values; - failed:=false; - value_u8bit := 0; - write('Value parameter test (src : LOC_FLAGS (orddef)))...'); - proc_value_bool8bit(value_u8bit = 0); - if global_u8bit <> RESULT_BOOL8BIT then - failed:=true; -{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x - proc_value_bool16bit(value_s64bit < 0); - if global_u16bit <> RESULT_BOOL16BIT then - failed:=true; - proc_value_bool32bit(bool1 and bool2); - if global_s32bit <> RESULT_BOOL32BIT then - failed:=true;*} - if failed then - fail - else - WriteLn('Passed!'); - - - -{$ifndef tp} - clear_globals; - clear_values; - failed:=false; - write('Value parameter test (src : LOC_JUMP (orddef)))...'); - proc_value_bool8bit(value_s64bit = 0); - if global_u8bit <> RESULT_BOOL8BIT then - failed:=true; -{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x - proc_value_bool16bit(value_s64bit < 0); - if global_u16bit <> RESULT_BOOL16BIT then - failed:=true; - proc_value_bool32bit(bool1 and bool2); - if global_s32bit <> RESULT_BOOL32BIT then - failed:=true;*} - if failed then - fail - else - WriteLn('Passed!'); -{$endif} - - { arraydef, - recorddef, - objectdef, - stringdef, - setdef : all considered the same by code generator. - } - write('Value parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallrec.b := RESULT_U8BIT; - value_smallrec.w := RESULT_U16BIT; - proc_value_smallrecord(value_smallrec); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); - proc_value_largerecord(value_largerec); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Value parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallset := [A_A,A_D]; - proc_value_smallset(value_smallset); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_largeset := ['I']; - proc_value_largeset(value_largeset); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - - - write('Value parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - value_smallstring := RESULT_SMALLSTRING; - - proc_value_smallstring(value_smallstring); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_bigstring := RESULT_BIGSTRING; - proc_value_bigstring(value_bigstring); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!} - { DON'T KNOW WHY/HOW TO TEST!!!!! } - - - write('Value parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - fillchar(value_smallarray,sizeof(value_smallarray),#0); - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_value_smallarray(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - fillchar(value_smallarray,sizeof(value_smallarray),#0); - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_value_smallarray_open(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - -{$ifndef tp} - clear_globals; - clear_values; - - value_u8bit := RESULT_U8BIT; - value_ptr := RESULT_PCHAR; - value_s64bit := RESULT_S64BIT; - value_smallstring := RESULT_SMALLSTRING; - value_class := tclass1.create; - value_boolean := RESULT_BOOLEAN; - value_char := RESULT_CHAR; - value_s64real:=RESULT_S64REAL; - proc_value_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real, - value_boolean,value_class]); - - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if global_char <> RESULT_CHAR then - failed := true; - if global_boolean <> RESULT_BOOLEAN then - failed:=true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed := true; - if global_bigstring <> RESULT_SMALLSTRING then - failed := true; - if global_ptr <> value_ptr then - failed := true; -{ if value_class <> global_class then - failed := true;!!!!!!!!!!!!!!!!!!!!} - if global_s64bit <> RESULT_S64BIT then - failed := true; - if assigned(value_class) then - value_class.destroy; - - global_u8bit := 0; - proc_value_smallarray_const_2([]); - if global_u8bit <> RESULT_U8BIT then - failed := true; -{$endif fpc} - - if failed then - fail - else - WriteLn('Passed!'); - - {***************************** MIXED TESTS *******************************} - clear_globals; - clear_values; - - failed:=false; - - { LOC_REGISTER } - write('Mixed value parameter test (src : LOC_REGISTER)...'); - proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),getu8bit,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - proc_value_u16bit_mixed(byte(NOT RESULT_U8BIT),getu16bit,RESULT_U8BIT); - if global_u16bit <> RESULT_U16BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - proc_value_s32bit_mixed(byte(NOT RESULT_U8BIT),gets32bit, RESULT_U8BIT); - if global_s32bit <> RESULT_S32BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$ifndef tp} - proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT),gets64bit,RESULT_U8BIT); - if global_s64bit <> RESULT_S64BIT then - failed:=true; -{$endif} - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_FPUREGISTER } - clear_globals; - clear_values; - failed:=false; - write('Mixed value parameter test (src : LOC_FPUREGISTER)...'); - proc_value_s32real_mixed(byte(NOT RESULT_U8BIT), gets32real, RESULT_U8BIT); - if value_u8bit <> RESULT_U8BIT then - failed := true; - if trunc(global_s32real) <> trunc(RESULT_S32REAL) then - failed:=true; - proc_value_s64real_mixed(byte(NOT RESULT_U8BIT),gets64real,RESULT_U8BIT); - if value_u8bit <> RESULT_U8BIT then - failed := true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed:=true; - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_MEM, LOC_REFERENCE orddef } - clear_globals; - clear_values; - value_u8bit := RESULT_U8BIT; - value_u16bit := RESULT_U16BIT; - value_s32bit := RESULT_S32BIT; -{$ifndef tp} - value_s64bit := RESULT_S64BIT; -{$endif} - value_s32real := RESULT_S32REAL; - value_s64real := RESULT_S64REAL; - - failed:=false; - - { LOC_REFERENCE } - write('Mixed value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...'); - proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),value_u8bit, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - proc_value_u16bit_mixed(byte(NOT RESULT_U8BIT),value_u16bit, RESULT_U8BIT); - if global_u16bit <> RESULT_U16BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - proc_value_s32bit_mixed(byte(NOT RESULT_U8BIT),value_s32bit, RESULT_U8BIT); - if global_s32bit <> RESULT_S32BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$ifndef tp} - proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit, RESULT_U8BIT); - if global_s64bit <> RESULT_S64BIT then - failed:=true; -{$endif} - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_REFERENCE } - clear_globals; - failed:=false; - write('Mixed value parameter test (src : LOC_REFERENCE (floatdef))...'); - proc_value_s32real_mixed(byte(NOT RESULT_U8BIT), value_s32real, RESULT_U8BIT); - if trunc(global_s32real) <> trunc(RESULT_S32REAL) then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - proc_value_s64real_mixed(byte(NOT RESULT_U8BIT), value_s64real, RESULT_U8BIT); - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Mixed value parameter test (src : LOC_REFERENCE (pointer))...'); - clear_globals; - clear_values; - failed:=false; - value_ptr := RESULT_PCHAR; - proc_value_pointerdef_mixed(byte(NOT RESULT_U8BIT), value_ptr, RESULT_U8BIT); - if global_ptr <> value_ptr then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - - value_proc := {$ifndef tp}@{$endif}testprocedure; - proc_value_procvardef_mixed(byte(NOT RESULT_U8BIT), value_proc, RESULT_U8BIT); - if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then - failed := true; - -{$ifndef tp} - value_class := tclass1.create; - proc_value_classrefdef_mixed(byte(NOT RESULT_U8BIT), value_class, RESULT_U8BIT); - if value_class <> global_class then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - value_class.destroy; -{$endif} - if failed then - fail - else - WriteLn('Passed!'); - - - - - { LOC_REFERENCE } - clear_globals; - clear_values; - failed:=false; - value_u8bit := 0; - write('Mixed value parameter test (src : LOC_FLAGS (orddef)))...'); - proc_value_bool8bit_mixed(byte(NOT RESULT_U8BIT), value_u8bit = 0, RESULT_U8BIT); - if global_u8bit <> RESULT_BOOL8BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x - proc_value_bool16bit(value_s64bit < 0); - if global_u16bit <> RESULT_BOOL16BIT then - failed:=true; - proc_value_bool32bit(bool1 and bool2); - if global_s32bit <> RESULT_BOOL32BIT then - failed:=true;*} - if failed then - fail - else - WriteLn('Passed!'); - - - -{$ifndef tp} - clear_globals; - clear_values; - failed:=false; - write('Mixed value parameter test (src : LOC_JUMP (orddef)))...'); - proc_value_bool8bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit = 0, RESULT_U8BIT); - if global_u8bit <> RESULT_BOOL8BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x - proc_value_bool16bit(value_s64bit < 0); - if global_u16bit <> RESULT_BOOL16BIT then - failed:=true; - proc_value_bool32bit(bool1 and bool2); - if global_s32bit <> RESULT_BOOL32BIT then - failed:=true;*} - if failed then - fail - else - WriteLn('Passed!'); -{$endif} - - { arraydef, - recorddef, - objectdef, - stringdef, - setdef : all considered the same by code generator. - } - write('Mixed value parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallrec.b := RESULT_U8BIT; - value_smallrec.w := RESULT_U16BIT; - proc_value_smallrecord_mixed(byte(NOT RESULT_U8BIT), value_smallrec, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); - proc_value_largerecord_mixed(byte(NOT RESULT_U8BIT), value_largerec, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Mixed value parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallset := [A_A,A_D]; - proc_value_smallset_mixed(byte(NOT RESULT_U8BIT), value_smallset, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_largeset := ['I']; - proc_value_largeset_mixed(byte(NOT RESULT_U8BIT), value_largeset, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - - - write('Mixed value parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - value_smallstring := RESULT_SMALLSTRING; - - proc_value_smallstring_mixed(byte(NOT RESULT_U8BIT), value_smallstring, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_bigstring := RESULT_BIGSTRING; - proc_value_bigstring_mixed(byte(NOT RESULT_U8BIT), value_bigstring, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!} - { DON'T KNOW WHY/HOW TO TEST!!!!! } - - - write('Mixed value parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - fillchar(value_smallarray,sizeof(value_smallarray),#0); - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_value_smallarray_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - fillchar(value_smallarray,sizeof(value_smallarray),#0); - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_value_smallarray_open_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - -{$ifndef tp} - clear_globals; - clear_values; - - value_u8bit := RESULT_U8BIT; - value_ptr := RESULT_PCHAR; - value_s64bit := RESULT_S64BIT; - value_smallstring := RESULT_SMALLSTRING; - value_class := tclass1.create; - value_boolean := RESULT_BOOLEAN; - value_char := RESULT_CHAR; - value_s64real:=RESULT_S64REAL; - proc_value_smallarray_const_1_mixed(byte(NOT RESULT_U8BIT), [value_u8bit,value_ptr,value_s64bit,value_char, - value_smallstring,value_s64real,value_boolean,value_class], - RESULT_U8BIT); - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if global_char <> RESULT_CHAR then - failed := true; - if global_boolean <> RESULT_BOOLEAN then - failed:=true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed := true; - if global_bigstring <> RESULT_SMALLSTRING then - failed := true; - if global_ptr <> value_ptr then - failed := true; -{ if value_class <> global_class then - failed := true;!!!!!!!!!!!!!!!!!!!!} - if global_s64bit <> RESULT_S64BIT then - failed := true; - if assigned(value_class) then - value_class.destroy; - - global_u8bit := 0; - proc_value_smallarray_const_2_mixed(byte(NOT RESULT_U8BIT), [], RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$endif} - - 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 } +{ (value parameters with stdcall calling convention) } +{****************************************************************} +program tcalval8; + +{$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_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; +{$ifndef tp} + global_s64bit := 0; + global_class := nil; +{$endif} + 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; +{$ifndef tp} + value_s64bit := 0; + value_class := nil; +{$endif} + end; + + + procedure testprocedure; + begin + end; + + function getu8bit : byte; + begin + getu8bit:=RESULT_U8BIT; + end; + + function getu16bit: word; + begin + getu16bit:=RESULT_U16BIT; + end; + + function gets32bit: longint; + begin + gets32bit:=RESULT_S32BIT; + end; + + function gets64bit: int64; + begin + gets64bit:=RESULT_S64BIT; + end; + + + function gets32real: single; + begin + gets32real:=RESULT_S32REAL; + end; + + function gets64real: double; + begin + gets64real:=RESULT_S64REAL; + end; + +{ ***************************************************************** } +{ VALUE PARAMETERS } +{ ***************************************************************** } + + procedure proc_value_u8bit(v: byte);stdcall; + begin + global_u8bit := v; + end; + + + procedure proc_value_u16bit(v: word);stdcall; + begin + global_u16bit := v; + end; + + + procedure proc_value_s32bit(v : longint);stdcall; + begin + global_s32bit := v; + end; + + + + + procedure proc_value_bool8bit(v: boolean);stdcall; + begin + { boolean should be 8-bit always! } + if sizeof(boolean) <> 1 then RunError(255); + global_u8bit := byte(v); + end; + + + procedure proc_value_bool16bit(v: wordbool);stdcall; + begin + global_u16bit := word(v); + end; + + + procedure proc_value_bool32bit(v : longbool);stdcall; + begin + global_s32bit := longint(v); + end; + + + procedure proc_value_s32real(v : single);stdcall; + begin + global_s32real := v; + end; + + procedure proc_value_s64real(v: double);stdcall; + begin + global_s64real:= v; + end; + + + procedure proc_value_pointerdef(p : pchar);stdcall; + begin + global_ptr:=p; + end; + + + procedure proc_value_procvardef(p : tprocedure);stdcall; + begin + global_proc:=p; + end; + + + + + procedure proc_value_smallrecord(smallrec : tsmallrecord);stdcall; + begin + if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_value_largerecord(largerec : tlargerecord);stdcall; + begin + if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_value_smallset(smallset : tsmallset);stdcall; + begin + if A_D in smallset then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_value_largeset(largeset : tlargeset);stdcall; + begin + if 'I' in largeset then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_value_smallstring(s:tsmallstring);stdcall; + begin + if s = RESULT_SMALLSTRING then + global_u8bit := RESULT_u8BIT; + end; + + + procedure proc_value_bigstring(s:shortstring);stdcall; + begin + if s = RESULT_BIGSTRING then + global_u8bit := RESULT_u8BIT; + end; + + + procedure proc_value_smallarray(arr : tsmallarray);stdcall; + begin + if arr[SMALL_INDEX] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_value_smallarray_open(arr : array of byte);stdcall; + begin + { form 0 to N-1 indexes in open arrays } + if arr[SMALL_INDEX-1] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + end; + +{$ifndef tp} + procedure proc_value_classrefdef(obj : tclass1);stdcall; + begin + global_class:=obj; + end; + + + procedure proc_value_smallarray_const_1(arr : array of const);stdcall; + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : global_u8bit := arr[i].vinteger and $ff; + vtBoolean : global_boolean := arr[i].vboolean; + vtChar : global_char := arr[i].vchar; + vtExtended : global_s64real := arr[i].VExtended^; + vtString : global_bigstring := arr[i].VString^; + vtPointer : ; + vtPChar : global_ptr := arr[i].VPchar; + vtObject : ; +{ vtClass : global_class := (arr[i].VClass) as tclass1;} + vtAnsiString : ; + vtInt64 : global_s64bit := arr[i].vInt64^; + else + RunError(255); + end; + end; {endfor} + end; + + + procedure proc_value_smallarray_const_2(arr : array of const);stdcall; + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_value_s64bit(v: int64);stdcall; + begin + global_s64bit:= v; + end; +{$endif} + + {********************************* MIXED PARAMETERS *************************} + + procedure proc_value_u8bit_mixed(b1 : byte; v: byte; b2: byte);stdcall; + begin + global_u8bit := v; + value_u8bit := b2; + end; + + + procedure proc_value_u16bit_mixed(b1: byte; v: word; b2: byte);stdcall; + begin + global_u16bit := v; + value_u8bit := b2; + end; + + + procedure proc_value_s32bit_mixed(b1 : byte; v : longint; b2: byte);stdcall; + begin + global_s32bit := v; + value_u8bit := b2; + end; + + + + + procedure proc_value_bool8bit_mixed(b1: byte; v: boolean; b2: byte);stdcall; + begin + { boolean should be 8-bit always! } + if sizeof(boolean) <> 1 then RunError(255); + global_u8bit := byte(v); + value_u8bit := b2; + end; + + + procedure proc_value_bool16bit_mixed(b1 : byte; v: wordbool; b2: byte);stdcall; + begin + global_u16bit := word(v); + value_u8bit := b2; + end; + + + procedure proc_value_bool32bit_mixed(b1 : byte; v : longbool; b2: byte);stdcall; + begin + global_s32bit := longint(v); + value_u8bit := b2; + end; + + + procedure proc_value_s32real_mixed(b1: byte; v : single; b2: byte);stdcall; + begin + global_s32real := v; + value_u8bit := b2; + end; + + procedure proc_value_s64real_mixed(b1: byte; v: double; b2: byte);stdcall; + begin + global_s64real:= v; + value_u8bit := b2; + end; + + + procedure proc_value_pointerdef_mixed(b1: byte; p : pchar; b2: byte);stdcall; + begin + global_ptr:=p; + value_u8bit := b2; + end; + + + procedure proc_value_procvardef_mixed(b1: byte; p : tprocedure; b2: byte);stdcall; + begin + global_proc:=p; + value_u8bit := b2; + end; + + + + + procedure proc_value_smallrecord_mixed(b1: byte; smallrec : tsmallrecord; b2: byte);stdcall; + begin + if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + procedure proc_value_largerecord_mixed(b1: byte; largerec : tlargerecord; b2: byte);stdcall; + begin + if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + procedure proc_value_smallset_mixed(b1: byte; smallset : tsmallset; b2: byte);stdcall; + begin + if A_D in smallset then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + procedure proc_value_largeset_mixed(b1: byte; largeset : tlargeset; b2: byte);stdcall; + begin + if 'I' in largeset then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + procedure proc_value_smallstring_mixed(b1: byte; s:tsmallstring; b2: byte);stdcall; + begin + if s = RESULT_SMALLSTRING then + global_u8bit := RESULT_u8BIT; + value_u8bit := b2; + end; + + + procedure proc_value_bigstring_mixed(b1: byte; s:shortstring; b2: byte);stdcall; + begin + if s = RESULT_BIGSTRING then + global_u8bit := RESULT_u8BIT; + value_u8bit := b2; + end; + + + procedure proc_value_smallarray_mixed(b1: byte; arr : tsmallarray; b2: byte);stdcall; + begin + if arr[SMALL_INDEX] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + procedure proc_value_smallarray_open_mixed(b1: byte; arr : array of byte; b2: byte);stdcall; + begin + { form 0 to N-1 indexes in open arrays } + if arr[SMALL_INDEX-1] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + +{$ifndef tp} + procedure proc_value_classrefdef_mixed(b1: byte; obj : tclass1; b2: byte);stdcall; + begin + global_class:=obj; + value_u8bit := b2; + end; + + + procedure proc_value_s64bit_mixed(b1 : byte; v: int64; b2: byte);stdcall; + begin + global_s64bit:= v; + value_u8bit := b2; + end; + + + procedure proc_value_smallarray_const_1_mixed(b1: byte; arr : array of const; b2: byte);stdcall; + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : global_u8bit := arr[i].vinteger and $ff; + vtBoolean : global_boolean := arr[i].vboolean; + vtChar : global_char := arr[i].vchar; + vtExtended : global_s64real := arr[i].VExtended^; + vtString : global_bigstring := arr[i].VString^; + vtPointer : ; + vtPChar : global_ptr := arr[i].VPchar; + vtObject : ; +{ vtClass : global_class := (arr[i].VClass) as tclass1;} + vtAnsiString : ; + vtInt64 : global_s64bit := arr[i].vInt64^; + else + RunError(255); + end; + end; {endfor} + value_u8bit := b2; + end; + + + procedure proc_value_smallarray_const_2_mixed(b1: byte; arr : array of const; b2: byte);stdcall; + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; +{$endif} + + + +var + failed: boolean; +Begin + {***************************** NORMAL TESTS *******************************} + clear_globals; + clear_values; + + failed:=false; + + { LOC_REGISTER } + write('Value parameter test (src : LOC_REGISTER)...'); + proc_value_u8bit(getu8bit); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + proc_value_u16bit(getu16bit); + if global_u16bit <> RESULT_U16BIT then + failed:=true; + proc_value_s32bit(gets32bit); + if global_s32bit <> RESULT_S32BIT then + failed:=true; +{$ifndef tp} + proc_value_s64bit(gets64bit); + if global_s64bit <> RESULT_S64BIT then + failed:=true; +{$endif} + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_FPUREGISTER } + clear_globals; + clear_values; + failed:=false; + write('Value parameter test (src : LOC_FPUREGISTER)...'); + proc_value_s32real(gets32real); + if trunc(global_s32real) <> trunc(RESULT_S32REAL) then + failed:=true; + proc_value_s64real(gets64real); + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed:=true; + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_MEM, LOC_REFERENCE orddef } + clear_globals; + clear_values; + value_u8bit := RESULT_U8BIT; + value_u16bit := RESULT_U16BIT; + value_s32bit := RESULT_S32BIT; +{$ifndef tp} + value_s64bit := RESULT_S64BIT; +{$endif} + value_s32real := RESULT_S32REAL; + value_s64real := RESULT_S64REAL; + + failed:=false; + + { LOC_REFERENCE } + write('Value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...'); + proc_value_u8bit(value_u8bit); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + proc_value_u16bit(value_u16bit); + if global_u16bit <> RESULT_U16BIT then + failed:=true; + proc_value_s32bit(value_s32bit); + if global_s32bit <> RESULT_S32BIT then + failed:=true; +{$ifndef tp} + proc_value_s64bit(value_s64bit); + if global_s64bit <> RESULT_S64BIT then + failed:=true; +{$endif} + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_REFERENCE } + clear_globals; + failed:=false; + write('Value parameter test (src : LOC_REFERENCE (floatdef))...'); + proc_value_s32real(value_s32real); + if trunc(global_s32real) <> trunc(RESULT_S32REAL) then + failed:=true; + proc_value_s64real(value_s64real); + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed:=true; + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Value parameter test (src : LOC_REFERENCE (pointer))...'); + clear_globals; + clear_values; + failed:=false; + value_ptr := RESULT_PCHAR; + proc_value_pointerdef(value_ptr); + if global_ptr <> value_ptr then + failed := true; + + + value_proc := {$ifndef tp}@{$endif}testprocedure; + proc_value_procvardef(value_proc); + if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then + failed := true; + +{$ifndef tp} + value_class := tclass1.create; + proc_value_classrefdef(value_class); + if value_class <> global_class then + failed := true; + value_class.destroy; +{$endif} + if failed then + fail + else + WriteLn('Passed!'); + + + + + { LOC_REFERENCE } + clear_globals; + clear_values; + failed:=false; + value_u8bit := 0; + write('Value parameter test (src : LOC_FLAGS (orddef)))...'); + proc_value_bool8bit(value_u8bit = 0); + if global_u8bit <> RESULT_BOOL8BIT then + failed:=true; +{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x + proc_value_bool16bit(value_s64bit < 0); + if global_u16bit <> RESULT_BOOL16BIT then + failed:=true; + proc_value_bool32bit(bool1 and bool2); + if global_s32bit <> RESULT_BOOL32BIT then + failed:=true;*} + if failed then + fail + else + WriteLn('Passed!'); + + + +{$ifndef tp} + clear_globals; + clear_values; + failed:=false; + write('Value parameter test (src : LOC_JUMP (orddef)))...'); + proc_value_bool8bit(value_s64bit = 0); + if global_u8bit <> RESULT_BOOL8BIT then + failed:=true; +{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x + proc_value_bool16bit(value_s64bit < 0); + if global_u16bit <> RESULT_BOOL16BIT then + failed:=true; + proc_value_bool32bit(bool1 and bool2); + if global_s32bit <> RESULT_BOOL32BIT then + failed:=true;*} + if failed then + fail + else + WriteLn('Passed!'); +{$endif} + + { arraydef, + recorddef, + objectdef, + stringdef, + setdef : all considered the same by code generator. + } + write('Value parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallrec.b := RESULT_U8BIT; + value_smallrec.w := RESULT_U16BIT; + proc_value_smallrecord(value_smallrec); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); + proc_value_largerecord(value_largerec); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Value parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallset := [A_A,A_D]; + proc_value_smallset(value_smallset); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_largeset := ['I']; + proc_value_largeset(value_largeset); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + + + write('Value parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + value_smallstring := RESULT_SMALLSTRING; + + proc_value_smallstring(value_smallstring); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_bigstring := RESULT_BIGSTRING; + proc_value_bigstring(value_bigstring); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!} + { DON'T KNOW WHY/HOW TO TEST!!!!! } + + + write('Value parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + fillchar(value_smallarray,sizeof(value_smallarray),#0); + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_value_smallarray(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + fillchar(value_smallarray,sizeof(value_smallarray),#0); + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_value_smallarray_open(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + +{$ifndef tp} + clear_globals; + clear_values; + + value_u8bit := RESULT_U8BIT; + value_ptr := RESULT_PCHAR; + value_s64bit := RESULT_S64BIT; + value_smallstring := RESULT_SMALLSTRING; + value_class := tclass1.create; + value_boolean := RESULT_BOOLEAN; + value_char := RESULT_CHAR; + value_s64real:=RESULT_S64REAL; + proc_value_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real, + value_boolean,value_class]); + + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if global_char <> RESULT_CHAR then + failed := true; + if global_boolean <> RESULT_BOOLEAN then + failed:=true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed := true; + if global_bigstring <> RESULT_SMALLSTRING then + failed := true; + if global_ptr <> value_ptr then + failed := true; +{ if value_class <> global_class then + failed := true;!!!!!!!!!!!!!!!!!!!!} + if global_s64bit <> RESULT_S64BIT then + failed := true; + if assigned(value_class) then + value_class.destroy; + + global_u8bit := 0; + proc_value_smallarray_const_2([]); + if global_u8bit <> RESULT_U8BIT then + failed := true; +{$endif fpc} + + if failed then + fail + else + WriteLn('Passed!'); + + {***************************** MIXED TESTS *******************************} + clear_globals; + clear_values; + + failed:=false; + + { LOC_REGISTER } + write('Mixed value parameter test (src : LOC_REGISTER)...'); + proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),getu8bit,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + proc_value_u16bit_mixed(byte(NOT RESULT_U8BIT),getu16bit,RESULT_U8BIT); + if global_u16bit <> RESULT_U16BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + proc_value_s32bit_mixed(byte(NOT RESULT_U8BIT),gets32bit, RESULT_U8BIT); + if global_s32bit <> RESULT_S32BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$ifndef tp} + proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT),gets64bit,RESULT_U8BIT); + if global_s64bit <> RESULT_S64BIT then + failed:=true; +{$endif} + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_FPUREGISTER } + clear_globals; + clear_values; + failed:=false; + write('Mixed value parameter test (src : LOC_FPUREGISTER)...'); + proc_value_s32real_mixed(byte(NOT RESULT_U8BIT), gets32real, RESULT_U8BIT); + if value_u8bit <> RESULT_U8BIT then + failed := true; + if trunc(global_s32real) <> trunc(RESULT_S32REAL) then + failed:=true; + proc_value_s64real_mixed(byte(NOT RESULT_U8BIT),gets64real,RESULT_U8BIT); + if value_u8bit <> RESULT_U8BIT then + failed := true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed:=true; + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_MEM, LOC_REFERENCE orddef } + clear_globals; + clear_values; + value_u8bit := RESULT_U8BIT; + value_u16bit := RESULT_U16BIT; + value_s32bit := RESULT_S32BIT; +{$ifndef tp} + value_s64bit := RESULT_S64BIT; +{$endif} + value_s32real := RESULT_S32REAL; + value_s64real := RESULT_S64REAL; + + failed:=false; + + { LOC_REFERENCE } + write('Mixed value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...'); + proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),value_u8bit, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + proc_value_u16bit_mixed(byte(NOT RESULT_U8BIT),value_u16bit, RESULT_U8BIT); + if global_u16bit <> RESULT_U16BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + proc_value_s32bit_mixed(byte(NOT RESULT_U8BIT),value_s32bit, RESULT_U8BIT); + if global_s32bit <> RESULT_S32BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$ifndef tp} + proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit, RESULT_U8BIT); + if global_s64bit <> RESULT_S64BIT then + failed:=true; +{$endif} + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_REFERENCE } + clear_globals; + failed:=false; + write('Mixed value parameter test (src : LOC_REFERENCE (floatdef))...'); + proc_value_s32real_mixed(byte(NOT RESULT_U8BIT), value_s32real, RESULT_U8BIT); + if trunc(global_s32real) <> trunc(RESULT_S32REAL) then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + proc_value_s64real_mixed(byte(NOT RESULT_U8BIT), value_s64real, RESULT_U8BIT); + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Mixed value parameter test (src : LOC_REFERENCE (pointer))...'); + clear_globals; + clear_values; + failed:=false; + value_ptr := RESULT_PCHAR; + proc_value_pointerdef_mixed(byte(NOT RESULT_U8BIT), value_ptr, RESULT_U8BIT); + if global_ptr <> value_ptr then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + + value_proc := {$ifndef tp}@{$endif}testprocedure; + proc_value_procvardef_mixed(byte(NOT RESULT_U8BIT), value_proc, RESULT_U8BIT); + if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then + failed := true; + +{$ifndef tp} + value_class := tclass1.create; + proc_value_classrefdef_mixed(byte(NOT RESULT_U8BIT), value_class, RESULT_U8BIT); + if value_class <> global_class then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + value_class.destroy; +{$endif} + if failed then + fail + else + WriteLn('Passed!'); + + + + + { LOC_REFERENCE } + clear_globals; + clear_values; + failed:=false; + value_u8bit := 0; + write('Mixed value parameter test (src : LOC_FLAGS (orddef)))...'); + proc_value_bool8bit_mixed(byte(NOT RESULT_U8BIT), value_u8bit = 0, RESULT_U8BIT); + if global_u8bit <> RESULT_BOOL8BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x + proc_value_bool16bit(value_s64bit < 0); + if global_u16bit <> RESULT_BOOL16BIT then + failed:=true; + proc_value_bool32bit(bool1 and bool2); + if global_s32bit <> RESULT_BOOL32BIT then + failed:=true;*} + if failed then + fail + else + WriteLn('Passed!'); + + + +{$ifndef tp} + clear_globals; + clear_values; + failed:=false; + write('Mixed value parameter test (src : LOC_JUMP (orddef)))...'); + proc_value_bool8bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit = 0, RESULT_U8BIT); + if global_u8bit <> RESULT_BOOL8BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x + proc_value_bool16bit(value_s64bit < 0); + if global_u16bit <> RESULT_BOOL16BIT then + failed:=true; + proc_value_bool32bit(bool1 and bool2); + if global_s32bit <> RESULT_BOOL32BIT then + failed:=true;*} + if failed then + fail + else + WriteLn('Passed!'); +{$endif} + + { arraydef, + recorddef, + objectdef, + stringdef, + setdef : all considered the same by code generator. + } + write('Mixed value parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallrec.b := RESULT_U8BIT; + value_smallrec.w := RESULT_U16BIT; + proc_value_smallrecord_mixed(byte(NOT RESULT_U8BIT), value_smallrec, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); + proc_value_largerecord_mixed(byte(NOT RESULT_U8BIT), value_largerec, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Mixed value parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallset := [A_A,A_D]; + proc_value_smallset_mixed(byte(NOT RESULT_U8BIT), value_smallset, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_largeset := ['I']; + proc_value_largeset_mixed(byte(NOT RESULT_U8BIT), value_largeset, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + + + write('Mixed value parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + value_smallstring := RESULT_SMALLSTRING; + + proc_value_smallstring_mixed(byte(NOT RESULT_U8BIT), value_smallstring, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_bigstring := RESULT_BIGSTRING; + proc_value_bigstring_mixed(byte(NOT RESULT_U8BIT), value_bigstring, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!} + { DON'T KNOW WHY/HOW TO TEST!!!!! } + + + write('Mixed value parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + fillchar(value_smallarray,sizeof(value_smallarray),#0); + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_value_smallarray_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + fillchar(value_smallarray,sizeof(value_smallarray),#0); + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_value_smallarray_open_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + +{$ifndef tp} + clear_globals; + clear_values; + + value_u8bit := RESULT_U8BIT; + value_ptr := RESULT_PCHAR; + value_s64bit := RESULT_S64BIT; + value_smallstring := RESULT_SMALLSTRING; + value_class := tclass1.create; + value_boolean := RESULT_BOOLEAN; + value_char := RESULT_CHAR; + value_s64real:=RESULT_S64REAL; + proc_value_smallarray_const_1_mixed(byte(NOT RESULT_U8BIT), [value_u8bit,value_ptr,value_s64bit,value_char, + value_smallstring,value_s64real,value_boolean,value_class], + RESULT_U8BIT); + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if global_char <> RESULT_CHAR then + failed := true; + if global_boolean <> RESULT_BOOLEAN then + failed:=true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed := true; + if global_bigstring <> RESULT_SMALLSTRING then + failed := true; + if global_ptr <> value_ptr then + failed := true; +{ if value_class <> global_class then + failed := true;!!!!!!!!!!!!!!!!!!!!} + if global_s64bit <> RESULT_S64BIT then + failed := true; + if assigned(value_class) then + value_class.destroy; + + global_u8bit := 0; + proc_value_smallarray_const_2_mixed(byte(NOT RESULT_U8BIT), [], RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$endif} + + if failed then + fail + else + WriteLn('Passed!'); + +end. + + +{ $Log$ - Revision 1.4 2002-09-22 09:08:41 carl - * gets64bit was not returning an int64! - - Revision 1.3 2002/09/07 15:40:55 peter - * old logs removed and tabs fixed - - Revision 1.2 2002/05/13 13:45:38 peter - * updated to compile tests with kylix - - Revision 1.1 2002/04/13 17:49:45 carl - + value parameter passing for different calling conventions - -} + Revision 1.5 2003-04-22 10:24:29 florian + * fixed defines for powerpc + + Revision 1.4 2002/09/22 09:08:41 carl + * gets64bit was not returning an int64! + + Revision 1.3 2002/09/07 15:40:55 peter + * old logs removed and tabs fixed + + Revision 1.2 2002/05/13 13:45:38 peter + * updated to compile tests with kylix + + Revision 1.1 2002/04/13 17:49:45 carl + + value parameter passing for different calling conventions + +} diff --git a/tests/test/cg/tcalval9.pp b/tests/test/cg/tcalval9.pp index e267a376fc..6c47c37c71 100644 --- a/tests/test/cg/tcalval9.pp +++ b/tests/test/cg/tcalval9.pp @@ -1,1306 +1,1308 @@ -{****************************************************************} -{ 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 } -{ (value parameters with saveregs calling convention) } -{****************************************************************} -program tcalval9; - -{$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; - {$endif} - {$ifdef cpui386} - 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_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; -{$ifndef tp} - global_s64bit := 0; - global_class := nil; -{$endif} - 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; -{$ifndef tp} - value_s64bit := 0; - value_class := nil; -{$endif} - end; - - - procedure testprocedure; - begin - end; - - function getu8bit : byte; - begin - getu8bit:=RESULT_U8BIT; - end; - - function getu16bit: word; - begin - getu16bit:=RESULT_U16BIT; - end; - - function gets32bit: longint; - begin - gets32bit:=RESULT_S32BIT; - end; - - function gets64bit: int64; - begin - gets64bit:=RESULT_S64BIT; - end; - - - function gets32real: single; - begin - gets32real:=RESULT_S32REAL; - end; - - function gets64real: double; - begin - gets64real:=RESULT_S64REAL; - end; - -{ ***************************************************************** } -{ VALUE PARAMETERS } -{ ***************************************************************** } - - procedure proc_value_u8bit(v: byte);saveregisters; - begin - global_u8bit := v; - end; - - - procedure proc_value_u16bit(v: word);saveregisters; - begin - global_u16bit := v; - end; - - - procedure proc_value_s32bit(v : longint);saveregisters; - begin - global_s32bit := v; - end; - - - - - procedure proc_value_bool8bit(v: boolean);saveregisters; - begin - { boolean should be 8-bit always! } - if sizeof(boolean) <> 1 then RunError(255); - global_u8bit := byte(v); - end; - - - procedure proc_value_bool16bit(v: wordbool);saveregisters; - begin - global_u16bit := word(v); - end; - - - procedure proc_value_bool32bit(v : longbool);saveregisters; - begin - global_s32bit := longint(v); - end; - - - procedure proc_value_s32real(v : single);saveregisters; - begin - global_s32real := v; - end; - - procedure proc_value_s64real(v: double);saveregisters; - begin - global_s64real:= v; - end; - - - procedure proc_value_pointerdef(p : pchar);saveregisters; - begin - global_ptr:=p; - end; - - - procedure proc_value_procvardef(p : tprocedure);saveregisters; - begin - global_proc:=p; - end; - - - - - procedure proc_value_smallrecord(smallrec : tsmallrecord);saveregisters; - begin - if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_value_largerecord(largerec : tlargerecord);saveregisters; - begin - if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_value_smallset(smallset : tsmallset);saveregisters; - begin - if A_D in smallset then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_value_largeset(largeset : tlargeset);saveregisters; - begin - if 'I' in largeset then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_value_smallstring(s:tsmallstring);saveregisters; - begin - if s = RESULT_SMALLSTRING then - global_u8bit := RESULT_u8BIT; - end; - - - procedure proc_value_bigstring(s:shortstring);saveregisters; - begin - if s = RESULT_BIGSTRING then - global_u8bit := RESULT_u8BIT; - end; - - - procedure proc_value_smallarray(arr : tsmallarray);saveregisters; - begin - if arr[SMALL_INDEX] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_value_smallarray_open(arr : array of byte);saveregisters; - begin - { form 0 to N-1 indexes in open arrays } - if arr[SMALL_INDEX-1] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - end; - -{$ifndef tp} - procedure proc_value_classrefdef(obj : tclass1);saveregisters; - begin - global_class:=obj; - end; - - - procedure proc_value_smallarray_const_1(arr : array of const);saveregisters; - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : global_u8bit := arr[i].vinteger and $ff; - vtBoolean : global_boolean := arr[i].vboolean; - vtChar : global_char := arr[i].vchar; - vtExtended : global_s64real := arr[i].VExtended^; - vtString : global_bigstring := arr[i].VString^; - vtPointer : ; - vtPChar : global_ptr := arr[i].VPchar; - vtObject : ; -{ vtClass : global_class := (arr[i].VClass) as tclass1;} - vtAnsiString : ; - vtInt64 : global_s64bit := arr[i].vInt64^; - else - RunError(255); - end; - end; {endfor} - end; - - - procedure proc_value_smallarray_const_2(arr : array of const);saveregisters; - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - end; - - procedure proc_value_s64bit(v: int64);saveregisters; - begin - global_s64bit:= v; - end; -{$endif} - - {********************************* MIXED PARAMETERS *************************} - - procedure proc_value_u8bit_mixed(b1 : byte; v: byte; b2: byte);saveregisters; - begin - global_u8bit := v; - value_u8bit := b2; - end; - - - procedure proc_value_u16bit_mixed(b1: byte; v: word; b2: byte);saveregisters; - begin - global_u16bit := v; - value_u8bit := b2; - end; - - - procedure proc_value_s32bit_mixed(b1 : byte; v : longint; b2: byte);saveregisters; - begin - global_s32bit := v; - value_u8bit := b2; - end; - - - - - procedure proc_value_bool8bit_mixed(b1: byte; v: boolean; b2: byte);saveregisters; - begin - { boolean should be 8-bit always! } - if sizeof(boolean) <> 1 then RunError(255); - global_u8bit := byte(v); - value_u8bit := b2; - end; - - - procedure proc_value_bool16bit_mixed(b1 : byte; v: wordbool; b2: byte);saveregisters; - begin - global_u16bit := word(v); - value_u8bit := b2; - end; - - - procedure proc_value_bool32bit_mixed(b1 : byte; v : longbool; b2: byte);saveregisters; - begin - global_s32bit := longint(v); - value_u8bit := b2; - end; - - - procedure proc_value_s32real_mixed(b1: byte; v : single; b2: byte);saveregisters; - begin - global_s32real := v; - value_u8bit := b2; - end; - - procedure proc_value_s64real_mixed(b1: byte; v: double; b2: byte);saveregisters; - begin - global_s64real:= v; - value_u8bit := b2; - end; - - - procedure proc_value_pointerdef_mixed(b1: byte; p : pchar; b2: byte);saveregisters; - begin - global_ptr:=p; - value_u8bit := b2; - end; - - - procedure proc_value_procvardef_mixed(b1: byte; p : tprocedure; b2: byte);saveregisters; - begin - global_proc:=p; - value_u8bit := b2; - end; - - - - - procedure proc_value_smallrecord_mixed(b1: byte; smallrec : tsmallrecord; b2: byte);saveregisters; - begin - if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - procedure proc_value_largerecord_mixed(b1: byte; largerec : tlargerecord; b2: byte);saveregisters; - begin - if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - procedure proc_value_smallset_mixed(b1: byte; smallset : tsmallset; b2: byte);saveregisters; - begin - if A_D in smallset then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - - procedure proc_value_largeset_mixed(b1: byte; largeset : tlargeset; b2: byte);saveregisters; - begin - if 'I' in largeset then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - procedure proc_value_smallstring_mixed(b1: byte; s:tsmallstring; b2: byte);saveregisters; - begin - if s = RESULT_SMALLSTRING then - global_u8bit := RESULT_u8BIT; - value_u8bit := b2; - end; - - - procedure proc_value_bigstring_mixed(b1: byte; s:shortstring; b2: byte);saveregisters; - begin - if s = RESULT_BIGSTRING then - global_u8bit := RESULT_u8BIT; - value_u8bit := b2; - end; - - - procedure proc_value_smallarray_mixed(b1: byte; arr : tsmallarray; b2: byte);saveregisters; - begin - if arr[SMALL_INDEX] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - - procedure proc_value_smallarray_open_mixed(b1: byte; arr : array of byte; b2: byte);saveregisters; - begin - { form 0 to N-1 indexes in open arrays } - if arr[SMALL_INDEX-1] = RESULT_U8BIT then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; - -{$ifndef tp} - procedure proc_value_classrefdef_mixed(b1: byte; obj : tclass1; b2: byte);saveregisters; - begin - global_class:=obj; - value_u8bit := b2; - end; - - - procedure proc_value_s64bit_mixed(b1 : byte; v: int64; b2: byte);saveregisters; - begin - global_s64bit:= v; - value_u8bit := b2; - end; - - - procedure proc_value_smallarray_const_1_mixed(b1: byte; arr : array of const; b2: byte);saveregisters; - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : global_u8bit := arr[i].vinteger and $ff; - vtBoolean : global_boolean := arr[i].vboolean; - vtChar : global_char := arr[i].vchar; - vtExtended : global_s64real := arr[i].VExtended^; - vtString : global_bigstring := arr[i].VString^; - vtPointer : ; - vtPChar : global_ptr := arr[i].VPchar; - vtObject : ; -{ vtClass : global_class := (arr[i].VClass) as tclass1;} - vtAnsiString : ; - vtInt64 : global_s64bit := arr[i].vInt64^; - else - RunError(255); - end; - end; {endfor} - value_u8bit := b2; - end; - - - procedure proc_value_smallarray_const_2_mixed(b1: byte; arr : array of const; b2: byte);saveregisters; - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - value_u8bit := b2; - end; -{$endif} - - - -var - failed: boolean; -Begin - {***************************** NORMAL TESTS *******************************} - clear_globals; - clear_values; - - failed:=false; - - { LOC_REGISTER } - write('Value parameter test (src : LOC_REGISTER)...'); - proc_value_u8bit(getu8bit); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - proc_value_u16bit(getu16bit); - if global_u16bit <> RESULT_U16BIT then - failed:=true; - proc_value_s32bit(gets32bit); - if global_s32bit <> RESULT_S32BIT then - failed:=true; -{$ifndef tp} - proc_value_s64bit(gets64bit); - if global_s64bit <> RESULT_S64BIT then - failed:=true; -{$endif} - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_FPUREGISTER } - clear_globals; - clear_values; - failed:=false; - write('Value parameter test (src : LOC_FPUREGISTER)...'); - proc_value_s32real(gets32real); - if trunc(global_s32real) <> trunc(RESULT_S32REAL) then - failed:=true; - proc_value_s64real(gets64real); - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed:=true; - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_MEM, LOC_REFERENCE orddef } - clear_globals; - clear_values; - value_u8bit := RESULT_U8BIT; - value_u16bit := RESULT_U16BIT; - value_s32bit := RESULT_S32BIT; -{$ifndef tp} - value_s64bit := RESULT_S64BIT; -{$endif} - value_s32real := RESULT_S32REAL; - value_s64real := RESULT_S64REAL; - - failed:=false; - - { LOC_REFERENCE } - write('Value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...'); - proc_value_u8bit(value_u8bit); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - proc_value_u16bit(value_u16bit); - if global_u16bit <> RESULT_U16BIT then - failed:=true; - proc_value_s32bit(value_s32bit); - if global_s32bit <> RESULT_S32BIT then - failed:=true; -{$ifndef tp} - proc_value_s64bit(value_s64bit); - if global_s64bit <> RESULT_S64BIT then - failed:=true; -{$endif} - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_REFERENCE } - clear_globals; - failed:=false; - write('Value parameter test (src : LOC_REFERENCE (floatdef))...'); - proc_value_s32real(value_s32real); - if trunc(global_s32real) <> trunc(RESULT_S32REAL) then - failed:=true; - proc_value_s64real(value_s64real); - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed:=true; - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Value parameter test (src : LOC_REFERENCE (pointer))...'); - clear_globals; - clear_values; - failed:=false; - value_ptr := RESULT_PCHAR; - proc_value_pointerdef(value_ptr); - if global_ptr <> value_ptr then - failed := true; - - - value_proc := {$ifndef tp}@{$endif}testprocedure; - proc_value_procvardef(value_proc); - if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then - failed := true; - -{$ifndef tp} - value_class := tclass1.create; - proc_value_classrefdef(value_class); - if value_class <> global_class then - failed := true; - value_class.destroy; -{$endif} - if failed then - fail - else - WriteLn('Passed!'); - - - - - { LOC_REFERENCE } - clear_globals; - clear_values; - failed:=false; - value_u8bit := 0; - write('Value parameter test (src : LOC_FLAGS (orddef)))...'); - proc_value_bool8bit(value_u8bit = 0); - if global_u8bit <> RESULT_BOOL8BIT then - failed:=true; -{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x - proc_value_bool16bit(value_s64bit < 0); - if global_u16bit <> RESULT_BOOL16BIT then - failed:=true; - proc_value_bool32bit(bool1 and bool2); - if global_s32bit <> RESULT_BOOL32BIT then - failed:=true;*} - if failed then - fail - else - WriteLn('Passed!'); - - - -{$ifndef tp} - clear_globals; - clear_values; - failed:=false; - write('Value parameter test (src : LOC_JUMP (orddef)))...'); - proc_value_bool8bit(value_s64bit = 0); - if global_u8bit <> RESULT_BOOL8BIT then - failed:=true; -{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x - proc_value_bool16bit(value_s64bit < 0); - if global_u16bit <> RESULT_BOOL16BIT then - failed:=true; - proc_value_bool32bit(bool1 and bool2); - if global_s32bit <> RESULT_BOOL32BIT then - failed:=true;*} - if failed then - fail - else - WriteLn('Passed!'); -{$endif} - - { arraydef, - recorddef, - objectdef, - stringdef, - setdef : all considered the same by code generator. - } - write('Value parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallrec.b := RESULT_U8BIT; - value_smallrec.w := RESULT_U16BIT; - proc_value_smallrecord(value_smallrec); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); - proc_value_largerecord(value_largerec); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Value parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallset := [A_A,A_D]; - proc_value_smallset(value_smallset); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_largeset := ['I']; - proc_value_largeset(value_largeset); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - - - write('Value parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - value_smallstring := RESULT_SMALLSTRING; - - proc_value_smallstring(value_smallstring); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_bigstring := RESULT_BIGSTRING; - proc_value_bigstring(value_bigstring); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!} - { DON'T KNOW WHY/HOW TO TEST!!!!! } - - - write('Value parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - fillchar(value_smallarray,sizeof(value_smallarray),#0); - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_value_smallarray(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - fillchar(value_smallarray,sizeof(value_smallarray),#0); - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_value_smallarray_open(value_smallarray); - if global_u8bit <> RESULT_U8BIT then - failed := true; - -{$ifndef tp} - clear_globals; - clear_values; - - value_u8bit := RESULT_U8BIT; - value_ptr := RESULT_PCHAR; - value_s64bit := RESULT_S64BIT; - value_smallstring := RESULT_SMALLSTRING; - value_class := tclass1.create; - value_boolean := RESULT_BOOLEAN; - value_char := RESULT_CHAR; - value_s64real:=RESULT_S64REAL; - proc_value_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real, - value_boolean,value_class]); - - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if global_char <> RESULT_CHAR then - failed := true; - if global_boolean <> RESULT_BOOLEAN then - failed:=true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed := true; - if global_bigstring <> RESULT_SMALLSTRING then - failed := true; - if global_ptr <> value_ptr then - failed := true; -{ if value_class <> global_class then - failed := true;!!!!!!!!!!!!!!!!!!!!} - if global_s64bit <> RESULT_S64BIT then - failed := true; - if assigned(value_class) then - value_class.destroy; - - global_u8bit := 0; - proc_value_smallarray_const_2([]); - if global_u8bit <> RESULT_U8BIT then - failed := true; -{$endif fpc} - - if failed then - fail - else - WriteLn('Passed!'); - - {***************************** MIXED TESTS *******************************} - clear_globals; - clear_values; - - failed:=false; - - { LOC_REGISTER } - write('Mixed value parameter test (src : LOC_REGISTER)...'); - proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),getu8bit,RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - proc_value_u16bit_mixed(byte(NOT RESULT_U8BIT),getu16bit,RESULT_U8BIT); - if global_u16bit <> RESULT_U16BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - proc_value_s32bit_mixed(byte(NOT RESULT_U8BIT),gets32bit, RESULT_U8BIT); - if global_s32bit <> RESULT_S32BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$ifndef tp} - proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT),gets64bit,RESULT_U8BIT); - if global_s64bit <> RESULT_S64BIT then - failed:=true; -{$endif} - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_FPUREGISTER } - clear_globals; - clear_values; - failed:=false; - write('Mixed value parameter test (src : LOC_FPUREGISTER)...'); - proc_value_s32real_mixed(byte(NOT RESULT_U8BIT), gets32real, RESULT_U8BIT); - if value_u8bit <> RESULT_U8BIT then - failed := true; - if trunc(global_s32real) <> trunc(RESULT_S32REAL) then - failed:=true; - proc_value_s64real_mixed(byte(NOT RESULT_U8BIT),gets64real,RESULT_U8BIT); - if value_u8bit <> RESULT_U8BIT then - failed := true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed:=true; - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_MEM, LOC_REFERENCE orddef } - clear_globals; - clear_values; - value_u8bit := RESULT_U8BIT; - value_u16bit := RESULT_U16BIT; - value_s32bit := RESULT_S32BIT; -{$ifndef tp} - value_s64bit := RESULT_S64BIT; -{$endif} - value_s32real := RESULT_S32REAL; - value_s64real := RESULT_S64REAL; - - failed:=false; - - { LOC_REFERENCE } - write('Mixed value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...'); - proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),value_u8bit, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - proc_value_u16bit_mixed(byte(NOT RESULT_U8BIT),value_u16bit, RESULT_U8BIT); - if global_u16bit <> RESULT_U16BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - proc_value_s32bit_mixed(byte(NOT RESULT_U8BIT),value_s32bit, RESULT_U8BIT); - if global_s32bit <> RESULT_S32BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$ifndef tp} - proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit, RESULT_U8BIT); - if global_s64bit <> RESULT_S64BIT then - failed:=true; -{$endif} - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - { LOC_REFERENCE } - clear_globals; - failed:=false; - write('Mixed value parameter test (src : LOC_REFERENCE (floatdef))...'); - proc_value_s32real_mixed(byte(NOT RESULT_U8BIT), value_s32real, RESULT_U8BIT); - if trunc(global_s32real) <> trunc(RESULT_S32REAL) then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - proc_value_s64real_mixed(byte(NOT RESULT_U8BIT), value_s64real, RESULT_U8BIT); - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Mixed value parameter test (src : LOC_REFERENCE (pointer))...'); - clear_globals; - clear_values; - failed:=false; - value_ptr := RESULT_PCHAR; - proc_value_pointerdef_mixed(byte(NOT RESULT_U8BIT), value_ptr, RESULT_U8BIT); - if global_ptr <> value_ptr then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - - value_proc := {$ifndef tp}@{$endif}testprocedure; - proc_value_procvardef_mixed(byte(NOT RESULT_U8BIT), value_proc, RESULT_U8BIT); - if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then - failed := true; - -{$ifndef tp} - value_class := tclass1.create; - proc_value_classrefdef_mixed(byte(NOT RESULT_U8BIT), value_class, RESULT_U8BIT); - if value_class <> global_class then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - value_class.destroy; -{$endif} - if failed then - fail - else - WriteLn('Passed!'); - - - - - { LOC_REFERENCE } - clear_globals; - clear_values; - failed:=false; - value_u8bit := 0; - write('Mixed value parameter test (src : LOC_FLAGS (orddef)))...'); - proc_value_bool8bit_mixed(byte(NOT RESULT_U8BIT), value_u8bit = 0, RESULT_U8BIT); - if global_u8bit <> RESULT_BOOL8BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x - proc_value_bool16bit(value_s64bit < 0); - if global_u16bit <> RESULT_BOOL16BIT then - failed:=true; - proc_value_bool32bit(bool1 and bool2); - if global_s32bit <> RESULT_BOOL32BIT then - failed:=true;*} - if failed then - fail - else - WriteLn('Passed!'); - - - -{$ifndef tp} - clear_globals; - clear_values; - failed:=false; - write('Mixed value parameter test (src : LOC_JUMP (orddef)))...'); - proc_value_bool8bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit = 0, RESULT_U8BIT); - if global_u8bit <> RESULT_BOOL8BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x - proc_value_bool16bit(value_s64bit < 0); - if global_u16bit <> RESULT_BOOL16BIT then - failed:=true; - proc_value_bool32bit(bool1 and bool2); - if global_s32bit <> RESULT_BOOL32BIT then - failed:=true;*} - if failed then - fail - else - WriteLn('Passed!'); -{$endif} - - { arraydef, - recorddef, - objectdef, - stringdef, - setdef : all considered the same by code generator. - } - write('Mixed value parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallrec.b := RESULT_U8BIT; - value_smallrec.w := RESULT_U16BIT; - proc_value_smallrecord_mixed(byte(NOT RESULT_U8BIT), value_smallrec, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); - proc_value_largerecord_mixed(byte(NOT RESULT_U8BIT), value_largerec, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - write('Mixed value parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - value_smallset := [A_A,A_D]; - proc_value_smallset_mixed(byte(NOT RESULT_U8BIT), value_smallset, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_largeset := ['I']; - proc_value_largeset_mixed(byte(NOT RESULT_U8BIT), value_largeset, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - - - write('Mixed value parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - value_smallstring := RESULT_SMALLSTRING; - - proc_value_smallstring_mixed(byte(NOT RESULT_U8BIT), value_smallstring, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - value_bigstring := RESULT_BIGSTRING; - proc_value_bigstring_mixed(byte(NOT RESULT_U8BIT), value_bigstring, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - - { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!} - { DON'T KNOW WHY/HOW TO TEST!!!!! } - - - write('Mixed value parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - fillchar(value_smallarray,sizeof(value_smallarray),#0); - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_value_smallarray_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - - fillchar(value_smallarray,sizeof(value_smallarray),#0); - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_value_smallarray_open_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - -{$ifndef tp} - clear_globals; - clear_values; - - value_u8bit := RESULT_U8BIT; - value_ptr := RESULT_PCHAR; - value_s64bit := RESULT_S64BIT; - value_smallstring := RESULT_SMALLSTRING; - value_class := tclass1.create; - value_boolean := RESULT_BOOLEAN; - value_char := RESULT_CHAR; - value_s64real:=RESULT_S64REAL; - proc_value_smallarray_const_1_mixed(byte(NOT RESULT_U8BIT), [value_u8bit,value_ptr,value_s64bit,value_char, - value_smallstring,value_s64real,value_boolean,value_class], - RESULT_U8BIT); - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if global_char <> RESULT_CHAR then - failed := true; - if global_boolean <> RESULT_BOOLEAN then - failed:=true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed := true; - if global_bigstring <> RESULT_SMALLSTRING then - failed := true; - if global_ptr <> value_ptr then - failed := true; -{ if value_class <> global_class then - failed := true;!!!!!!!!!!!!!!!!!!!!} - if global_s64bit <> RESULT_S64BIT then - failed := true; - if assigned(value_class) then - value_class.destroy; - - global_u8bit := 0; - proc_value_smallarray_const_2_mixed(byte(NOT RESULT_U8BIT), [], RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; -{$endif} - - 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 } +{ (value parameters with saveregs calling convention) } +{****************************************************************} +program tcalval9; + +{$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_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; +{$ifndef tp} + global_s64bit := 0; + global_class := nil; +{$endif} + 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; +{$ifndef tp} + value_s64bit := 0; + value_class := nil; +{$endif} + end; + + + procedure testprocedure; + begin + end; + + function getu8bit : byte; + begin + getu8bit:=RESULT_U8BIT; + end; + + function getu16bit: word; + begin + getu16bit:=RESULT_U16BIT; + end; + + function gets32bit: longint; + begin + gets32bit:=RESULT_S32BIT; + end; + + function gets64bit: int64; + begin + gets64bit:=RESULT_S64BIT; + end; + + + function gets32real: single; + begin + gets32real:=RESULT_S32REAL; + end; + + function gets64real: double; + begin + gets64real:=RESULT_S64REAL; + end; + +{ ***************************************************************** } +{ VALUE PARAMETERS } +{ ***************************************************************** } + + procedure proc_value_u8bit(v: byte);saveregisters; + begin + global_u8bit := v; + end; + + + procedure proc_value_u16bit(v: word);saveregisters; + begin + global_u16bit := v; + end; + + + procedure proc_value_s32bit(v : longint);saveregisters; + begin + global_s32bit := v; + end; + + + + + procedure proc_value_bool8bit(v: boolean);saveregisters; + begin + { boolean should be 8-bit always! } + if sizeof(boolean) <> 1 then RunError(255); + global_u8bit := byte(v); + end; + + + procedure proc_value_bool16bit(v: wordbool);saveregisters; + begin + global_u16bit := word(v); + end; + + + procedure proc_value_bool32bit(v : longbool);saveregisters; + begin + global_s32bit := longint(v); + end; + + + procedure proc_value_s32real(v : single);saveregisters; + begin + global_s32real := v; + end; + + procedure proc_value_s64real(v: double);saveregisters; + begin + global_s64real:= v; + end; + + + procedure proc_value_pointerdef(p : pchar);saveregisters; + begin + global_ptr:=p; + end; + + + procedure proc_value_procvardef(p : tprocedure);saveregisters; + begin + global_proc:=p; + end; + + + + + procedure proc_value_smallrecord(smallrec : tsmallrecord);saveregisters; + begin + if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_value_largerecord(largerec : tlargerecord);saveregisters; + begin + if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_value_smallset(smallset : tsmallset);saveregisters; + begin + if A_D in smallset then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_value_largeset(largeset : tlargeset);saveregisters; + begin + if 'I' in largeset then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_value_smallstring(s:tsmallstring);saveregisters; + begin + if s = RESULT_SMALLSTRING then + global_u8bit := RESULT_u8BIT; + end; + + + procedure proc_value_bigstring(s:shortstring);saveregisters; + begin + if s = RESULT_BIGSTRING then + global_u8bit := RESULT_u8BIT; + end; + + + procedure proc_value_smallarray(arr : tsmallarray);saveregisters; + begin + if arr[SMALL_INDEX] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_value_smallarray_open(arr : array of byte);saveregisters; + begin + { form 0 to N-1 indexes in open arrays } + if arr[SMALL_INDEX-1] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + end; + +{$ifndef tp} + procedure proc_value_classrefdef(obj : tclass1);saveregisters; + begin + global_class:=obj; + end; + + + procedure proc_value_smallarray_const_1(arr : array of const);saveregisters; + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : global_u8bit := arr[i].vinteger and $ff; + vtBoolean : global_boolean := arr[i].vboolean; + vtChar : global_char := arr[i].vchar; + vtExtended : global_s64real := arr[i].VExtended^; + vtString : global_bigstring := arr[i].VString^; + vtPointer : ; + vtPChar : global_ptr := arr[i].VPchar; + vtObject : ; +{ vtClass : global_class := (arr[i].VClass) as tclass1;} + vtAnsiString : ; + vtInt64 : global_s64bit := arr[i].vInt64^; + else + RunError(255); + end; + end; {endfor} + end; + + + procedure proc_value_smallarray_const_2(arr : array of const);saveregisters; + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + end; + + procedure proc_value_s64bit(v: int64);saveregisters; + begin + global_s64bit:= v; + end; +{$endif} + + {********************************* MIXED PARAMETERS *************************} + + procedure proc_value_u8bit_mixed(b1 : byte; v: byte; b2: byte);saveregisters; + begin + global_u8bit := v; + value_u8bit := b2; + end; + + + procedure proc_value_u16bit_mixed(b1: byte; v: word; b2: byte);saveregisters; + begin + global_u16bit := v; + value_u8bit := b2; + end; + + + procedure proc_value_s32bit_mixed(b1 : byte; v : longint; b2: byte);saveregisters; + begin + global_s32bit := v; + value_u8bit := b2; + end; + + + + + procedure proc_value_bool8bit_mixed(b1: byte; v: boolean; b2: byte);saveregisters; + begin + { boolean should be 8-bit always! } + if sizeof(boolean) <> 1 then RunError(255); + global_u8bit := byte(v); + value_u8bit := b2; + end; + + + procedure proc_value_bool16bit_mixed(b1 : byte; v: wordbool; b2: byte);saveregisters; + begin + global_u16bit := word(v); + value_u8bit := b2; + end; + + + procedure proc_value_bool32bit_mixed(b1 : byte; v : longbool; b2: byte);saveregisters; + begin + global_s32bit := longint(v); + value_u8bit := b2; + end; + + + procedure proc_value_s32real_mixed(b1: byte; v : single; b2: byte);saveregisters; + begin + global_s32real := v; + value_u8bit := b2; + end; + + procedure proc_value_s64real_mixed(b1: byte; v: double; b2: byte);saveregisters; + begin + global_s64real:= v; + value_u8bit := b2; + end; + + + procedure proc_value_pointerdef_mixed(b1: byte; p : pchar; b2: byte);saveregisters; + begin + global_ptr:=p; + value_u8bit := b2; + end; + + + procedure proc_value_procvardef_mixed(b1: byte; p : tprocedure; b2: byte);saveregisters; + begin + global_proc:=p; + value_u8bit := b2; + end; + + + + + procedure proc_value_smallrecord_mixed(b1: byte; smallrec : tsmallrecord; b2: byte);saveregisters; + begin + if (smallrec.b = RESULT_U8BIT) and (smallrec.w = RESULT_U16BIT) then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + procedure proc_value_largerecord_mixed(b1: byte; largerec : tlargerecord; b2: byte);saveregisters; + begin + if (largerec.b[1] = RESULT_U8BIT) and (largerec.b[2] = RESULT_U8BIT) then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + procedure proc_value_smallset_mixed(b1: byte; smallset : tsmallset; b2: byte);saveregisters; + begin + if A_D in smallset then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + + procedure proc_value_largeset_mixed(b1: byte; largeset : tlargeset; b2: byte);saveregisters; + begin + if 'I' in largeset then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + procedure proc_value_smallstring_mixed(b1: byte; s:tsmallstring; b2: byte);saveregisters; + begin + if s = RESULT_SMALLSTRING then + global_u8bit := RESULT_u8BIT; + value_u8bit := b2; + end; + + + procedure proc_value_bigstring_mixed(b1: byte; s:shortstring; b2: byte);saveregisters; + begin + if s = RESULT_BIGSTRING then + global_u8bit := RESULT_u8BIT; + value_u8bit := b2; + end; + + + procedure proc_value_smallarray_mixed(b1: byte; arr : tsmallarray; b2: byte);saveregisters; + begin + if arr[SMALL_INDEX] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + + procedure proc_value_smallarray_open_mixed(b1: byte; arr : array of byte; b2: byte);saveregisters; + begin + { form 0 to N-1 indexes in open arrays } + if arr[SMALL_INDEX-1] = RESULT_U8BIT then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; + +{$ifndef tp} + procedure proc_value_classrefdef_mixed(b1: byte; obj : tclass1; b2: byte);saveregisters; + begin + global_class:=obj; + value_u8bit := b2; + end; + + + procedure proc_value_s64bit_mixed(b1 : byte; v: int64; b2: byte);saveregisters; + begin + global_s64bit:= v; + value_u8bit := b2; + end; + + + procedure proc_value_smallarray_const_1_mixed(b1: byte; arr : array of const; b2: byte);saveregisters; + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : global_u8bit := arr[i].vinteger and $ff; + vtBoolean : global_boolean := arr[i].vboolean; + vtChar : global_char := arr[i].vchar; + vtExtended : global_s64real := arr[i].VExtended^; + vtString : global_bigstring := arr[i].VString^; + vtPointer : ; + vtPChar : global_ptr := arr[i].VPchar; + vtObject : ; +{ vtClass : global_class := (arr[i].VClass) as tclass1;} + vtAnsiString : ; + vtInt64 : global_s64bit := arr[i].vInt64^; + else + RunError(255); + end; + end; {endfor} + value_u8bit := b2; + end; + + + procedure proc_value_smallarray_const_2_mixed(b1: byte; arr : array of const; b2: byte);saveregisters; + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + value_u8bit := b2; + end; +{$endif} + + + +var + failed: boolean; +Begin + {***************************** NORMAL TESTS *******************************} + clear_globals; + clear_values; + + failed:=false; + + { LOC_REGISTER } + write('Value parameter test (src : LOC_REGISTER)...'); + proc_value_u8bit(getu8bit); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + proc_value_u16bit(getu16bit); + if global_u16bit <> RESULT_U16BIT then + failed:=true; + proc_value_s32bit(gets32bit); + if global_s32bit <> RESULT_S32BIT then + failed:=true; +{$ifndef tp} + proc_value_s64bit(gets64bit); + if global_s64bit <> RESULT_S64BIT then + failed:=true; +{$endif} + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_FPUREGISTER } + clear_globals; + clear_values; + failed:=false; + write('Value parameter test (src : LOC_FPUREGISTER)...'); + proc_value_s32real(gets32real); + if trunc(global_s32real) <> trunc(RESULT_S32REAL) then + failed:=true; + proc_value_s64real(gets64real); + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed:=true; + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_MEM, LOC_REFERENCE orddef } + clear_globals; + clear_values; + value_u8bit := RESULT_U8BIT; + value_u16bit := RESULT_U16BIT; + value_s32bit := RESULT_S32BIT; +{$ifndef tp} + value_s64bit := RESULT_S64BIT; +{$endif} + value_s32real := RESULT_S32REAL; + value_s64real := RESULT_S64REAL; + + failed:=false; + + { LOC_REFERENCE } + write('Value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...'); + proc_value_u8bit(value_u8bit); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + proc_value_u16bit(value_u16bit); + if global_u16bit <> RESULT_U16BIT then + failed:=true; + proc_value_s32bit(value_s32bit); + if global_s32bit <> RESULT_S32BIT then + failed:=true; +{$ifndef tp} + proc_value_s64bit(value_s64bit); + if global_s64bit <> RESULT_S64BIT then + failed:=true; +{$endif} + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_REFERENCE } + clear_globals; + failed:=false; + write('Value parameter test (src : LOC_REFERENCE (floatdef))...'); + proc_value_s32real(value_s32real); + if trunc(global_s32real) <> trunc(RESULT_S32REAL) then + failed:=true; + proc_value_s64real(value_s64real); + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed:=true; + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Value parameter test (src : LOC_REFERENCE (pointer))...'); + clear_globals; + clear_values; + failed:=false; + value_ptr := RESULT_PCHAR; + proc_value_pointerdef(value_ptr); + if global_ptr <> value_ptr then + failed := true; + + + value_proc := {$ifndef tp}@{$endif}testprocedure; + proc_value_procvardef(value_proc); + if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then + failed := true; + +{$ifndef tp} + value_class := tclass1.create; + proc_value_classrefdef(value_class); + if value_class <> global_class then + failed := true; + value_class.destroy; +{$endif} + if failed then + fail + else + WriteLn('Passed!'); + + + + + { LOC_REFERENCE } + clear_globals; + clear_values; + failed:=false; + value_u8bit := 0; + write('Value parameter test (src : LOC_FLAGS (orddef)))...'); + proc_value_bool8bit(value_u8bit = 0); + if global_u8bit <> RESULT_BOOL8BIT then + failed:=true; +{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x + proc_value_bool16bit(value_s64bit < 0); + if global_u16bit <> RESULT_BOOL16BIT then + failed:=true; + proc_value_bool32bit(bool1 and bool2); + if global_s32bit <> RESULT_BOOL32BIT then + failed:=true;*} + if failed then + fail + else + WriteLn('Passed!'); + + + +{$ifndef tp} + clear_globals; + clear_values; + failed:=false; + write('Value parameter test (src : LOC_JUMP (orddef)))...'); + proc_value_bool8bit(value_s64bit = 0); + if global_u8bit <> RESULT_BOOL8BIT then + failed:=true; +{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x + proc_value_bool16bit(value_s64bit < 0); + if global_u16bit <> RESULT_BOOL16BIT then + failed:=true; + proc_value_bool32bit(bool1 and bool2); + if global_s32bit <> RESULT_BOOL32BIT then + failed:=true;*} + if failed then + fail + else + WriteLn('Passed!'); +{$endif} + + { arraydef, + recorddef, + objectdef, + stringdef, + setdef : all considered the same by code generator. + } + write('Value parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallrec.b := RESULT_U8BIT; + value_smallrec.w := RESULT_U16BIT; + proc_value_smallrecord(value_smallrec); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); + proc_value_largerecord(value_largerec); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Value parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallset := [A_A,A_D]; + proc_value_smallset(value_smallset); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_largeset := ['I']; + proc_value_largeset(value_largeset); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + + + write('Value parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + value_smallstring := RESULT_SMALLSTRING; + + proc_value_smallstring(value_smallstring); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_bigstring := RESULT_BIGSTRING; + proc_value_bigstring(value_bigstring); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!} + { DON'T KNOW WHY/HOW TO TEST!!!!! } + + + write('Value parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + fillchar(value_smallarray,sizeof(value_smallarray),#0); + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_value_smallarray(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + fillchar(value_smallarray,sizeof(value_smallarray),#0); + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_value_smallarray_open(value_smallarray); + if global_u8bit <> RESULT_U8BIT then + failed := true; + +{$ifndef tp} + clear_globals; + clear_values; + + value_u8bit := RESULT_U8BIT; + value_ptr := RESULT_PCHAR; + value_s64bit := RESULT_S64BIT; + value_smallstring := RESULT_SMALLSTRING; + value_class := tclass1.create; + value_boolean := RESULT_BOOLEAN; + value_char := RESULT_CHAR; + value_s64real:=RESULT_S64REAL; + proc_value_smallarray_const_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real, + value_boolean,value_class]); + + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if global_char <> RESULT_CHAR then + failed := true; + if global_boolean <> RESULT_BOOLEAN then + failed:=true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed := true; + if global_bigstring <> RESULT_SMALLSTRING then + failed := true; + if global_ptr <> value_ptr then + failed := true; +{ if value_class <> global_class then + failed := true;!!!!!!!!!!!!!!!!!!!!} + if global_s64bit <> RESULT_S64BIT then + failed := true; + if assigned(value_class) then + value_class.destroy; + + global_u8bit := 0; + proc_value_smallarray_const_2([]); + if global_u8bit <> RESULT_U8BIT then + failed := true; +{$endif fpc} + + if failed then + fail + else + WriteLn('Passed!'); + + {***************************** MIXED TESTS *******************************} + clear_globals; + clear_values; + + failed:=false; + + { LOC_REGISTER } + write('Mixed value parameter test (src : LOC_REGISTER)...'); + proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),getu8bit,RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + proc_value_u16bit_mixed(byte(NOT RESULT_U8BIT),getu16bit,RESULT_U8BIT); + if global_u16bit <> RESULT_U16BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + proc_value_s32bit_mixed(byte(NOT RESULT_U8BIT),gets32bit, RESULT_U8BIT); + if global_s32bit <> RESULT_S32BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$ifndef tp} + proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT),gets64bit,RESULT_U8BIT); + if global_s64bit <> RESULT_S64BIT then + failed:=true; +{$endif} + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_FPUREGISTER } + clear_globals; + clear_values; + failed:=false; + write('Mixed value parameter test (src : LOC_FPUREGISTER)...'); + proc_value_s32real_mixed(byte(NOT RESULT_U8BIT), gets32real, RESULT_U8BIT); + if value_u8bit <> RESULT_U8BIT then + failed := true; + if trunc(global_s32real) <> trunc(RESULT_S32REAL) then + failed:=true; + proc_value_s64real_mixed(byte(NOT RESULT_U8BIT),gets64real,RESULT_U8BIT); + if value_u8bit <> RESULT_U8BIT then + failed := true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed:=true; + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_MEM, LOC_REFERENCE orddef } + clear_globals; + clear_values; + value_u8bit := RESULT_U8BIT; + value_u16bit := RESULT_U16BIT; + value_s32bit := RESULT_S32BIT; +{$ifndef tp} + value_s64bit := RESULT_S64BIT; +{$endif} + value_s32real := RESULT_S32REAL; + value_s64real := RESULT_S64REAL; + + failed:=false; + + { LOC_REFERENCE } + write('Mixed value parameter test (src : LOC_REFERENCE (orddef/enumdef)))...'); + proc_value_u8bit_mixed(byte(NOT RESULT_U8BIT),value_u8bit, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + proc_value_u16bit_mixed(byte(NOT RESULT_U8BIT),value_u16bit, RESULT_U8BIT); + if global_u16bit <> RESULT_U16BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + proc_value_s32bit_mixed(byte(NOT RESULT_U8BIT),value_s32bit, RESULT_U8BIT); + if global_s32bit <> RESULT_S32BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$ifndef tp} + proc_value_s64bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit, RESULT_U8BIT); + if global_s64bit <> RESULT_S64BIT then + failed:=true; +{$endif} + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + { LOC_REFERENCE } + clear_globals; + failed:=false; + write('Mixed value parameter test (src : LOC_REFERENCE (floatdef))...'); + proc_value_s32real_mixed(byte(NOT RESULT_U8BIT), value_s32real, RESULT_U8BIT); + if trunc(global_s32real) <> trunc(RESULT_S32REAL) then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + proc_value_s64real_mixed(byte(NOT RESULT_U8BIT), value_s64real, RESULT_U8BIT); + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Mixed value parameter test (src : LOC_REFERENCE (pointer))...'); + clear_globals; + clear_values; + failed:=false; + value_ptr := RESULT_PCHAR; + proc_value_pointerdef_mixed(byte(NOT RESULT_U8BIT), value_ptr, RESULT_U8BIT); + if global_ptr <> value_ptr then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + + value_proc := {$ifndef tp}@{$endif}testprocedure; + proc_value_procvardef_mixed(byte(NOT RESULT_U8BIT), value_proc, RESULT_U8BIT); + if {$ifndef fpc}@{$endif}value_proc <> {$ifndef fpc}@{$endif}global_proc then + failed := true; + +{$ifndef tp} + value_class := tclass1.create; + proc_value_classrefdef_mixed(byte(NOT RESULT_U8BIT), value_class, RESULT_U8BIT); + if value_class <> global_class then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + value_class.destroy; +{$endif} + if failed then + fail + else + WriteLn('Passed!'); + + + + + { LOC_REFERENCE } + clear_globals; + clear_values; + failed:=false; + value_u8bit := 0; + write('Mixed value parameter test (src : LOC_FLAGS (orddef)))...'); + proc_value_bool8bit_mixed(byte(NOT RESULT_U8BIT), value_u8bit = 0, RESULT_U8BIT); + if global_u8bit <> RESULT_BOOL8BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{* IMPOSSIBLE TO GENERATE LOC_FLAGS WITH SIZE <> S_B ON VERSION 1.0.x + proc_value_bool16bit(value_s64bit < 0); + if global_u16bit <> RESULT_BOOL16BIT then + failed:=true; + proc_value_bool32bit(bool1 and bool2); + if global_s32bit <> RESULT_BOOL32BIT then + failed:=true;*} + if failed then + fail + else + WriteLn('Passed!'); + + + +{$ifndef tp} + clear_globals; + clear_values; + failed:=false; + write('Mixed value parameter test (src : LOC_JUMP (orddef)))...'); + proc_value_bool8bit_mixed(byte(NOT RESULT_U8BIT), value_s64bit = 0, RESULT_U8BIT); + if global_u8bit <> RESULT_BOOL8BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{* IMPOSSIBLE TO GENERATE LOC_JUMP WITH SIZE <> S_B ON VERSION 1.0.x + proc_value_bool16bit(value_s64bit < 0); + if global_u16bit <> RESULT_BOOL16BIT then + failed:=true; + proc_value_bool32bit(bool1 and bool2); + if global_s32bit <> RESULT_BOOL32BIT then + failed:=true;*} + if failed then + fail + else + WriteLn('Passed!'); +{$endif} + + { arraydef, + recorddef, + objectdef, + stringdef, + setdef : all considered the same by code generator. + } + write('Mixed value parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallrec.b := RESULT_U8BIT; + value_smallrec.w := RESULT_U16BIT; + proc_value_smallrecord_mixed(byte(NOT RESULT_U8BIT), value_smallrec, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + fillchar(value_largerec,sizeof(value_largerec),RESULT_U8BIT); + proc_value_largerecord_mixed(byte(NOT RESULT_U8BIT), value_largerec, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + write('Mixed value parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + value_smallset := [A_A,A_D]; + proc_value_smallset_mixed(byte(NOT RESULT_U8BIT), value_smallset, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_largeset := ['I']; + proc_value_largeset_mixed(byte(NOT RESULT_U8BIT), value_largeset, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + + + write('Mixed value parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + value_smallstring := RESULT_SMALLSTRING; + + proc_value_smallstring_mixed(byte(NOT RESULT_U8BIT), value_smallstring, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + value_bigstring := RESULT_BIGSTRING; + proc_value_bigstring_mixed(byte(NOT RESULT_U8BIT), value_bigstring, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + + { open array by value with cdecl modifier!!!!!!!!!!!!!!!!!!!!!!!!!!!} + { DON'T KNOW WHY/HOW TO TEST!!!!! } + + + write('Mixed value parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + fillchar(value_smallarray,sizeof(value_smallarray),#0); + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_value_smallarray_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + + fillchar(value_smallarray,sizeof(value_smallarray),#0); + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_value_smallarray_open_mixed(byte(NOT RESULT_U8BIT), value_smallarray, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + +{$ifndef tp} + clear_globals; + clear_values; + + value_u8bit := RESULT_U8BIT; + value_ptr := RESULT_PCHAR; + value_s64bit := RESULT_S64BIT; + value_smallstring := RESULT_SMALLSTRING; + value_class := tclass1.create; + value_boolean := RESULT_BOOLEAN; + value_char := RESULT_CHAR; + value_s64real:=RESULT_S64REAL; + proc_value_smallarray_const_1_mixed(byte(NOT RESULT_U8BIT), [value_u8bit,value_ptr,value_s64bit,value_char, + value_smallstring,value_s64real,value_boolean,value_class], + RESULT_U8BIT); + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if global_char <> RESULT_CHAR then + failed := true; + if global_boolean <> RESULT_BOOLEAN then + failed:=true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed := true; + if global_bigstring <> RESULT_SMALLSTRING then + failed := true; + if global_ptr <> value_ptr then + failed := true; +{ if value_class <> global_class then + failed := true;!!!!!!!!!!!!!!!!!!!!} + if global_s64bit <> RESULT_S64BIT then + failed := true; + if assigned(value_class) then + value_class.destroy; + + global_u8bit := 0; + proc_value_smallarray_const_2_mixed(byte(NOT RESULT_U8BIT), [], RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; +{$endif} + + if failed then + fail + else + WriteLn('Passed!'); + +end. + + +{ $Log$ - Revision 1.4 2002-09-22 09:08:41 carl - * gets64bit was not returning an int64! - - Revision 1.3 2002/09/07 15:40:55 peter - * old logs removed and tabs fixed - - Revision 1.2 2002/05/13 13:45:38 peter - * updated to compile tests with kylix - - Revision 1.1 2002/04/13 17:49:45 carl - + value parameter passing for different calling conventions - -} + Revision 1.5 2003-04-22 10:24:29 florian + * fixed defines for powerpc + + Revision 1.4 2002/09/22 09:08:41 carl + * gets64bit was not returning an int64! + + Revision 1.3 2002/09/07 15:40:55 peter + * old logs removed and tabs fixed + + Revision 1.2 2002/05/13 13:45:38 peter + * updated to compile tests with kylix + + Revision 1.1 2002/04/13 17:49:45 carl + + value parameter passing for different calling conventions + +} diff --git a/tests/test/cg/tcalvar1.pp b/tests/test/cg/tcalvar1.pp index b7af1b2717..0a44f38c90 100644 --- a/tests/test/cg/tcalvar1.pp +++ b/tests/test/cg/tcalvar1.pp @@ -1,831 +1,833 @@ -{****************************************************************} -{ 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 } -{ (var parameters with standard calling convention) } -{****************************************************************} -program tcalvar1; -{$mode objfpc} -{$INLINE ON} -{$R+} -{$P-} -{$V+} - -{$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; - {$endif} - {$ifdef cpui386} - 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 - tclass1 = class - end; - - 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_s64bit : int64; - global_s32real : single; - global_s64real : double; - global_ptr : pchar; - global_proc : tprocedure; - global_class : tclass1; - global_bigstring : shortstring; - global_boolean : boolean; - global_char : char; - value_u8bit : byte; - value_u16bit : word; - value_s32bit : longint; - value_s64bit : int64; - value_s32real : single; - value_s64real : double; - value_proc : tprocedure; - value_ptr : pchar; - value_class : tclass1; - 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_s64bit := 0; - global_s32real := 0.0; - global_s64real := 0.0; - global_ptr := nil; - global_proc := nil; - global_class := nil; - global_bigstring := ''; - global_boolean := false; - global_char := #0; - end; - - - procedure clear_values; - begin - value_u8bit := 0; - value_u16bit := 0; - value_s32bit := 0; - value_s64bit := 0; - value_s32real := 0.0; - value_s64real := 0.0; - value_proc := nil; - value_ptr := nil; - value_class := 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; - end; - - - procedure testprocedure; - begin - end; - - function getu8bit : byte; - begin - getu8bit:=RESULT_U8BIT; - end; - - function getu16bit: word; - begin - getu16bit:=RESULT_U16BIT; - end; - - function gets32bit: longint; - begin - gets32bit:=RESULT_S32BIT; - end; - - function gets64bit: int64; - begin - gets64bit:=RESULT_S64BIT; - end; - - - function gets32real: single; - begin - gets32real:=RESULT_S32REAL; - end; - - function gets64real: double; - begin - gets64real:=RESULT_S64REAL; - end; - - {************************************************************************} - { VAR PARAMETERS } - {************************************************************************} - procedure proc_var_s32bit(var v : longint); - begin - v:=RESULT_S32BIT; - end; - - procedure proc_var_s64bit(var v: int64); - begin - v:=RESULT_S64BIT; - end; - - - procedure proc_var_u8bit(var v: byte); - begin - v:=RESULT_U8BIT; - end; - - procedure proc_var_smallrecord(var smallrec : tsmallrecord); - begin - smallrec.b := RESULT_U8BIT; - smallrec.w := RESULT_U16BIT; - end; - - - procedure proc_var_largerecord(var largerec : tlargerecord); - begin - largerec.b[1] := RESULT_U8BIT; - largerec.b[2] := RESULT_U8BIT; - end; - - - procedure proc_var_smallset(var smallset : tsmallset); - begin - smallset := [A_A,A_D]; - end; - - - procedure proc_var_largeset(var largeset : tlargeset); - begin - largeset:= largeset + ['I']; - end; - - - procedure proc_var_smallstring(var s:tsmallstring); - begin - s:=RESULT_SMALLSTRING; - end; - - - procedure proc_var_bigstring(var s:shortstring); - begin - s:=RESULT_BIGSTRING; - end; - - - procedure proc_var_openstring(var s: OpenString); - begin - global_u8bit := high(s); - s:=RESULT_SMALLSTRING; - end; - - procedure proc_var_smallarray(var arr : tsmallarray); - begin - arr[SMALL_INDEX] := RESULT_U8BIT; - arr[1] := RESULT_U8BIT; - end; - - procedure proc_var_smallarray_open(var arr : array of byte); - begin - arr[high(arr)] := RESULT_U8BIT; - arr[low(arr)] := RESULT_U8BIT; - end; - - procedure proc_var_smallarray_const_1(var arr : array of const); - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : arr[i].vinteger := RESULT_U8BIT; - vtBoolean : arr[i].vboolean := RESULT_BOOLEAN; - else - RunError(255); - end; - end; {endfor} - end; - - - procedure proc_var_smallarray_const_2(var arr : array of const); - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_formaldef_array(var buf); - var - p: ^byte; - begin - { array is indexed from 1 } - p := @buf; - p[SMALL_INDEX-1] := RESULT_U8BIT; - p[0] := RESULT_U8BIT; - end; - - -procedure proc_var_formaldef_string(var buf); - var - p: ^byte; - begin - { array is indexed from 1 } - p := @buf; - p[SMALL_INDEX-1] := RESULT_U8BIT; - p[0] := RESULT_U8BIT; - end; - - - {************************************************************************} - { MIXED VAR PARAMETERS } - {************************************************************************} - procedure proc_var_s32bit_mixed(b1 : byte;var v : longint; b2: byte); - begin - v:=RESULT_S32BIT; - value_u8bit := RESULT_U8BIT; - end; - - procedure proc_var_s64bit_mixed(b1 : byte;var v: int64; b2: byte); - begin - v:=RESULT_S64BIT; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_u8bit_mixed(b1 : byte;var v: byte; b2: byte); - begin - v:=RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - - procedure proc_var_smallrecord_mixed(b1 : byte; var smallrec : tsmallrecord; b2: byte); - begin - smallrec.b := RESULT_U8BIT; - smallrec.w := RESULT_U16BIT; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_largerecord_mixed(b1 : byte; var largerec : tlargerecord; b2: byte); - begin - largerec.b[1] := RESULT_U8BIT; - largerec.b[2] := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_smallset_mixed(b1 : byte; var smallset : tsmallset; b2: byte); - begin - smallset := [A_A,A_D]; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_largeset_mixed(b1 : byte; var largeset : tlargeset; b2: byte); - begin - largeset:= largeset + ['I']; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_smallstring_mixed(b1 : byte; var s:tsmallstring; b2: byte); - begin - s:=RESULT_SMALLSTRING; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_bigstring_mixed(b1 : byte; var s:shortstring; b2: byte); - begin - s:=RESULT_BIGSTRING; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_openstring_mixed(b1 : byte; var s: OpenString; b2: byte); - begin - global_u8bit := high(s); - s:=RESULT_SMALLSTRING; - value_u8bit := RESULT_U8BIT; - end; - - procedure proc_var_smallarray_mixed(b1 : byte; var arr : tsmallarray; b2: byte); - begin - arr[SMALL_INDEX] := RESULT_U8BIT; - arr[1] := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - - procedure proc_var_smallarray_open_mixed(b1 : byte; var arr : array of byte; b2: byte); - begin - arr[high(arr)] := RESULT_U8BIT; - arr[low(arr)] := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - - procedure proc_var_smallarray_const_1_mixed(b1 : byte; var arr : array of const; b2: byte); - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : arr[i].vinteger := RESULT_U8BIT; - vtBoolean : arr[i].vboolean := RESULT_BOOLEAN; - else - RunError(255); - end; - end; {endfor} - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_smallarray_const_2_mixed(b1 : byte; var arr : array of const; b2: byte); - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; -end; - - - procedure proc_var_formaldef_array_mixed(b1 : byte; var buf; b2: byte); - var - p: ^byte; - begin - { array is indexed from 1 } - p := @buf; - p[SMALL_INDEX-1] := RESULT_U8BIT; - p[0] := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - - -procedure proc_var_formaldef_string_mixed(b1 : byte; var buf; b2: byte); - var - p: ^byte; - begin - { array is indexed from 1 } - p := @buf; - p[SMALL_INDEX-1] := RESULT_U8BIT; - p[0] := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - -var - failed: boolean; - pp : ^pchar; -begin - {***************************** NORMAL TESTS *******************************} - clear_globals; - clear_values; - failed:=false; - - write('Var parameter test (src : LOC_REFERENCE (orddef)))...'); - proc_var_s32bit(global_s32bit); - if global_s32bit <> RESULT_S32BIT then - failed:=true; - - clear_globals; - clear_values; - proc_var_s64bit(global_s64bit); - if global_s64bit <> RESULT_S64BIT then - failed:=true; - - clear_globals; - clear_values; - proc_var_u8bit(global_u8bit); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - - - if failed then - fail - else - WriteLn('Passed!'); - - write('Var parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - proc_var_smallrecord(value_smallrec); - if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then - failed := true; - - clear_globals; - clear_values; - proc_var_largerecord(value_largerec); - if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - write('var parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - proc_var_smallset(value_smallset); - if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then - failed := true; - - clear_globals; - clear_values; - proc_var_largeset(value_largeset); - if not ('I' in value_largeset) then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - write('var parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - proc_var_smallstring(value_smallstring); - if value_smallstring <> RESULT_SMALLSTRING then - failed := true; - - clear_globals; - clear_values; - proc_var_bigstring(value_bigstring); - if value_bigstring <> RESULT_BIGSTRING then - failed := true; - - clear_globals; - clear_values; - proc_var_openstring(value_smallstring); - if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - - write('Var parameter test (src : LOC_REFERENCE (formaldef)))...'); - clear_globals; - clear_values; - failed:=false; - - proc_var_formaldef_array(value_smallarray); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - write('Var parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_var_smallarray(value_smallarray); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - - - - clear_globals; - clear_values; - - proc_var_smallarray_open(value_smallarray); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - -(* HOW CAN ARRAY OF CONST VAR PARAMETERS BE TESTED? - clear_globals; - clear_values; - value_u8bit := RESULT_U8BIT; - value_ptr := RESULT_PCHAR; - value_s64bit := RESULT_S64BIT; - value_smallstring := RESULT_SMALLSTRING; - value_class := tclass1.create; - value_boolean := RESULT_BOOLEAN; - value_char := RESULT_CHAR; - value_s64real:=RESULT_S64REAL; - proc_var_smallarray_var_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,value_boolean,value_class]); - - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if global_char <> RESULT_CHAR then - failed := true; - if global_boolean <> RESULT_BOOLEAN then - failed:=true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed := true; - if global_bigstring <> RESULT_SMALLSTRING then - failed := true; - if global_ptr <> value_ptr then - failed := true; -{ if value_class <> global_class then - failed := true;!!!!!!!!!!!!!!!!!!!!} - if global_s64bit <> RESULT_S64BIT then - failed := true; - if assigned(value_class) then - value_class.destroy; - global_u8bit := 0; - proc_var_smallarray_const_2([]); - if global_u8bit <> RESULT_U8BIT then - failed := true; -*) - - - if failed then - fail - else - WriteLn('Passed!'); - - {***************************** MIXED TESTS *******************************} - clear_globals; - clear_values; - failed:=false; - - write('Var parameter test (src : LOC_REFERENCE (orddef)))...'); - proc_var_s32bit_mixed(RESULT_U8BIT, global_s32bit, RESULT_U8BIT); - if global_s32bit <> RESULT_S32BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_s64bit_mixed(RESULT_U8BIT, global_s64bit, RESULT_U8BIT); - if global_s64bit <> RESULT_S64BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_u8bit_mixed(RESULT_U8BIT, global_u8bit, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - write('Var parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - proc_var_smallrecord_mixed(RESULT_U8BIT,value_smallrec, RESULT_U8BIT); - if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_largerecord_mixed(RESULT_U8BIT, value_largerec, RESULT_U8BIT); - if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - write('var parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - proc_var_smallset_mixed(RESULT_U8BIT, value_smallset, RESULT_U8BIT); - if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_largeset_mixed(RESULT_U8BIT, value_largeset, RESULT_U8BIT); - if not ('I' in value_largeset) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - write('var parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - proc_var_smallstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT); - if value_smallstring <> RESULT_SMALLSTRING then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_bigstring_mixed(RESULT_U8BIT, value_bigstring,RESULT_U8BIT); - if value_bigstring <> RESULT_BIGSTRING then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_openstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT); - if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - - write('Var parameter test (src : LOC_REFERENCE (formaldef)))...'); - clear_globals; - clear_values; - failed:=false; - - proc_var_formaldef_array_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - write('Var parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_var_smallarray_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - - - clear_globals; - clear_values; - - proc_var_smallarray_open_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - if value_u8bit <> RESULT_U8BIT 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 } +{ (var parameters with standard calling convention) } +{****************************************************************} +program tcalvar1; +{$mode objfpc} +{$INLINE ON} +{$R+} +{$P-} +{$V+} + +{$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 + tclass1 = class + end; + + 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_s64bit : int64; + global_s32real : single; + global_s64real : double; + global_ptr : pchar; + global_proc : tprocedure; + global_class : tclass1; + global_bigstring : shortstring; + global_boolean : boolean; + global_char : char; + value_u8bit : byte; + value_u16bit : word; + value_s32bit : longint; + value_s64bit : int64; + value_s32real : single; + value_s64real : double; + value_proc : tprocedure; + value_ptr : pchar; + value_class : tclass1; + 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_s64bit := 0; + global_s32real := 0.0; + global_s64real := 0.0; + global_ptr := nil; + global_proc := nil; + global_class := nil; + global_bigstring := ''; + global_boolean := false; + global_char := #0; + end; + + + procedure clear_values; + begin + value_u8bit := 0; + value_u16bit := 0; + value_s32bit := 0; + value_s64bit := 0; + value_s32real := 0.0; + value_s64real := 0.0; + value_proc := nil; + value_ptr := nil; + value_class := 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; + end; + + + procedure testprocedure; + begin + end; + + function getu8bit : byte; + begin + getu8bit:=RESULT_U8BIT; + end; + + function getu16bit: word; + begin + getu16bit:=RESULT_U16BIT; + end; + + function gets32bit: longint; + begin + gets32bit:=RESULT_S32BIT; + end; + + function gets64bit: int64; + begin + gets64bit:=RESULT_S64BIT; + end; + + + function gets32real: single; + begin + gets32real:=RESULT_S32REAL; + end; + + function gets64real: double; + begin + gets64real:=RESULT_S64REAL; + end; + + {************************************************************************} + { VAR PARAMETERS } + {************************************************************************} + procedure proc_var_s32bit(var v : longint); + begin + v:=RESULT_S32BIT; + end; + + procedure proc_var_s64bit(var v: int64); + begin + v:=RESULT_S64BIT; + end; + + + procedure proc_var_u8bit(var v: byte); + begin + v:=RESULT_U8BIT; + end; + + procedure proc_var_smallrecord(var smallrec : tsmallrecord); + begin + smallrec.b := RESULT_U8BIT; + smallrec.w := RESULT_U16BIT; + end; + + + procedure proc_var_largerecord(var largerec : tlargerecord); + begin + largerec.b[1] := RESULT_U8BIT; + largerec.b[2] := RESULT_U8BIT; + end; + + + procedure proc_var_smallset(var smallset : tsmallset); + begin + smallset := [A_A,A_D]; + end; + + + procedure proc_var_largeset(var largeset : tlargeset); + begin + largeset:= largeset + ['I']; + end; + + + procedure proc_var_smallstring(var s:tsmallstring); + begin + s:=RESULT_SMALLSTRING; + end; + + + procedure proc_var_bigstring(var s:shortstring); + begin + s:=RESULT_BIGSTRING; + end; + + + procedure proc_var_openstring(var s: OpenString); + begin + global_u8bit := high(s); + s:=RESULT_SMALLSTRING; + end; + + procedure proc_var_smallarray(var arr : tsmallarray); + begin + arr[SMALL_INDEX] := RESULT_U8BIT; + arr[1] := RESULT_U8BIT; + end; + + procedure proc_var_smallarray_open(var arr : array of byte); + begin + arr[high(arr)] := RESULT_U8BIT; + arr[low(arr)] := RESULT_U8BIT; + end; + + procedure proc_var_smallarray_const_1(var arr : array of const); + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : arr[i].vinteger := RESULT_U8BIT; + vtBoolean : arr[i].vboolean := RESULT_BOOLEAN; + else + RunError(255); + end; + end; {endfor} + end; + + + procedure proc_var_smallarray_const_2(var arr : array of const); + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_formaldef_array(var buf); + var + p: ^byte; + begin + { array is indexed from 1 } + p := @buf; + p[SMALL_INDEX-1] := RESULT_U8BIT; + p[0] := RESULT_U8BIT; + end; + + +procedure proc_var_formaldef_string(var buf); + var + p: ^byte; + begin + { array is indexed from 1 } + p := @buf; + p[SMALL_INDEX-1] := RESULT_U8BIT; + p[0] := RESULT_U8BIT; + end; + + + {************************************************************************} + { MIXED VAR PARAMETERS } + {************************************************************************} + procedure proc_var_s32bit_mixed(b1 : byte;var v : longint; b2: byte); + begin + v:=RESULT_S32BIT; + value_u8bit := RESULT_U8BIT; + end; + + procedure proc_var_s64bit_mixed(b1 : byte;var v: int64; b2: byte); + begin + v:=RESULT_S64BIT; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_u8bit_mixed(b1 : byte;var v: byte; b2: byte); + begin + v:=RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + + procedure proc_var_smallrecord_mixed(b1 : byte; var smallrec : tsmallrecord; b2: byte); + begin + smallrec.b := RESULT_U8BIT; + smallrec.w := RESULT_U16BIT; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_largerecord_mixed(b1 : byte; var largerec : tlargerecord; b2: byte); + begin + largerec.b[1] := RESULT_U8BIT; + largerec.b[2] := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_smallset_mixed(b1 : byte; var smallset : tsmallset; b2: byte); + begin + smallset := [A_A,A_D]; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_largeset_mixed(b1 : byte; var largeset : tlargeset; b2: byte); + begin + largeset:= largeset + ['I']; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_smallstring_mixed(b1 : byte; var s:tsmallstring; b2: byte); + begin + s:=RESULT_SMALLSTRING; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_bigstring_mixed(b1 : byte; var s:shortstring; b2: byte); + begin + s:=RESULT_BIGSTRING; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_openstring_mixed(b1 : byte; var s: OpenString; b2: byte); + begin + global_u8bit := high(s); + s:=RESULT_SMALLSTRING; + value_u8bit := RESULT_U8BIT; + end; + + procedure proc_var_smallarray_mixed(b1 : byte; var arr : tsmallarray; b2: byte); + begin + arr[SMALL_INDEX] := RESULT_U8BIT; + arr[1] := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + + procedure proc_var_smallarray_open_mixed(b1 : byte; var arr : array of byte; b2: byte); + begin + arr[high(arr)] := RESULT_U8BIT; + arr[low(arr)] := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + + procedure proc_var_smallarray_const_1_mixed(b1 : byte; var arr : array of const; b2: byte); + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : arr[i].vinteger := RESULT_U8BIT; + vtBoolean : arr[i].vboolean := RESULT_BOOLEAN; + else + RunError(255); + end; + end; {endfor} + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_smallarray_const_2_mixed(b1 : byte; var arr : array of const; b2: byte); + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; +end; + + + procedure proc_var_formaldef_array_mixed(b1 : byte; var buf; b2: byte); + var + p: ^byte; + begin + { array is indexed from 1 } + p := @buf; + p[SMALL_INDEX-1] := RESULT_U8BIT; + p[0] := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + + +procedure proc_var_formaldef_string_mixed(b1 : byte; var buf; b2: byte); + var + p: ^byte; + begin + { array is indexed from 1 } + p := @buf; + p[SMALL_INDEX-1] := RESULT_U8BIT; + p[0] := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + +var + failed: boolean; + pp : ^pchar; +begin + {***************************** NORMAL TESTS *******************************} + clear_globals; + clear_values; + failed:=false; + + write('Var parameter test (src : LOC_REFERENCE (orddef)))...'); + proc_var_s32bit(global_s32bit); + if global_s32bit <> RESULT_S32BIT then + failed:=true; + + clear_globals; + clear_values; + proc_var_s64bit(global_s64bit); + if global_s64bit <> RESULT_S64BIT then + failed:=true; + + clear_globals; + clear_values; + proc_var_u8bit(global_u8bit); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + + + if failed then + fail + else + WriteLn('Passed!'); + + write('Var parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + proc_var_smallrecord(value_smallrec); + if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then + failed := true; + + clear_globals; + clear_values; + proc_var_largerecord(value_largerec); + if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + write('var parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + proc_var_smallset(value_smallset); + if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then + failed := true; + + clear_globals; + clear_values; + proc_var_largeset(value_largeset); + if not ('I' in value_largeset) then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + write('var parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + proc_var_smallstring(value_smallstring); + if value_smallstring <> RESULT_SMALLSTRING then + failed := true; + + clear_globals; + clear_values; + proc_var_bigstring(value_bigstring); + if value_bigstring <> RESULT_BIGSTRING then + failed := true; + + clear_globals; + clear_values; + proc_var_openstring(value_smallstring); + if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + + write('Var parameter test (src : LOC_REFERENCE (formaldef)))...'); + clear_globals; + clear_values; + failed:=false; + + proc_var_formaldef_array(value_smallarray); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + write('Var parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_var_smallarray(value_smallarray); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + + + + clear_globals; + clear_values; + + proc_var_smallarray_open(value_smallarray); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + +(* HOW CAN ARRAY OF CONST VAR PARAMETERS BE TESTED? + clear_globals; + clear_values; + value_u8bit := RESULT_U8BIT; + value_ptr := RESULT_PCHAR; + value_s64bit := RESULT_S64BIT; + value_smallstring := RESULT_SMALLSTRING; + value_class := tclass1.create; + value_boolean := RESULT_BOOLEAN; + value_char := RESULT_CHAR; + value_s64real:=RESULT_S64REAL; + proc_var_smallarray_var_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,value_boolean,value_class]); + + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if global_char <> RESULT_CHAR then + failed := true; + if global_boolean <> RESULT_BOOLEAN then + failed:=true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed := true; + if global_bigstring <> RESULT_SMALLSTRING then + failed := true; + if global_ptr <> value_ptr then + failed := true; +{ if value_class <> global_class then + failed := true;!!!!!!!!!!!!!!!!!!!!} + if global_s64bit <> RESULT_S64BIT then + failed := true; + if assigned(value_class) then + value_class.destroy; + global_u8bit := 0; + proc_var_smallarray_const_2([]); + if global_u8bit <> RESULT_U8BIT then + failed := true; +*) + + + if failed then + fail + else + WriteLn('Passed!'); + + {***************************** MIXED TESTS *******************************} + clear_globals; + clear_values; + failed:=false; + + write('Var parameter test (src : LOC_REFERENCE (orddef)))...'); + proc_var_s32bit_mixed(RESULT_U8BIT, global_s32bit, RESULT_U8BIT); + if global_s32bit <> RESULT_S32BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_s64bit_mixed(RESULT_U8BIT, global_s64bit, RESULT_U8BIT); + if global_s64bit <> RESULT_S64BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_u8bit_mixed(RESULT_U8BIT, global_u8bit, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + write('Var parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + proc_var_smallrecord_mixed(RESULT_U8BIT,value_smallrec, RESULT_U8BIT); + if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_largerecord_mixed(RESULT_U8BIT, value_largerec, RESULT_U8BIT); + if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + write('var parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + proc_var_smallset_mixed(RESULT_U8BIT, value_smallset, RESULT_U8BIT); + if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_largeset_mixed(RESULT_U8BIT, value_largeset, RESULT_U8BIT); + if not ('I' in value_largeset) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + write('var parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + proc_var_smallstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT); + if value_smallstring <> RESULT_SMALLSTRING then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_bigstring_mixed(RESULT_U8BIT, value_bigstring,RESULT_U8BIT); + if value_bigstring <> RESULT_BIGSTRING then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_openstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT); + if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + + write('Var parameter test (src : LOC_REFERENCE (formaldef)))...'); + clear_globals; + clear_values; + failed:=false; + + proc_var_formaldef_array_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + write('Var parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_var_smallarray_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + + + clear_globals; + clear_values; + + proc_var_smallarray_open_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + +end. + + +{ $Log$ - Revision 1.4 2002-09-22 09:08:41 carl - * gets64bit was not returning an int64! - - Revision 1.3 2002/09/07 15:40:55 peter - * old logs removed and tabs fixed - - Revision 1.2 2002/05/13 13:45:38 peter - * updated to compile tests with kylix - - Revision 1.1 2002/04/10 16:33:19 carl - + first tries at first calln testing - - -} + Revision 1.5 2003-04-22 10:24:29 florian + * fixed defines for powerpc + + Revision 1.4 2002/09/22 09:08:41 carl + * gets64bit was not returning an int64! + + Revision 1.3 2002/09/07 15:40:55 peter + * old logs removed and tabs fixed + + Revision 1.2 2002/05/13 13:45:38 peter + * updated to compile tests with kylix + + Revision 1.1 2002/04/10 16:33:19 carl + + first tries at first calln testing + + +} diff --git a/tests/test/cg/tcalvar2.pp b/tests/test/cg/tcalvar2.pp index 309c9b391e..1ec1bdf31e 100644 --- a/tests/test/cg/tcalvar2.pp +++ b/tests/test/cg/tcalvar2.pp @@ -1,501 +1,503 @@ -{****************************************************************} -{ 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 } -{ (var with inline calling convention) } -{****************************************************************} -program tcalvar2; -{$mode objfpc} -{$INLINE ON} -{$P-} -{$V+} -{$R+} - -{$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; - {$endif} - {$ifdef cpui386} - 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 - tclass1 = class - end; - - 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_s64bit : int64; - global_s32real : single; - global_s64real : double; - global_ptr : pchar; - global_proc : tprocedure; - global_class : tclass1; - global_bigstring : shortstring; - global_boolean : boolean; - global_char : char; - value_u8bit : byte; - value_u16bit : word; - value_s32bit : longint; - value_s64bit : int64; - value_s32real : single; - value_s64real : double; - value_proc : tprocedure; - value_ptr : pchar; - value_class : tclass1; - 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_s64bit := 0; - global_s32real := 0.0; - global_s64real := 0.0; - global_ptr := nil; - global_proc := nil; - global_class := nil; - global_bigstring := ''; - global_boolean := false; - global_char := #0; - end; - - - procedure clear_values; - begin - value_u8bit := 0; - value_u16bit := 0; - value_s32bit := 0; - value_s64bit := 0; - value_s32real := 0.0; - value_s64real := 0.0; - value_proc := nil; - value_ptr := nil; - value_class := 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; - end; - - - procedure testprocedure; - begin - end; - - function getu8bit : byte; - begin - getu8bit:=RESULT_U8BIT; - end; - - function getu16bit: word; - begin - getu16bit:=RESULT_U16BIT; - end; - - function gets32bit: longint; - begin - gets32bit:=RESULT_S32BIT; - end; - - function gets64bit: int64; - begin - gets64bit:=RESULT_S64BIT; - end; - - - function gets32real: single; - begin - gets32real:=RESULT_S32REAL; - end; - - function gets64real: double; - begin - gets64real:=RESULT_S64REAL; - end; - - {************************************************************************} - { VAR PARAMETERS (INLINE) } - {************************************************************************} - procedure proc_var_s32bit_inline(var v : longint);inline; - begin - v:=RESULT_S32BIT; - end; - - procedure proc_var_s64bit_inline(var v: int64);inline; - begin - v:=RESULT_S64BIT; - end; - - - procedure proc_var_u8bit_inline(var v: byte);inline; - begin - v:=RESULT_U8BIT; - end; - - procedure proc_var_smallrecord_inline(var smallrec : tsmallrecord);inline; - begin - smallrec.b := RESULT_U8BIT; - smallrec.w := RESULT_U16BIT; - end; - - - procedure proc_var_largerecord_inline(var largerec : tlargerecord);inline; - begin - largerec.b[1] := RESULT_U8BIT; - largerec.b[2] := RESULT_U8BIT; - end; - - - procedure proc_var_smallset_inline(var smallset : tsmallset);inline; - begin - smallset := [A_A,A_D]; - end; - - - procedure proc_var_largeset_inline(var largeset : tlargeset);inline; - begin - largeset:= largeset + ['I']; - end; - - - procedure proc_var_smallstring_inline(var s:tsmallstring);inline; - begin - s:=RESULT_SMALLSTRING; - end; - - - procedure proc_var_bigstring_inline(var s:shortstring);inline; - begin - s:=RESULT_BIGSTRING; - end; - - - procedure proc_var_openstring_inline(var s: OpenString);inline; - begin - global_u8bit := high(s); - s:=RESULT_SMALLSTRING; - end; - - procedure proc_var_smallarray_inline(var arr : tsmallarray);inline; - begin - arr[SMALL_INDEX] := RESULT_U8BIT; - arr[1] := RESULT_U8BIT; - end; - - procedure proc_var_smallarray_open_inline(var arr : array of byte);inline; - begin - arr[high(arr)] := RESULT_U8BIT; - arr[low(arr)] := RESULT_U8BIT; - end; - -{!!!!!!!!!!!!!!!!!! DON'T KNOW HOWTO TEST} - procedure proc_var_smallarray_const_1_inline(var arr : array of const);inline; - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : arr[i].vinteger := RESULT_U8BIT; - vtBoolean : arr[i].vboolean := RESULT_BOOLEAN; - else - RunError(255); - end; - end; {endfor} - end; - - - procedure proc_var_smallarray_const_2_inline(var arr : array of const);inline; - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_formaldef_array_inline(var buf);inline; - var - p: ^byte; - begin - { array is indexed from 1 } - p := @buf; - p[SMALL_INDEX-1] := RESULT_U8BIT; - p[0] := RESULT_U8BIT; - end; - - -procedure proc_var_formaldef_string_inline(var buf);inline; - var - p: ^byte; - begin - { array is indexed from 1 } - p := @buf; - p[SMALL_INDEX-1] := RESULT_U8BIT; - p[0] := RESULT_U8BIT; - end; - - -var - failed: boolean; - pp : ^pchar; -begin - {***************************** INLINE TESTS *******************************} - write('(Inline) var parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - proc_var_smallrecord_inline(value_smallrec); - if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then - failed := true; - - clear_globals; - clear_values; - proc_var_largerecord_inline(value_largerec); - if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - write('(Inline) var parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - proc_var_smallset_inline(value_smallset); - if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then - failed := true; - - clear_globals; - clear_values; - proc_var_largeset_inline(value_largeset); - if not ('I' in value_largeset) then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - write('(Inline) var parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - proc_var_smallstring_inline(value_smallstring); - if value_smallstring <> RESULT_SMALLSTRING then - failed := true; - - clear_globals; - clear_values; - proc_var_bigstring_inline(value_bigstring); - if value_bigstring <> RESULT_BIGSTRING then - failed := true; - - clear_globals; - clear_values; - proc_var_openstring_inline(value_smallstring); - if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - write('(Inline) Var parameter test (src : LOC_REFERENCE (formaldef)))...'); - clear_globals; - clear_values; - failed:=false; - - proc_var_formaldef_array_inline(value_smallarray); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - write('(Inline) Var parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_var_smallarray_inline(value_smallarray); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - - - - clear_globals; - clear_values; - - proc_var_smallarray_open_inline(value_smallarray); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - - -(* HOW CAN ARRAY OF CONST VAR PARAMETERS BE TESTED? - clear_globals; - clear_values; - value_u8bit := RESULT_U8BIT; - value_ptr := RESULT_PCHAR; - value_s64bit := RESULT_S64BIT; - value_smallstring := RESULT_SMALLSTRING; - value_class := tclass1.create; - value_boolean := RESULT_BOOLEAN; - value_char := RESULT_CHAR; - value_s64real:=RESULT_S64REAL; - proc_var_smallarray_var_1_inline([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,value_boolean,value_class]); - - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if global_char <> RESULT_CHAR then - failed := true; - if global_boolean <> RESULT_BOOLEAN then - failed:=true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed := true; - if global_bigstring <> RESULT_SMALLSTRING then - failed := true; - if global_ptr <> value_ptr then - failed := true; -{ if value_class <> global_class then - failed := true;!!!!!!!!!!!!!!!!!!!!} - if global_s64bit <> RESULT_S64BIT then - failed := true; - if assigned(value_class) then - value_class.destroy; - global_u8bit := 0; - proc_var_smallarray_const_2_inline([]); - if global_u8bit <> RESULT_U8BIT 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 } +{ (var with inline calling convention) } +{****************************************************************} +program tcalvar2; +{$mode objfpc} +{$INLINE ON} +{$P-} +{$V+} +{$R+} + +{$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 + tclass1 = class + end; + + 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_s64bit : int64; + global_s32real : single; + global_s64real : double; + global_ptr : pchar; + global_proc : tprocedure; + global_class : tclass1; + global_bigstring : shortstring; + global_boolean : boolean; + global_char : char; + value_u8bit : byte; + value_u16bit : word; + value_s32bit : longint; + value_s64bit : int64; + value_s32real : single; + value_s64real : double; + value_proc : tprocedure; + value_ptr : pchar; + value_class : tclass1; + 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_s64bit := 0; + global_s32real := 0.0; + global_s64real := 0.0; + global_ptr := nil; + global_proc := nil; + global_class := nil; + global_bigstring := ''; + global_boolean := false; + global_char := #0; + end; + + + procedure clear_values; + begin + value_u8bit := 0; + value_u16bit := 0; + value_s32bit := 0; + value_s64bit := 0; + value_s32real := 0.0; + value_s64real := 0.0; + value_proc := nil; + value_ptr := nil; + value_class := 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; + end; + + + procedure testprocedure; + begin + end; + + function getu8bit : byte; + begin + getu8bit:=RESULT_U8BIT; + end; + + function getu16bit: word; + begin + getu16bit:=RESULT_U16BIT; + end; + + function gets32bit: longint; + begin + gets32bit:=RESULT_S32BIT; + end; + + function gets64bit: int64; + begin + gets64bit:=RESULT_S64BIT; + end; + + + function gets32real: single; + begin + gets32real:=RESULT_S32REAL; + end; + + function gets64real: double; + begin + gets64real:=RESULT_S64REAL; + end; + + {************************************************************************} + { VAR PARAMETERS (INLINE) } + {************************************************************************} + procedure proc_var_s32bit_inline(var v : longint);inline; + begin + v:=RESULT_S32BIT; + end; + + procedure proc_var_s64bit_inline(var v: int64);inline; + begin + v:=RESULT_S64BIT; + end; + + + procedure proc_var_u8bit_inline(var v: byte);inline; + begin + v:=RESULT_U8BIT; + end; + + procedure proc_var_smallrecord_inline(var smallrec : tsmallrecord);inline; + begin + smallrec.b := RESULT_U8BIT; + smallrec.w := RESULT_U16BIT; + end; + + + procedure proc_var_largerecord_inline(var largerec : tlargerecord);inline; + begin + largerec.b[1] := RESULT_U8BIT; + largerec.b[2] := RESULT_U8BIT; + end; + + + procedure proc_var_smallset_inline(var smallset : tsmallset);inline; + begin + smallset := [A_A,A_D]; + end; + + + procedure proc_var_largeset_inline(var largeset : tlargeset);inline; + begin + largeset:= largeset + ['I']; + end; + + + procedure proc_var_smallstring_inline(var s:tsmallstring);inline; + begin + s:=RESULT_SMALLSTRING; + end; + + + procedure proc_var_bigstring_inline(var s:shortstring);inline; + begin + s:=RESULT_BIGSTRING; + end; + + + procedure proc_var_openstring_inline(var s: OpenString);inline; + begin + global_u8bit := high(s); + s:=RESULT_SMALLSTRING; + end; + + procedure proc_var_smallarray_inline(var arr : tsmallarray);inline; + begin + arr[SMALL_INDEX] := RESULT_U8BIT; + arr[1] := RESULT_U8BIT; + end; + + procedure proc_var_smallarray_open_inline(var arr : array of byte);inline; + begin + arr[high(arr)] := RESULT_U8BIT; + arr[low(arr)] := RESULT_U8BIT; + end; + +{!!!!!!!!!!!!!!!!!! DON'T KNOW HOWTO TEST} + procedure proc_var_smallarray_const_1_inline(var arr : array of const);inline; + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : arr[i].vinteger := RESULT_U8BIT; + vtBoolean : arr[i].vboolean := RESULT_BOOLEAN; + else + RunError(255); + end; + end; {endfor} + end; + + + procedure proc_var_smallarray_const_2_inline(var arr : array of const);inline; + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_formaldef_array_inline(var buf);inline; + var + p: ^byte; + begin + { array is indexed from 1 } + p := @buf; + p[SMALL_INDEX-1] := RESULT_U8BIT; + p[0] := RESULT_U8BIT; + end; + + +procedure proc_var_formaldef_string_inline(var buf);inline; + var + p: ^byte; + begin + { array is indexed from 1 } + p := @buf; + p[SMALL_INDEX-1] := RESULT_U8BIT; + p[0] := RESULT_U8BIT; + end; + + +var + failed: boolean; + pp : ^pchar; +begin + {***************************** INLINE TESTS *******************************} + write('(Inline) var parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + proc_var_smallrecord_inline(value_smallrec); + if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then + failed := true; + + clear_globals; + clear_values; + proc_var_largerecord_inline(value_largerec); + if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + write('(Inline) var parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + proc_var_smallset_inline(value_smallset); + if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then + failed := true; + + clear_globals; + clear_values; + proc_var_largeset_inline(value_largeset); + if not ('I' in value_largeset) then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + write('(Inline) var parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + proc_var_smallstring_inline(value_smallstring); + if value_smallstring <> RESULT_SMALLSTRING then + failed := true; + + clear_globals; + clear_values; + proc_var_bigstring_inline(value_bigstring); + if value_bigstring <> RESULT_BIGSTRING then + failed := true; + + clear_globals; + clear_values; + proc_var_openstring_inline(value_smallstring); + if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + write('(Inline) Var parameter test (src : LOC_REFERENCE (formaldef)))...'); + clear_globals; + clear_values; + failed:=false; + + proc_var_formaldef_array_inline(value_smallarray); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + write('(Inline) Var parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_var_smallarray_inline(value_smallarray); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + + + + clear_globals; + clear_values; + + proc_var_smallarray_open_inline(value_smallarray); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + + +(* HOW CAN ARRAY OF CONST VAR PARAMETERS BE TESTED? + clear_globals; + clear_values; + value_u8bit := RESULT_U8BIT; + value_ptr := RESULT_PCHAR; + value_s64bit := RESULT_S64BIT; + value_smallstring := RESULT_SMALLSTRING; + value_class := tclass1.create; + value_boolean := RESULT_BOOLEAN; + value_char := RESULT_CHAR; + value_s64real:=RESULT_S64REAL; + proc_var_smallarray_var_1_inline([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,value_boolean,value_class]); + + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if global_char <> RESULT_CHAR then + failed := true; + if global_boolean <> RESULT_BOOLEAN then + failed:=true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed := true; + if global_bigstring <> RESULT_SMALLSTRING then + failed := true; + if global_ptr <> value_ptr then + failed := true; +{ if value_class <> global_class then + failed := true;!!!!!!!!!!!!!!!!!!!!} + if global_s64bit <> RESULT_S64BIT then + failed := true; + if assigned(value_class) then + value_class.destroy; + global_u8bit := 0; + proc_var_smallarray_const_2_inline([]); + if global_u8bit <> RESULT_U8BIT then + failed := true; +*) + if failed then + fail + else + WriteLn('Passed!'); + +end. + + +{ $Log$ - Revision 1.4 2002-09-22 09:08:41 carl - * gets64bit was not returning an int64! - - Revision 1.3 2002/09/07 15:40:55 peter - * old logs removed and tabs fixed - - Revision 1.2 2002/05/13 13:45:38 peter - * updated to compile tests with kylix - - Revision 1.1 2002/04/10 16:33:19 carl - + first tries at first calln testing - - -} + Revision 1.5 2003-04-22 10:24:29 florian + * fixed defines for powerpc + + Revision 1.4 2002/09/22 09:08:41 carl + * gets64bit was not returning an int64! + + Revision 1.3 2002/09/07 15:40:55 peter + * old logs removed and tabs fixed + + Revision 1.2 2002/05/13 13:45:38 peter + * updated to compile tests with kylix + + Revision 1.1 2002/04/10 16:33:19 carl + + first tries at first calln testing + + +} diff --git a/tests/test/cg/tcalvar3.pp b/tests/test/cg/tcalvar3.pp index c544d90227..6374a90ce7 100644 --- a/tests/test/cg/tcalvar3.pp +++ b/tests/test/cg/tcalvar3.pp @@ -1,838 +1,840 @@ -{****************************************************************} -{ 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 } -{ (var parameters with pascal calling convention) } -{****************************************************************} -program tcalvar3; -{$mode objfpc} -{$INLINE ON} -{$R+} -{$P-} -{$V+} - -{$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; - {$endif} - {$ifdef cpui386} - 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 -{$ifdef fpc} - pbytearr=^byte; -{$else} - pbytearr=^tbytearr; - tbytearr=array[0..$fffffff] of byte; -{$endif} - - tclass1 = class - end; - - 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_s64bit : int64; - global_s32real : single; - global_s64real : double; - global_ptr : pchar; - global_proc : tprocedure; - global_class : tclass1; - global_bigstring : shortstring; - global_boolean : boolean; - global_char : char; - value_u8bit : byte; - value_u16bit : word; - value_s32bit : longint; - value_s64bit : int64; - value_s32real : single; - value_s64real : double; - value_proc : tprocedure; - value_ptr : pchar; - value_class : tclass1; - 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_s64bit := 0; - global_s32real := 0.0; - global_s64real := 0.0; - global_ptr := nil; - global_proc := nil; - global_class := nil; - global_bigstring := ''; - global_boolean := false; - global_char := #0; - end; - - - procedure clear_values; - begin - value_u8bit := 0; - value_u16bit := 0; - value_s32bit := 0; - value_s64bit := 0; - value_s32real := 0.0; - value_s64real := 0.0; - value_proc := nil; - value_ptr := nil; - value_class := 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; - end; - - - procedure testprocedure; - begin - end; - - function getu8bit : byte; - begin - getu8bit:=RESULT_U8BIT; - end; - - function getu16bit: word; - begin - getu16bit:=RESULT_U16BIT; - end; - - function gets32bit: longint; - begin - gets32bit:=RESULT_S32BIT; - end; - - function gets64bit: int64; - begin - gets64bit:=RESULT_S64BIT; - end; - - - function gets32real: single; - begin - gets32real:=RESULT_S32REAL; - end; - - function gets64real: double; - begin - gets64real:=RESULT_S64REAL; - end; - - {************************************************************************} - { VAR PARAMETERS } - {************************************************************************} - procedure proc_var_s32bit(var v : longint);pascal; - begin - v:=RESULT_S32BIT; - end; - - procedure proc_var_s64bit(var v: int64);pascal; - begin - v:=RESULT_S64BIT; - end; - - - procedure proc_var_u8bit(var v: byte);pascal; - begin - v:=RESULT_U8BIT; - end; - - procedure proc_var_smallrecord(var smallrec : tsmallrecord);pascal; - begin - smallrec.b := RESULT_U8BIT; - smallrec.w := RESULT_U16BIT; - end; - - - procedure proc_var_largerecord(var largerec : tlargerecord);pascal; - begin - largerec.b[1] := RESULT_U8BIT; - largerec.b[2] := RESULT_U8BIT; - end; - - - procedure proc_var_smallset(var smallset : tsmallset);pascal; - begin - smallset := [A_A,A_D]; - end; - - - procedure proc_var_largeset(var largeset : tlargeset);pascal; - begin - largeset:= largeset + ['I']; - end; - - - procedure proc_var_smallstring(var s:tsmallstring);pascal; - begin - s:=RESULT_SMALLSTRING; - end; - - - procedure proc_var_bigstring(var s:shortstring);pascal; - begin - s:=RESULT_BIGSTRING; - end; - - - procedure proc_var_openstring(var s: OpenString);pascal; - begin - global_u8bit := high(s); - s:=RESULT_SMALLSTRING; - end; - - procedure proc_var_smallarray(var arr : tsmallarray);pascal; - begin - arr[SMALL_INDEX] := RESULT_U8BIT; - arr[1] := RESULT_U8BIT; - end; - - procedure proc_var_smallarray_open(var arr : array of byte);pascal; - begin - arr[high(arr)] := RESULT_U8BIT; - arr[low(arr)] := RESULT_U8BIT; - end; - - procedure proc_var_smallarray_const_1(var arr : array of const);pascal; - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : arr[i].vinteger := RESULT_U8BIT; - vtBoolean : arr[i].vboolean := RESULT_BOOLEAN; - else - RunError(255); - end; - end; {endfor} - end; - - - procedure proc_var_smallarray_const_2(var arr : array of const);pascal; - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_formaldef_array(var buf);pascal; - var - p: pbytearr; - begin - { array is indexed from 1 } - p := @buf; - p[SMALL_INDEX-1] := RESULT_U8BIT; - p[0] := RESULT_U8BIT; - end; - - -procedure proc_var_formaldef_string(var buf);pascal; - var - p: pbytearr; - begin - { array is indexed from 1 } - p := @buf; - p[SMALL_INDEX-1] := RESULT_U8BIT; - p[0] := RESULT_U8BIT; - end; - - - {************************************************************************} - { MIXED VAR PARAMETERS } - {************************************************************************} - procedure proc_var_s32bit_mixed(b1 : byte;var v : longint; b2: byte);pascal; - begin - v:=RESULT_S32BIT; - value_u8bit := RESULT_U8BIT; - end; - - procedure proc_var_s64bit_mixed(b1 : byte;var v: int64; b2: byte);pascal; - begin - v:=RESULT_S64BIT; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_u8bit_mixed(b1 : byte;var v: byte; b2: byte);pascal; - begin - v:=RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - - procedure proc_var_smallrecord_mixed(b1 : byte; var smallrec : tsmallrecord; b2: byte);pascal; - begin - smallrec.b := RESULT_U8BIT; - smallrec.w := RESULT_U16BIT; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_largerecord_mixed(b1 : byte; var largerec : tlargerecord; b2: byte);pascal; - begin - largerec.b[1] := RESULT_U8BIT; - largerec.b[2] := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_smallset_mixed(b1 : byte; var smallset : tsmallset; b2: byte);pascal; - begin - smallset := [A_A,A_D]; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_largeset_mixed(b1 : byte; var largeset : tlargeset; b2: byte);pascal; - begin - largeset:= largeset + ['I']; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_smallstring_mixed(b1 : byte; var s:tsmallstring; b2: byte);pascal; - begin - s:=RESULT_SMALLSTRING; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_bigstring_mixed(b1 : byte; var s:shortstring; b2: byte);pascal; - begin - s:=RESULT_BIGSTRING; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_openstring_mixed(b1 : byte; var s: OpenString; b2: byte);pascal; - begin - global_u8bit := high(s); - s:=RESULT_SMALLSTRING; - value_u8bit := RESULT_U8BIT; - end; - - procedure proc_var_smallarray_mixed(b1 : byte; var arr : tsmallarray; b2: byte);pascal; - begin - arr[SMALL_INDEX] := RESULT_U8BIT; - arr[1] := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - - procedure proc_var_smallarray_open_mixed(b1 : byte; var arr : array of byte; b2: byte);pascal; - begin - arr[high(arr)] := RESULT_U8BIT; - arr[low(arr)] := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - - procedure proc_var_smallarray_const_1_mixed(b1 : byte; var arr : array of const; b2: byte);pascal; - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : arr[i].vinteger := RESULT_U8BIT; - vtBoolean : arr[i].vboolean := RESULT_BOOLEAN; - else - RunError(255); - end; - end; {endfor} - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_smallarray_const_2_mixed(b1 : byte; var arr : array of const; b2: byte);pascal; - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; -end; - - - procedure proc_var_formaldef_array_mixed(b1 : byte; var buf; b2: byte);pascal; - var - p: pbytearr; - begin - { array is indexed from 1 } - p := @buf; - p[SMALL_INDEX-1] := RESULT_U8BIT; - p[0] := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - - -procedure proc_var_formaldef_string_mixed(b1 : byte; var buf; b2: byte);pascal; - var - p: pbytearr; - begin - { array is indexed from 1 } - p := @buf; - p[SMALL_INDEX-1] := RESULT_U8BIT; - p[0] := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - -var - failed: boolean; - pp : ^pchar; -begin - {***************************** NORMAL TESTS *******************************} - clear_globals; - clear_values; - failed:=false; - - write('Var parameter test (src : LOC_REFERENCE (orddef)))...'); - proc_var_s32bit(global_s32bit); - if global_s32bit <> RESULT_S32BIT then - failed:=true; - - clear_globals; - clear_values; - proc_var_s64bit(global_s64bit); - if global_s64bit <> RESULT_S64BIT then - failed:=true; - - clear_globals; - clear_values; - proc_var_u8bit(global_u8bit); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - - - if failed then - fail - else - WriteLn('Passed!'); - - write('Var parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - proc_var_smallrecord(value_smallrec); - if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then - failed := true; - - clear_globals; - clear_values; - proc_var_largerecord(value_largerec); - if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - write('var parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - proc_var_smallset(value_smallset); - if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then - failed := true; - - clear_globals; - clear_values; - proc_var_largeset(value_largeset); - if not ('I' in value_largeset) then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - write('var parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - proc_var_smallstring(value_smallstring); - if value_smallstring <> RESULT_SMALLSTRING then - failed := true; - - clear_globals; - clear_values; - proc_var_bigstring(value_bigstring); - if value_bigstring <> RESULT_BIGSTRING then - failed := true; - - clear_globals; - clear_values; - proc_var_openstring(value_smallstring); - if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - - write('Var parameter test (src : LOC_REFERENCE (formaldef)))...'); - clear_globals; - clear_values; - failed:=false; - - proc_var_formaldef_array(value_smallarray); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - write('Var parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_var_smallarray(value_smallarray); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - - - - clear_globals; - clear_values; - - proc_var_smallarray_open(value_smallarray); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - -(* HOW CAN ARRAY OF CONST VAR PARAMETERS BE TESTED? - clear_globals; - clear_values; - value_u8bit := RESULT_U8BIT; - value_ptr := RESULT_PCHAR; - value_s64bit := RESULT_S64BIT; - value_smallstring := RESULT_SMALLSTRING; - value_class := tclass1.create; - value_boolean := RESULT_BOOLEAN; - value_char := RESULT_CHAR; - value_s64real:=RESULT_S64REAL; - proc_var_smallarray_var_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,value_boolean,value_class]); - - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if global_char <> RESULT_CHAR then - failed := true; - if global_boolean <> RESULT_BOOLEAN then - failed:=true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed := true; - if global_bigstring <> RESULT_SMALLSTRING then - failed := true; - if global_ptr <> value_ptr then - failed := true; -{ if value_class <> global_class then - failed := true;!!!!!!!!!!!!!!!!!!!!} - if global_s64bit <> RESULT_S64BIT then - failed := true; - if assigned(value_class) then - value_class.destroy; - global_u8bit := 0; - proc_var_smallarray_const_2([]); - if global_u8bit <> RESULT_U8BIT then - failed := true; -*) - - - if failed then - fail - else - WriteLn('Passed!'); - - {***************************** MIXED TESTS *******************************} - clear_globals; - clear_values; - failed:=false; - - write('Var parameter test (src : LOC_REFERENCE (orddef)))...'); - proc_var_s32bit_mixed(RESULT_U8BIT, global_s32bit, RESULT_U8BIT); - if global_s32bit <> RESULT_S32BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_s64bit_mixed(RESULT_U8BIT, global_s64bit, RESULT_U8BIT); - if global_s64bit <> RESULT_S64BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_u8bit_mixed(RESULT_U8BIT, global_u8bit, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - write('Var parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - proc_var_smallrecord_mixed(RESULT_U8BIT,value_smallrec, RESULT_U8BIT); - if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_largerecord_mixed(RESULT_U8BIT, value_largerec, RESULT_U8BIT); - if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - write('var parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - proc_var_smallset_mixed(RESULT_U8BIT, value_smallset, RESULT_U8BIT); - if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_largeset_mixed(RESULT_U8BIT, value_largeset, RESULT_U8BIT); - if not ('I' in value_largeset) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - write('var parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - proc_var_smallstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT); - if value_smallstring <> RESULT_SMALLSTRING then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_bigstring_mixed(RESULT_U8BIT, value_bigstring,RESULT_U8BIT); - if value_bigstring <> RESULT_BIGSTRING then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_openstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT); - if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - - write('Var parameter test (src : LOC_REFERENCE (formaldef)))...'); - clear_globals; - clear_values; - failed:=false; - - proc_var_formaldef_array_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - write('Var parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_var_smallarray_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - - - clear_globals; - clear_values; - - proc_var_smallarray_open_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - if value_u8bit <> RESULT_U8BIT 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 } +{ (var parameters with pascal calling convention) } +{****************************************************************} +program tcalvar3; +{$mode objfpc} +{$INLINE ON} +{$R+} +{$P-} +{$V+} + +{$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 +{$ifdef fpc} + pbytearr=^byte; +{$else} + pbytearr=^tbytearr; + tbytearr=array[0..$fffffff] of byte; +{$endif} + + tclass1 = class + end; + + 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_s64bit : int64; + global_s32real : single; + global_s64real : double; + global_ptr : pchar; + global_proc : tprocedure; + global_class : tclass1; + global_bigstring : shortstring; + global_boolean : boolean; + global_char : char; + value_u8bit : byte; + value_u16bit : word; + value_s32bit : longint; + value_s64bit : int64; + value_s32real : single; + value_s64real : double; + value_proc : tprocedure; + value_ptr : pchar; + value_class : tclass1; + 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_s64bit := 0; + global_s32real := 0.0; + global_s64real := 0.0; + global_ptr := nil; + global_proc := nil; + global_class := nil; + global_bigstring := ''; + global_boolean := false; + global_char := #0; + end; + + + procedure clear_values; + begin + value_u8bit := 0; + value_u16bit := 0; + value_s32bit := 0; + value_s64bit := 0; + value_s32real := 0.0; + value_s64real := 0.0; + value_proc := nil; + value_ptr := nil; + value_class := 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; + end; + + + procedure testprocedure; + begin + end; + + function getu8bit : byte; + begin + getu8bit:=RESULT_U8BIT; + end; + + function getu16bit: word; + begin + getu16bit:=RESULT_U16BIT; + end; + + function gets32bit: longint; + begin + gets32bit:=RESULT_S32BIT; + end; + + function gets64bit: int64; + begin + gets64bit:=RESULT_S64BIT; + end; + + + function gets32real: single; + begin + gets32real:=RESULT_S32REAL; + end; + + function gets64real: double; + begin + gets64real:=RESULT_S64REAL; + end; + + {************************************************************************} + { VAR PARAMETERS } + {************************************************************************} + procedure proc_var_s32bit(var v : longint);pascal; + begin + v:=RESULT_S32BIT; + end; + + procedure proc_var_s64bit(var v: int64);pascal; + begin + v:=RESULT_S64BIT; + end; + + + procedure proc_var_u8bit(var v: byte);pascal; + begin + v:=RESULT_U8BIT; + end; + + procedure proc_var_smallrecord(var smallrec : tsmallrecord);pascal; + begin + smallrec.b := RESULT_U8BIT; + smallrec.w := RESULT_U16BIT; + end; + + + procedure proc_var_largerecord(var largerec : tlargerecord);pascal; + begin + largerec.b[1] := RESULT_U8BIT; + largerec.b[2] := RESULT_U8BIT; + end; + + + procedure proc_var_smallset(var smallset : tsmallset);pascal; + begin + smallset := [A_A,A_D]; + end; + + + procedure proc_var_largeset(var largeset : tlargeset);pascal; + begin + largeset:= largeset + ['I']; + end; + + + procedure proc_var_smallstring(var s:tsmallstring);pascal; + begin + s:=RESULT_SMALLSTRING; + end; + + + procedure proc_var_bigstring(var s:shortstring);pascal; + begin + s:=RESULT_BIGSTRING; + end; + + + procedure proc_var_openstring(var s: OpenString);pascal; + begin + global_u8bit := high(s); + s:=RESULT_SMALLSTRING; + end; + + procedure proc_var_smallarray(var arr : tsmallarray);pascal; + begin + arr[SMALL_INDEX] := RESULT_U8BIT; + arr[1] := RESULT_U8BIT; + end; + + procedure proc_var_smallarray_open(var arr : array of byte);pascal; + begin + arr[high(arr)] := RESULT_U8BIT; + arr[low(arr)] := RESULT_U8BIT; + end; + + procedure proc_var_smallarray_const_1(var arr : array of const);pascal; + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : arr[i].vinteger := RESULT_U8BIT; + vtBoolean : arr[i].vboolean := RESULT_BOOLEAN; + else + RunError(255); + end; + end; {endfor} + end; + + + procedure proc_var_smallarray_const_2(var arr : array of const);pascal; + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_formaldef_array(var buf);pascal; + var + p: pbytearr; + begin + { array is indexed from 1 } + p := @buf; + p[SMALL_INDEX-1] := RESULT_U8BIT; + p[0] := RESULT_U8BIT; + end; + + +procedure proc_var_formaldef_string(var buf);pascal; + var + p: pbytearr; + begin + { array is indexed from 1 } + p := @buf; + p[SMALL_INDEX-1] := RESULT_U8BIT; + p[0] := RESULT_U8BIT; + end; + + + {************************************************************************} + { MIXED VAR PARAMETERS } + {************************************************************************} + procedure proc_var_s32bit_mixed(b1 : byte;var v : longint; b2: byte);pascal; + begin + v:=RESULT_S32BIT; + value_u8bit := RESULT_U8BIT; + end; + + procedure proc_var_s64bit_mixed(b1 : byte;var v: int64; b2: byte);pascal; + begin + v:=RESULT_S64BIT; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_u8bit_mixed(b1 : byte;var v: byte; b2: byte);pascal; + begin + v:=RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + + procedure proc_var_smallrecord_mixed(b1 : byte; var smallrec : tsmallrecord; b2: byte);pascal; + begin + smallrec.b := RESULT_U8BIT; + smallrec.w := RESULT_U16BIT; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_largerecord_mixed(b1 : byte; var largerec : tlargerecord; b2: byte);pascal; + begin + largerec.b[1] := RESULT_U8BIT; + largerec.b[2] := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_smallset_mixed(b1 : byte; var smallset : tsmallset; b2: byte);pascal; + begin + smallset := [A_A,A_D]; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_largeset_mixed(b1 : byte; var largeset : tlargeset; b2: byte);pascal; + begin + largeset:= largeset + ['I']; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_smallstring_mixed(b1 : byte; var s:tsmallstring; b2: byte);pascal; + begin + s:=RESULT_SMALLSTRING; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_bigstring_mixed(b1 : byte; var s:shortstring; b2: byte);pascal; + begin + s:=RESULT_BIGSTRING; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_openstring_mixed(b1 : byte; var s: OpenString; b2: byte);pascal; + begin + global_u8bit := high(s); + s:=RESULT_SMALLSTRING; + value_u8bit := RESULT_U8BIT; + end; + + procedure proc_var_smallarray_mixed(b1 : byte; var arr : tsmallarray; b2: byte);pascal; + begin + arr[SMALL_INDEX] := RESULT_U8BIT; + arr[1] := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + + procedure proc_var_smallarray_open_mixed(b1 : byte; var arr : array of byte; b2: byte);pascal; + begin + arr[high(arr)] := RESULT_U8BIT; + arr[low(arr)] := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + + procedure proc_var_smallarray_const_1_mixed(b1 : byte; var arr : array of const; b2: byte);pascal; + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : arr[i].vinteger := RESULT_U8BIT; + vtBoolean : arr[i].vboolean := RESULT_BOOLEAN; + else + RunError(255); + end; + end; {endfor} + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_smallarray_const_2_mixed(b1 : byte; var arr : array of const; b2: byte);pascal; + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; +end; + + + procedure proc_var_formaldef_array_mixed(b1 : byte; var buf; b2: byte);pascal; + var + p: pbytearr; + begin + { array is indexed from 1 } + p := @buf; + p[SMALL_INDEX-1] := RESULT_U8BIT; + p[0] := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + + +procedure proc_var_formaldef_string_mixed(b1 : byte; var buf; b2: byte);pascal; + var + p: pbytearr; + begin + { array is indexed from 1 } + p := @buf; + p[SMALL_INDEX-1] := RESULT_U8BIT; + p[0] := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + +var + failed: boolean; + pp : ^pchar; +begin + {***************************** NORMAL TESTS *******************************} + clear_globals; + clear_values; + failed:=false; + + write('Var parameter test (src : LOC_REFERENCE (orddef)))...'); + proc_var_s32bit(global_s32bit); + if global_s32bit <> RESULT_S32BIT then + failed:=true; + + clear_globals; + clear_values; + proc_var_s64bit(global_s64bit); + if global_s64bit <> RESULT_S64BIT then + failed:=true; + + clear_globals; + clear_values; + proc_var_u8bit(global_u8bit); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + + + if failed then + fail + else + WriteLn('Passed!'); + + write('Var parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + proc_var_smallrecord(value_smallrec); + if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then + failed := true; + + clear_globals; + clear_values; + proc_var_largerecord(value_largerec); + if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + write('var parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + proc_var_smallset(value_smallset); + if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then + failed := true; + + clear_globals; + clear_values; + proc_var_largeset(value_largeset); + if not ('I' in value_largeset) then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + write('var parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + proc_var_smallstring(value_smallstring); + if value_smallstring <> RESULT_SMALLSTRING then + failed := true; + + clear_globals; + clear_values; + proc_var_bigstring(value_bigstring); + if value_bigstring <> RESULT_BIGSTRING then + failed := true; + + clear_globals; + clear_values; + proc_var_openstring(value_smallstring); + if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + + write('Var parameter test (src : LOC_REFERENCE (formaldef)))...'); + clear_globals; + clear_values; + failed:=false; + + proc_var_formaldef_array(value_smallarray); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + write('Var parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_var_smallarray(value_smallarray); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + + + + clear_globals; + clear_values; + + proc_var_smallarray_open(value_smallarray); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + +(* HOW CAN ARRAY OF CONST VAR PARAMETERS BE TESTED? + clear_globals; + clear_values; + value_u8bit := RESULT_U8BIT; + value_ptr := RESULT_PCHAR; + value_s64bit := RESULT_S64BIT; + value_smallstring := RESULT_SMALLSTRING; + value_class := tclass1.create; + value_boolean := RESULT_BOOLEAN; + value_char := RESULT_CHAR; + value_s64real:=RESULT_S64REAL; + proc_var_smallarray_var_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,value_boolean,value_class]); + + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if global_char <> RESULT_CHAR then + failed := true; + if global_boolean <> RESULT_BOOLEAN then + failed:=true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed := true; + if global_bigstring <> RESULT_SMALLSTRING then + failed := true; + if global_ptr <> value_ptr then + failed := true; +{ if value_class <> global_class then + failed := true;!!!!!!!!!!!!!!!!!!!!} + if global_s64bit <> RESULT_S64BIT then + failed := true; + if assigned(value_class) then + value_class.destroy; + global_u8bit := 0; + proc_var_smallarray_const_2([]); + if global_u8bit <> RESULT_U8BIT then + failed := true; +*) + + + if failed then + fail + else + WriteLn('Passed!'); + + {***************************** MIXED TESTS *******************************} + clear_globals; + clear_values; + failed:=false; + + write('Var parameter test (src : LOC_REFERENCE (orddef)))...'); + proc_var_s32bit_mixed(RESULT_U8BIT, global_s32bit, RESULT_U8BIT); + if global_s32bit <> RESULT_S32BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_s64bit_mixed(RESULT_U8BIT, global_s64bit, RESULT_U8BIT); + if global_s64bit <> RESULT_S64BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_u8bit_mixed(RESULT_U8BIT, global_u8bit, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + write('Var parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + proc_var_smallrecord_mixed(RESULT_U8BIT,value_smallrec, RESULT_U8BIT); + if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_largerecord_mixed(RESULT_U8BIT, value_largerec, RESULT_U8BIT); + if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + write('var parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + proc_var_smallset_mixed(RESULT_U8BIT, value_smallset, RESULT_U8BIT); + if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_largeset_mixed(RESULT_U8BIT, value_largeset, RESULT_U8BIT); + if not ('I' in value_largeset) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + write('var parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + proc_var_smallstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT); + if value_smallstring <> RESULT_SMALLSTRING then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_bigstring_mixed(RESULT_U8BIT, value_bigstring,RESULT_U8BIT); + if value_bigstring <> RESULT_BIGSTRING then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_openstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT); + if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + + write('Var parameter test (src : LOC_REFERENCE (formaldef)))...'); + clear_globals; + clear_values; + failed:=false; + + proc_var_formaldef_array_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + write('Var parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_var_smallarray_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + + + clear_globals; + clear_values; + + proc_var_smallarray_open_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + +end. + + +{ $Log$ - Revision 1.4 2002-09-22 09:08:41 carl - * gets64bit was not returning an int64! - - Revision 1.3 2002/09/07 15:40:55 peter - * old logs removed and tabs fixed - - Revision 1.2 2002/05/13 13:45:38 peter - * updated to compile tests with kylix - - Revision 1.1 2002/04/13 17:51:00 carl - + var parameter passing for different calling conventions - - -} + Revision 1.5 2003-04-22 10:24:29 florian + * fixed defines for powerpc + + Revision 1.4 2002/09/22 09:08:41 carl + * gets64bit was not returning an int64! + + Revision 1.3 2002/09/07 15:40:55 peter + * old logs removed and tabs fixed + + Revision 1.2 2002/05/13 13:45:38 peter + * updated to compile tests with kylix + + Revision 1.1 2002/04/13 17:51:00 carl + + var parameter passing for different calling conventions + + +} diff --git a/tests/test/cg/tcalvar4.pp b/tests/test/cg/tcalvar4.pp index cf752cbfd7..0767c0b80c 100644 --- a/tests/test/cg/tcalvar4.pp +++ b/tests/test/cg/tcalvar4.pp @@ -1,744 +1,746 @@ -{****************************************************************} -{ 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 } -{ (var parameters with cdecl calling convention) } -{****************************************************************} -program tcalvar4; -{$ifdef fpc} - {$mode objfpc} - {$INLINE ON} -{$endif} -{$R+} -{$P-} -{$V+} - -{$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; - {$endif} - {$ifdef cpui386} - 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 -{$ifdef fpc} - pbytearr=^byte; -{$else} - pbytearr=^tbytearr; - tbytearr=array[0..$fffffff] of byte; -{$endif} - - tclass1 = class - end; - - 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_s64bit : int64; - global_s32real : single; - global_s64real : double; - global_ptr : pchar; - global_proc : tprocedure; - global_class : tclass1; - global_bigstring : shortstring; - global_boolean : boolean; - global_char : char; - value_u8bit : byte; - value_u16bit : word; - value_s32bit : longint; - value_s64bit : int64; - value_s32real : single; - value_s64real : double; - value_proc : tprocedure; - value_ptr : pchar; - value_class : tclass1; - 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_s64bit := 0; - global_s32real := 0.0; - global_s64real := 0.0; - global_ptr := nil; - global_proc := nil; - global_class := nil; - global_bigstring := ''; - global_boolean := false; - global_char := #0; - end; - - - procedure clear_values; - begin - value_u8bit := 0; - value_u16bit := 0; - value_s32bit := 0; - value_s64bit := 0; - value_s32real := 0.0; - value_s64real := 0.0; - value_proc := nil; - value_ptr := nil; - value_class := 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; - end; - - - procedure testprocedure; - begin - end; - - function getu8bit : byte; - begin - getu8bit:=RESULT_U8BIT; - end; - - function getu16bit: word; - begin - getu16bit:=RESULT_U16BIT; - end; - - function gets32bit: longint; - begin - gets32bit:=RESULT_S32BIT; - end; - - function gets64bit: int64; - begin - gets64bit:=RESULT_S64BIT; - end; - - - function gets32real: single; - begin - gets32real:=RESULT_S32REAL; - end; - - function gets64real: double; - begin - gets64real:=RESULT_S64REAL; - end; - - {************************************************************************} - { VAR PARAMETERS } - {************************************************************************} - procedure proc_var_s32bit(var v : longint);cdecl; - begin - v:=RESULT_S32BIT; - end; - - procedure proc_var_s64bit(var v: int64);cdecl; - begin - v:=RESULT_S64BIT; - end; - - - procedure proc_var_u8bit(var v: byte);cdecl; - begin - v:=RESULT_U8BIT; - end; - - procedure proc_var_smallrecord(var smallrec : tsmallrecord);cdecl; - begin - smallrec.b := RESULT_U8BIT; - smallrec.w := RESULT_U16BIT; - end; - - - procedure proc_var_largerecord(var largerec : tlargerecord);cdecl; - begin - largerec.b[1] := RESULT_U8BIT; - largerec.b[2] := RESULT_U8BIT; - end; - - - procedure proc_var_smallset(var smallset : tsmallset);cdecl; - begin - smallset := [A_A,A_D]; - end; - - - procedure proc_var_largeset(var largeset : tlargeset);cdecl; - begin - largeset:= largeset + ['I']; - end; - - - procedure proc_var_smallstring(var s:tsmallstring);cdecl; - begin - s:=RESULT_SMALLSTRING; - end; - - - procedure proc_var_bigstring(var s:shortstring);cdecl; - begin - s:=RESULT_BIGSTRING; - end; - - - procedure proc_var_openstring(var s: OpenString);cdecl; - begin - global_u8bit := {high(s) is not available with cdecl}255; - s:=RESULT_SMALLSTRING; - end; - - procedure proc_var_smallarray(var arr : tsmallarray);cdecl; - begin - arr[SMALL_INDEX] := RESULT_U8BIT; - arr[1] := RESULT_U8BIT; - end; - - - - - procedure proc_var_formaldef_array(var buf);cdecl; - var - p: pbytearr; - begin - { array is indexed from 1 } - p := @buf; - p[SMALL_INDEX-1] := RESULT_U8BIT; - p[0] := RESULT_U8BIT; - end; - - -procedure proc_var_formaldef_string(var buf);cdecl; - var - p: pbytearr; - begin - { array is indexed from 1 } - p := @buf; - p[SMALL_INDEX-1] := RESULT_U8BIT; - p[0] := RESULT_U8BIT; - end; - - - {************************************************************************} - { MIXED VAR PARAMETERS } - {************************************************************************} - procedure proc_var_s32bit_mixed(b1 : byte;var v : longint; b2: byte);cdecl; - begin - v:=RESULT_S32BIT; - value_u8bit := RESULT_U8BIT; - end; - - procedure proc_var_s64bit_mixed(b1 : byte;var v: int64; b2: byte);cdecl; - begin - v:=RESULT_S64BIT; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_u8bit_mixed(b1 : byte;var v: byte; b2: byte);cdecl; - begin - v:=RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - - procedure proc_var_smallrecord_mixed(b1 : byte; var smallrec : tsmallrecord; b2: byte);cdecl; - begin - smallrec.b := RESULT_U8BIT; - smallrec.w := RESULT_U16BIT; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_largerecord_mixed(b1 : byte; var largerec : tlargerecord; b2: byte);cdecl; - begin - largerec.b[1] := RESULT_U8BIT; - largerec.b[2] := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_smallset_mixed(b1 : byte; var smallset : tsmallset; b2: byte);cdecl; - begin - smallset := [A_A,A_D]; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_largeset_mixed(b1 : byte; var largeset : tlargeset; b2: byte);cdecl; - begin - largeset:= largeset + ['I']; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_smallstring_mixed(b1 : byte; var s:tsmallstring; b2: byte);cdecl; - begin - s:=RESULT_SMALLSTRING; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_bigstring_mixed(b1 : byte; var s:shortstring; b2: byte);cdecl; - begin - s:=RESULT_BIGSTRING; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_openstring_mixed(b1 : byte; var s: OpenString; b2: byte);cdecl; - begin - global_u8bit := {high(s) is not available with cdecl}255; - s:=RESULT_SMALLSTRING; - value_u8bit := RESULT_U8BIT; - end; - - procedure proc_var_smallarray_mixed(b1 : byte; var arr : tsmallarray; b2: byte);cdecl; - begin - arr[SMALL_INDEX] := RESULT_U8BIT; - arr[1] := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - - - - procedure proc_var_formaldef_array_mixed(b1 : byte; var buf; b2: byte);cdecl; - var - p: pbytearr; - begin - { array is indexed from 1 } - p := @buf; - p[SMALL_INDEX-1] := RESULT_U8BIT; - p[0] := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - - -procedure proc_var_formaldef_string_mixed(b1 : byte; var buf; b2: byte);cdecl; - var - p: pbytearr; - begin - { array is indexed from 1 } - p := @buf; - p[SMALL_INDEX-1] := RESULT_U8BIT; - p[0] := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - -var - failed: boolean; - pp : ^pchar; -begin - {***************************** NORMAL TESTS *******************************} - clear_globals; - clear_values; - failed:=false; - - write('Var parameter test (src : LOC_REFERENCE (orddef)))...'); - proc_var_s32bit(global_s32bit); - if global_s32bit <> RESULT_S32BIT then - failed:=true; - - clear_globals; - clear_values; - proc_var_s64bit(global_s64bit); - if global_s64bit <> RESULT_S64BIT then - failed:=true; - - clear_globals; - clear_values; - proc_var_u8bit(global_u8bit); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - - - if failed then - fail - else - WriteLn('Passed!'); - - write('Var parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - proc_var_smallrecord(value_smallrec); - if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then - failed := true; - - clear_globals; - clear_values; - proc_var_largerecord(value_largerec); - if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - write('var parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - proc_var_smallset(value_smallset); - if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then - failed := true; - - clear_globals; - clear_values; - proc_var_largeset(value_largeset); - if not ('I' in value_largeset) then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - write('var parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - proc_var_smallstring(value_smallstring); - if value_smallstring <> RESULT_SMALLSTRING then - failed := true; - - clear_globals; - clear_values; - proc_var_bigstring(value_bigstring); - if value_bigstring <> RESULT_BIGSTRING then - failed := true; - - clear_globals; - clear_values; - proc_var_openstring(value_smallstring); - if (value_smallstring <> RESULT_SMALLSTRING) or - { high is not passed to cdecl'ared functions thus - value_smallstring should be 255 on retyurn PM } - (global_u8bit <> {high(value_smallstring)}255) then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - - write('Var parameter test (src : LOC_REFERENCE (formaldef)))...'); - clear_globals; - clear_values; - failed:=false; - - proc_var_formaldef_array(value_smallarray); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - write('Var parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_var_smallarray(value_smallarray); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - - - - if failed then - fail - else - WriteLn('Passed!'); - - {***************************** MIXED TESTS *******************************} - clear_globals; - clear_values; - failed:=false; - - write('Var parameter test (src : LOC_REFERENCE (orddef)))...'); - proc_var_s32bit_mixed(RESULT_U8BIT, global_s32bit, RESULT_U8BIT); - if global_s32bit <> RESULT_S32BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_s64bit_mixed(RESULT_U8BIT, global_s64bit, RESULT_U8BIT); - if global_s64bit <> RESULT_S64BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_u8bit_mixed(RESULT_U8BIT, global_u8bit, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - write('Var parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - proc_var_smallrecord_mixed(RESULT_U8BIT,value_smallrec, RESULT_U8BIT); - if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_largerecord_mixed(RESULT_U8BIT, value_largerec, RESULT_U8BIT); - if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - write('var parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - proc_var_smallset_mixed(RESULT_U8BIT, value_smallset, RESULT_U8BIT); - if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_largeset_mixed(RESULT_U8BIT, value_largeset, RESULT_U8BIT); - if not ('I' in value_largeset) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - write('var parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - proc_var_smallstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT); - if value_smallstring <> RESULT_SMALLSTRING then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_bigstring_mixed(RESULT_U8BIT, value_bigstring,RESULT_U8BIT); - if value_bigstring <> RESULT_BIGSTRING then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_openstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT); - if (value_smallstring <> RESULT_SMALLSTRING) or - { high is not passed to cdecl'ared functions thus - value_smallstring should be 255 on retyurn PM } - (global_u8bit <> {high(value_smallstring)}255) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - - write('Var parameter test (src : LOC_REFERENCE (formaldef)))...'); - clear_globals; - clear_values; - failed:=false; - - proc_var_formaldef_array_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - write('Var parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_var_smallarray_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - if value_u8bit <> RESULT_U8BIT 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 } +{ (var parameters with cdecl calling convention) } +{****************************************************************} +program tcalvar4; +{$ifdef fpc} + {$mode objfpc} + {$INLINE ON} +{$endif} +{$R+} +{$P-} +{$V+} + +{$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 +{$ifdef fpc} + pbytearr=^byte; +{$else} + pbytearr=^tbytearr; + tbytearr=array[0..$fffffff] of byte; +{$endif} + + tclass1 = class + end; + + 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_s64bit : int64; + global_s32real : single; + global_s64real : double; + global_ptr : pchar; + global_proc : tprocedure; + global_class : tclass1; + global_bigstring : shortstring; + global_boolean : boolean; + global_char : char; + value_u8bit : byte; + value_u16bit : word; + value_s32bit : longint; + value_s64bit : int64; + value_s32real : single; + value_s64real : double; + value_proc : tprocedure; + value_ptr : pchar; + value_class : tclass1; + 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_s64bit := 0; + global_s32real := 0.0; + global_s64real := 0.0; + global_ptr := nil; + global_proc := nil; + global_class := nil; + global_bigstring := ''; + global_boolean := false; + global_char := #0; + end; + + + procedure clear_values; + begin + value_u8bit := 0; + value_u16bit := 0; + value_s32bit := 0; + value_s64bit := 0; + value_s32real := 0.0; + value_s64real := 0.0; + value_proc := nil; + value_ptr := nil; + value_class := 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; + end; + + + procedure testprocedure; + begin + end; + + function getu8bit : byte; + begin + getu8bit:=RESULT_U8BIT; + end; + + function getu16bit: word; + begin + getu16bit:=RESULT_U16BIT; + end; + + function gets32bit: longint; + begin + gets32bit:=RESULT_S32BIT; + end; + + function gets64bit: int64; + begin + gets64bit:=RESULT_S64BIT; + end; + + + function gets32real: single; + begin + gets32real:=RESULT_S32REAL; + end; + + function gets64real: double; + begin + gets64real:=RESULT_S64REAL; + end; + + {************************************************************************} + { VAR PARAMETERS } + {************************************************************************} + procedure proc_var_s32bit(var v : longint);cdecl; + begin + v:=RESULT_S32BIT; + end; + + procedure proc_var_s64bit(var v: int64);cdecl; + begin + v:=RESULT_S64BIT; + end; + + + procedure proc_var_u8bit(var v: byte);cdecl; + begin + v:=RESULT_U8BIT; + end; + + procedure proc_var_smallrecord(var smallrec : tsmallrecord);cdecl; + begin + smallrec.b := RESULT_U8BIT; + smallrec.w := RESULT_U16BIT; + end; + + + procedure proc_var_largerecord(var largerec : tlargerecord);cdecl; + begin + largerec.b[1] := RESULT_U8BIT; + largerec.b[2] := RESULT_U8BIT; + end; + + + procedure proc_var_smallset(var smallset : tsmallset);cdecl; + begin + smallset := [A_A,A_D]; + end; + + + procedure proc_var_largeset(var largeset : tlargeset);cdecl; + begin + largeset:= largeset + ['I']; + end; + + + procedure proc_var_smallstring(var s:tsmallstring);cdecl; + begin + s:=RESULT_SMALLSTRING; + end; + + + procedure proc_var_bigstring(var s:shortstring);cdecl; + begin + s:=RESULT_BIGSTRING; + end; + + + procedure proc_var_openstring(var s: OpenString);cdecl; + begin + global_u8bit := {high(s) is not available with cdecl}255; + s:=RESULT_SMALLSTRING; + end; + + procedure proc_var_smallarray(var arr : tsmallarray);cdecl; + begin + arr[SMALL_INDEX] := RESULT_U8BIT; + arr[1] := RESULT_U8BIT; + end; + + + + + procedure proc_var_formaldef_array(var buf);cdecl; + var + p: pbytearr; + begin + { array is indexed from 1 } + p := @buf; + p[SMALL_INDEX-1] := RESULT_U8BIT; + p[0] := RESULT_U8BIT; + end; + + +procedure proc_var_formaldef_string(var buf);cdecl; + var + p: pbytearr; + begin + { array is indexed from 1 } + p := @buf; + p[SMALL_INDEX-1] := RESULT_U8BIT; + p[0] := RESULT_U8BIT; + end; + + + {************************************************************************} + { MIXED VAR PARAMETERS } + {************************************************************************} + procedure proc_var_s32bit_mixed(b1 : byte;var v : longint; b2: byte);cdecl; + begin + v:=RESULT_S32BIT; + value_u8bit := RESULT_U8BIT; + end; + + procedure proc_var_s64bit_mixed(b1 : byte;var v: int64; b2: byte);cdecl; + begin + v:=RESULT_S64BIT; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_u8bit_mixed(b1 : byte;var v: byte; b2: byte);cdecl; + begin + v:=RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + + procedure proc_var_smallrecord_mixed(b1 : byte; var smallrec : tsmallrecord; b2: byte);cdecl; + begin + smallrec.b := RESULT_U8BIT; + smallrec.w := RESULT_U16BIT; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_largerecord_mixed(b1 : byte; var largerec : tlargerecord; b2: byte);cdecl; + begin + largerec.b[1] := RESULT_U8BIT; + largerec.b[2] := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_smallset_mixed(b1 : byte; var smallset : tsmallset; b2: byte);cdecl; + begin + smallset := [A_A,A_D]; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_largeset_mixed(b1 : byte; var largeset : tlargeset; b2: byte);cdecl; + begin + largeset:= largeset + ['I']; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_smallstring_mixed(b1 : byte; var s:tsmallstring; b2: byte);cdecl; + begin + s:=RESULT_SMALLSTRING; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_bigstring_mixed(b1 : byte; var s:shortstring; b2: byte);cdecl; + begin + s:=RESULT_BIGSTRING; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_openstring_mixed(b1 : byte; var s: OpenString; b2: byte);cdecl; + begin + global_u8bit := {high(s) is not available with cdecl}255; + s:=RESULT_SMALLSTRING; + value_u8bit := RESULT_U8BIT; + end; + + procedure proc_var_smallarray_mixed(b1 : byte; var arr : tsmallarray; b2: byte);cdecl; + begin + arr[SMALL_INDEX] := RESULT_U8BIT; + arr[1] := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + + + + procedure proc_var_formaldef_array_mixed(b1 : byte; var buf; b2: byte);cdecl; + var + p: pbytearr; + begin + { array is indexed from 1 } + p := @buf; + p[SMALL_INDEX-1] := RESULT_U8BIT; + p[0] := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + + +procedure proc_var_formaldef_string_mixed(b1 : byte; var buf; b2: byte);cdecl; + var + p: pbytearr; + begin + { array is indexed from 1 } + p := @buf; + p[SMALL_INDEX-1] := RESULT_U8BIT; + p[0] := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + +var + failed: boolean; + pp : ^pchar; +begin + {***************************** NORMAL TESTS *******************************} + clear_globals; + clear_values; + failed:=false; + + write('Var parameter test (src : LOC_REFERENCE (orddef)))...'); + proc_var_s32bit(global_s32bit); + if global_s32bit <> RESULT_S32BIT then + failed:=true; + + clear_globals; + clear_values; + proc_var_s64bit(global_s64bit); + if global_s64bit <> RESULT_S64BIT then + failed:=true; + + clear_globals; + clear_values; + proc_var_u8bit(global_u8bit); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + + + if failed then + fail + else + WriteLn('Passed!'); + + write('Var parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + proc_var_smallrecord(value_smallrec); + if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then + failed := true; + + clear_globals; + clear_values; + proc_var_largerecord(value_largerec); + if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + write('var parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + proc_var_smallset(value_smallset); + if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then + failed := true; + + clear_globals; + clear_values; + proc_var_largeset(value_largeset); + if not ('I' in value_largeset) then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + write('var parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + proc_var_smallstring(value_smallstring); + if value_smallstring <> RESULT_SMALLSTRING then + failed := true; + + clear_globals; + clear_values; + proc_var_bigstring(value_bigstring); + if value_bigstring <> RESULT_BIGSTRING then + failed := true; + + clear_globals; + clear_values; + proc_var_openstring(value_smallstring); + if (value_smallstring <> RESULT_SMALLSTRING) or + { high is not passed to cdecl'ared functions thus + value_smallstring should be 255 on retyurn PM } + (global_u8bit <> {high(value_smallstring)}255) then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + + write('Var parameter test (src : LOC_REFERENCE (formaldef)))...'); + clear_globals; + clear_values; + failed:=false; + + proc_var_formaldef_array(value_smallarray); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + write('Var parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_var_smallarray(value_smallarray); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + + + + if failed then + fail + else + WriteLn('Passed!'); + + {***************************** MIXED TESTS *******************************} + clear_globals; + clear_values; + failed:=false; + + write('Var parameter test (src : LOC_REFERENCE (orddef)))...'); + proc_var_s32bit_mixed(RESULT_U8BIT, global_s32bit, RESULT_U8BIT); + if global_s32bit <> RESULT_S32BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_s64bit_mixed(RESULT_U8BIT, global_s64bit, RESULT_U8BIT); + if global_s64bit <> RESULT_S64BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_u8bit_mixed(RESULT_U8BIT, global_u8bit, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + write('Var parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + proc_var_smallrecord_mixed(RESULT_U8BIT,value_smallrec, RESULT_U8BIT); + if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_largerecord_mixed(RESULT_U8BIT, value_largerec, RESULT_U8BIT); + if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + write('var parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + proc_var_smallset_mixed(RESULT_U8BIT, value_smallset, RESULT_U8BIT); + if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_largeset_mixed(RESULT_U8BIT, value_largeset, RESULT_U8BIT); + if not ('I' in value_largeset) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + write('var parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + proc_var_smallstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT); + if value_smallstring <> RESULT_SMALLSTRING then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_bigstring_mixed(RESULT_U8BIT, value_bigstring,RESULT_U8BIT); + if value_bigstring <> RESULT_BIGSTRING then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_openstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT); + if (value_smallstring <> RESULT_SMALLSTRING) or + { high is not passed to cdecl'ared functions thus + value_smallstring should be 255 on retyurn PM } + (global_u8bit <> {high(value_smallstring)}255) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + + write('Var parameter test (src : LOC_REFERENCE (formaldef)))...'); + clear_globals; + clear_values; + failed:=false; + + proc_var_formaldef_array_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + write('Var parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_var_smallarray_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + + + if failed then + fail + else + WriteLn('Passed!'); + +end. + + +{ $Log$ - 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/12/05 15:54:20 pierre - * update as openstrings are transformed into normal string in cdecl'ared functions - - Revision 1.6 2002/11/20 19:39:21 carl - - high() cannot be used in cdecle'd routines - - Revision 1.5 2002/11/09 21:47:37 carl - + updated tests for correct parsing (array of const now allowed with high!) - - Revision 1.4 2002/09/22 09:08:41 carl - * gets64bit was not returning an int64! - - Revision 1.3 2002/09/07 15:40:55 peter - * old logs removed and tabs fixed - - Revision 1.2 2002/05/13 13:45:38 peter - * updated to compile tests with kylix - - Revision 1.1 2002/04/13 17:51:00 carl - + var parameter passing for different calling conventions - - -} + 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/12/05 15:54:20 pierre + * update as openstrings are transformed into normal string in cdecl'ared functions + + Revision 1.6 2002/11/20 19:39:21 carl + - high() cannot be used in cdecle'd routines + + Revision 1.5 2002/11/09 21:47:37 carl + + updated tests for correct parsing (array of const now allowed with high!) + + Revision 1.4 2002/09/22 09:08:41 carl + * gets64bit was not returning an int64! + + Revision 1.3 2002/09/07 15:40:55 peter + * old logs removed and tabs fixed + + Revision 1.2 2002/05/13 13:45:38 peter + * updated to compile tests with kylix + + Revision 1.1 2002/04/13 17:51:00 carl + + var parameter passing for different calling conventions + + +} diff --git a/tests/test/cg/tcalvar5.pp b/tests/test/cg/tcalvar5.pp index 7f9a52d3ab..39703c999d 100644 --- a/tests/test/cg/tcalvar5.pp +++ b/tests/test/cg/tcalvar5.pp @@ -1,840 +1,842 @@ -{****************************************************************} -{ 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 } -{ (var parameters with popstack calling convention) } -{****************************************************************} -program tcalvar5; -{$ifdef fpc} - {$mode objfpc} - {$INLINE ON} -{$endif} -{$R+} -{$P-} -{$V+} - -{$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; - {$endif} - {$ifdef cpui386} - 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 -{$ifdef fpc} - pbytearr=^byte; -{$else} - pbytearr=^tbytearr; - tbytearr=array[0..$fffffff] of byte; -{$endif} - - tclass1 = class - end; - - 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_s64bit : int64; - global_s32real : single; - global_s64real : double; - global_ptr : pchar; - global_proc : tprocedure; - global_class : tclass1; - global_bigstring : shortstring; - global_boolean : boolean; - global_char : char; - value_u8bit : byte; - value_u16bit : word; - value_s32bit : longint; - value_s64bit : int64; - value_s32real : single; - value_s64real : double; - value_proc : tprocedure; - value_ptr : pchar; - value_class : tclass1; - 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_s64bit := 0; - global_s32real := 0.0; - global_s64real := 0.0; - global_ptr := nil; - global_proc := nil; - global_class := nil; - global_bigstring := ''; - global_boolean := false; - global_char := #0; - end; - - - procedure clear_values; - begin - value_u8bit := 0; - value_u16bit := 0; - value_s32bit := 0; - value_s64bit := 0; - value_s32real := 0.0; - value_s64real := 0.0; - value_proc := nil; - value_ptr := nil; - value_class := 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; - end; - - - procedure testprocedure; - begin - end; - - function getu8bit : byte; - begin - getu8bit:=RESULT_U8BIT; - end; - - function getu16bit: word; - begin - getu16bit:=RESULT_U16BIT; - end; - - function gets32bit: longint; - begin - gets32bit:=RESULT_S32BIT; - end; - - function gets64bit: int64; - begin - gets64bit:=RESULT_S64BIT; - end; - - - function gets32real: single; - begin - gets32real:=RESULT_S32REAL; - end; - - function gets64real: double; - begin - gets64real:=RESULT_S64REAL; - end; - - {************************************************************************} - { VAR PARAMETERS } - {************************************************************************} - procedure proc_var_s32bit(var v : longint);popstack; - begin - v:=RESULT_S32BIT; - end; - - procedure proc_var_s64bit(var v: int64);popstack; - begin - v:=RESULT_S64BIT; - end; - - - procedure proc_var_u8bit(var v: byte);popstack; - begin - v:=RESULT_U8BIT; - end; - - procedure proc_var_smallrecord(var smallrec : tsmallrecord);popstack; - begin - smallrec.b := RESULT_U8BIT; - smallrec.w := RESULT_U16BIT; - end; - - - procedure proc_var_largerecord(var largerec : tlargerecord);popstack; - begin - largerec.b[1] := RESULT_U8BIT; - largerec.b[2] := RESULT_U8BIT; - end; - - - procedure proc_var_smallset(var smallset : tsmallset);popstack; - begin - smallset := [A_A,A_D]; - end; - - - procedure proc_var_largeset(var largeset : tlargeset);popstack; - begin - largeset:= largeset + ['I']; - end; - - - procedure proc_var_smallstring(var s:tsmallstring);popstack; - begin - s:=RESULT_SMALLSTRING; - end; - - - procedure proc_var_bigstring(var s:shortstring);popstack; - begin - s:=RESULT_BIGSTRING; - end; - - - procedure proc_var_openstring(var s: OpenString);popstack; - begin - global_u8bit := high(s); - s:=RESULT_SMALLSTRING; - end; - - procedure proc_var_smallarray(var arr : tsmallarray);popstack; - begin - arr[SMALL_INDEX] := RESULT_U8BIT; - arr[1] := RESULT_U8BIT; - end; - - procedure proc_var_smallarray_open(var arr : array of byte);popstack; - begin - arr[high(arr)] := RESULT_U8BIT; - arr[low(arr)] := RESULT_U8BIT; - end; - - procedure proc_var_smallarray_const_1(var arr : array of const);popstack; - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : arr[i].vinteger := RESULT_U8BIT; - vtBoolean : arr[i].vboolean := RESULT_BOOLEAN; - else - RunError(255); - end; - end; {endfor} - end; - - - procedure proc_var_smallarray_const_2(var arr : array of const);popstack; - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_formaldef_array(var buf);popstack; - var - p: pbytearr; - begin - { array is indexed from 1 } - p := @buf; - p[SMALL_INDEX-1] := RESULT_U8BIT; - p[0] := RESULT_U8BIT; - end; - - -procedure proc_var_formaldef_string(var buf);popstack; - var - p: pbytearr; - begin - { array is indexed from 1 } - p := @buf; - p[SMALL_INDEX-1] := RESULT_U8BIT; - p[0] := RESULT_U8BIT; - end; - - - {************************************************************************} - { MIXED VAR PARAMETERS } - {************************************************************************} - procedure proc_var_s32bit_mixed(b1 : byte;var v : longint; b2: byte);popstack; - begin - v:=RESULT_S32BIT; - value_u8bit := RESULT_U8BIT; - end; - - procedure proc_var_s64bit_mixed(b1 : byte;var v: int64; b2: byte);popstack; - begin - v:=RESULT_S64BIT; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_u8bit_mixed(b1 : byte;var v: byte; b2: byte);popstack; - begin - v:=RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - - procedure proc_var_smallrecord_mixed(b1 : byte; var smallrec : tsmallrecord; b2: byte);popstack; - begin - smallrec.b := RESULT_U8BIT; - smallrec.w := RESULT_U16BIT; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_largerecord_mixed(b1 : byte; var largerec : tlargerecord; b2: byte);popstack; - begin - largerec.b[1] := RESULT_U8BIT; - largerec.b[2] := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_smallset_mixed(b1 : byte; var smallset : tsmallset; b2: byte);popstack; - begin - smallset := [A_A,A_D]; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_largeset_mixed(b1 : byte; var largeset : tlargeset; b2: byte);popstack; - begin - largeset:= largeset + ['I']; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_smallstring_mixed(b1 : byte; var s:tsmallstring; b2: byte);popstack; - begin - s:=RESULT_SMALLSTRING; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_bigstring_mixed(b1 : byte; var s:shortstring; b2: byte);popstack; - begin - s:=RESULT_BIGSTRING; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_openstring_mixed(b1 : byte; var s: OpenString; b2: byte);popstack; - begin - global_u8bit := high(s); - s:=RESULT_SMALLSTRING; - value_u8bit := RESULT_U8BIT; - end; - - procedure proc_var_smallarray_mixed(b1 : byte; var arr : tsmallarray; b2: byte);popstack; - begin - arr[SMALL_INDEX] := RESULT_U8BIT; - arr[1] := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - - procedure proc_var_smallarray_open_mixed(b1 : byte; var arr : array of byte; b2: byte);popstack; - begin - arr[high(arr)] := RESULT_U8BIT; - arr[low(arr)] := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - - procedure proc_var_smallarray_const_1_mixed(b1 : byte; var arr : array of const; b2: byte);popstack; - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : arr[i].vinteger := RESULT_U8BIT; - vtBoolean : arr[i].vboolean := RESULT_BOOLEAN; - else - RunError(255); - end; - end; {endfor} - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_smallarray_const_2_mixed(b1 : byte; var arr : array of const; b2: byte);popstack; - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; -end; - - - procedure proc_var_formaldef_array_mixed(b1 : byte; var buf; b2: byte);popstack; - var - p: pbytearr; - begin - { array is indexed from 1 } - p := @buf; - p[SMALL_INDEX-1] := RESULT_U8BIT; - p[0] := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - - -procedure proc_var_formaldef_string_mixed(b1 : byte; var buf; b2: byte);popstack; - var - p: pbytearr; - begin - { array is indexed from 1 } - p := @buf; - p[SMALL_INDEX-1] := RESULT_U8BIT; - p[0] := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - -var - failed: boolean; - pp : ^pchar; -begin - {***************************** NORMAL TESTS *******************************} - clear_globals; - clear_values; - failed:=false; - - write('Var parameter test (src : LOC_REFERENCE (orddef)))...'); - proc_var_s32bit(global_s32bit); - if global_s32bit <> RESULT_S32BIT then - failed:=true; - - clear_globals; - clear_values; - proc_var_s64bit(global_s64bit); - if global_s64bit <> RESULT_S64BIT then - failed:=true; - - clear_globals; - clear_values; - proc_var_u8bit(global_u8bit); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - - - if failed then - fail - else - WriteLn('Passed!'); - - write('Var parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - proc_var_smallrecord(value_smallrec); - if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then - failed := true; - - clear_globals; - clear_values; - proc_var_largerecord(value_largerec); - if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - write('var parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - proc_var_smallset(value_smallset); - if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then - failed := true; - - clear_globals; - clear_values; - proc_var_largeset(value_largeset); - if not ('I' in value_largeset) then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - write('var parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - proc_var_smallstring(value_smallstring); - if value_smallstring <> RESULT_SMALLSTRING then - failed := true; - - clear_globals; - clear_values; - proc_var_bigstring(value_bigstring); - if value_bigstring <> RESULT_BIGSTRING then - failed := true; - - clear_globals; - clear_values; - proc_var_openstring(value_smallstring); - if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - - write('Var parameter test (src : LOC_REFERENCE (formaldef)))...'); - clear_globals; - clear_values; - failed:=false; - - proc_var_formaldef_array(value_smallarray); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - write('Var parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_var_smallarray(value_smallarray); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - - - - clear_globals; - clear_values; - - proc_var_smallarray_open(value_smallarray); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - -(* HOW CAN ARRAY OF CONST VAR PARAMETERS BE TESTED? - clear_globals; - clear_values; - value_u8bit := RESULT_U8BIT; - value_ptr := RESULT_PCHAR; - value_s64bit := RESULT_S64BIT; - value_smallstring := RESULT_SMALLSTRING; - value_class := tclass1.create; - value_boolean := RESULT_BOOLEAN; - value_char := RESULT_CHAR; - value_s64real:=RESULT_S64REAL; - proc_var_smallarray_var_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,value_boolean,value_class]); - - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if global_char <> RESULT_CHAR then - failed := true; - if global_boolean <> RESULT_BOOLEAN then - failed:=true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed := true; - if global_bigstring <> RESULT_SMALLSTRING then - failed := true; - if global_ptr <> value_ptr then - failed := true; -{ if value_class <> global_class then - failed := true;!!!!!!!!!!!!!!!!!!!!} - if global_s64bit <> RESULT_S64BIT then - failed := true; - if assigned(value_class) then - value_class.destroy; - global_u8bit := 0; - proc_var_smallarray_const_2([]); - if global_u8bit <> RESULT_U8BIT then - failed := true; -*) - - - if failed then - fail - else - WriteLn('Passed!'); - - {***************************** MIXED TESTS *******************************} - clear_globals; - clear_values; - failed:=false; - - write('Var parameter test (src : LOC_REFERENCE (orddef)))...'); - proc_var_s32bit_mixed(RESULT_U8BIT, global_s32bit, RESULT_U8BIT); - if global_s32bit <> RESULT_S32BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_s64bit_mixed(RESULT_U8BIT, global_s64bit, RESULT_U8BIT); - if global_s64bit <> RESULT_S64BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_u8bit_mixed(RESULT_U8BIT, global_u8bit, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - write('Var parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - proc_var_smallrecord_mixed(RESULT_U8BIT,value_smallrec, RESULT_U8BIT); - if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_largerecord_mixed(RESULT_U8BIT, value_largerec, RESULT_U8BIT); - if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - write('var parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - proc_var_smallset_mixed(RESULT_U8BIT, value_smallset, RESULT_U8BIT); - if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_largeset_mixed(RESULT_U8BIT, value_largeset, RESULT_U8BIT); - if not ('I' in value_largeset) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - write('var parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - proc_var_smallstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT); - if value_smallstring <> RESULT_SMALLSTRING then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_bigstring_mixed(RESULT_U8BIT, value_bigstring,RESULT_U8BIT); - if value_bigstring <> RESULT_BIGSTRING then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_openstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT); - if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - - write('Var parameter test (src : LOC_REFERENCE (formaldef)))...'); - clear_globals; - clear_values; - failed:=false; - - proc_var_formaldef_array_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - write('Var parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_var_smallarray_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - - - clear_globals; - clear_values; - - proc_var_smallarray_open_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - if value_u8bit <> RESULT_U8BIT 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 } +{ (var parameters with popstack calling convention) } +{****************************************************************} +program tcalvar5; +{$ifdef fpc} + {$mode objfpc} + {$INLINE ON} +{$endif} +{$R+} +{$P-} +{$V+} + +{$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 +{$ifdef fpc} + pbytearr=^byte; +{$else} + pbytearr=^tbytearr; + tbytearr=array[0..$fffffff] of byte; +{$endif} + + tclass1 = class + end; + + 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_s64bit : int64; + global_s32real : single; + global_s64real : double; + global_ptr : pchar; + global_proc : tprocedure; + global_class : tclass1; + global_bigstring : shortstring; + global_boolean : boolean; + global_char : char; + value_u8bit : byte; + value_u16bit : word; + value_s32bit : longint; + value_s64bit : int64; + value_s32real : single; + value_s64real : double; + value_proc : tprocedure; + value_ptr : pchar; + value_class : tclass1; + 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_s64bit := 0; + global_s32real := 0.0; + global_s64real := 0.0; + global_ptr := nil; + global_proc := nil; + global_class := nil; + global_bigstring := ''; + global_boolean := false; + global_char := #0; + end; + + + procedure clear_values; + begin + value_u8bit := 0; + value_u16bit := 0; + value_s32bit := 0; + value_s64bit := 0; + value_s32real := 0.0; + value_s64real := 0.0; + value_proc := nil; + value_ptr := nil; + value_class := 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; + end; + + + procedure testprocedure; + begin + end; + + function getu8bit : byte; + begin + getu8bit:=RESULT_U8BIT; + end; + + function getu16bit: word; + begin + getu16bit:=RESULT_U16BIT; + end; + + function gets32bit: longint; + begin + gets32bit:=RESULT_S32BIT; + end; + + function gets64bit: int64; + begin + gets64bit:=RESULT_S64BIT; + end; + + + function gets32real: single; + begin + gets32real:=RESULT_S32REAL; + end; + + function gets64real: double; + begin + gets64real:=RESULT_S64REAL; + end; + + {************************************************************************} + { VAR PARAMETERS } + {************************************************************************} + procedure proc_var_s32bit(var v : longint);popstack; + begin + v:=RESULT_S32BIT; + end; + + procedure proc_var_s64bit(var v: int64);popstack; + begin + v:=RESULT_S64BIT; + end; + + + procedure proc_var_u8bit(var v: byte);popstack; + begin + v:=RESULT_U8BIT; + end; + + procedure proc_var_smallrecord(var smallrec : tsmallrecord);popstack; + begin + smallrec.b := RESULT_U8BIT; + smallrec.w := RESULT_U16BIT; + end; + + + procedure proc_var_largerecord(var largerec : tlargerecord);popstack; + begin + largerec.b[1] := RESULT_U8BIT; + largerec.b[2] := RESULT_U8BIT; + end; + + + procedure proc_var_smallset(var smallset : tsmallset);popstack; + begin + smallset := [A_A,A_D]; + end; + + + procedure proc_var_largeset(var largeset : tlargeset);popstack; + begin + largeset:= largeset + ['I']; + end; + + + procedure proc_var_smallstring(var s:tsmallstring);popstack; + begin + s:=RESULT_SMALLSTRING; + end; + + + procedure proc_var_bigstring(var s:shortstring);popstack; + begin + s:=RESULT_BIGSTRING; + end; + + + procedure proc_var_openstring(var s: OpenString);popstack; + begin + global_u8bit := high(s); + s:=RESULT_SMALLSTRING; + end; + + procedure proc_var_smallarray(var arr : tsmallarray);popstack; + begin + arr[SMALL_INDEX] := RESULT_U8BIT; + arr[1] := RESULT_U8BIT; + end; + + procedure proc_var_smallarray_open(var arr : array of byte);popstack; + begin + arr[high(arr)] := RESULT_U8BIT; + arr[low(arr)] := RESULT_U8BIT; + end; + + procedure proc_var_smallarray_const_1(var arr : array of const);popstack; + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : arr[i].vinteger := RESULT_U8BIT; + vtBoolean : arr[i].vboolean := RESULT_BOOLEAN; + else + RunError(255); + end; + end; {endfor} + end; + + + procedure proc_var_smallarray_const_2(var arr : array of const);popstack; + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_formaldef_array(var buf);popstack; + var + p: pbytearr; + begin + { array is indexed from 1 } + p := @buf; + p[SMALL_INDEX-1] := RESULT_U8BIT; + p[0] := RESULT_U8BIT; + end; + + +procedure proc_var_formaldef_string(var buf);popstack; + var + p: pbytearr; + begin + { array is indexed from 1 } + p := @buf; + p[SMALL_INDEX-1] := RESULT_U8BIT; + p[0] := RESULT_U8BIT; + end; + + + {************************************************************************} + { MIXED VAR PARAMETERS } + {************************************************************************} + procedure proc_var_s32bit_mixed(b1 : byte;var v : longint; b2: byte);popstack; + begin + v:=RESULT_S32BIT; + value_u8bit := RESULT_U8BIT; + end; + + procedure proc_var_s64bit_mixed(b1 : byte;var v: int64; b2: byte);popstack; + begin + v:=RESULT_S64BIT; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_u8bit_mixed(b1 : byte;var v: byte; b2: byte);popstack; + begin + v:=RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + + procedure proc_var_smallrecord_mixed(b1 : byte; var smallrec : tsmallrecord; b2: byte);popstack; + begin + smallrec.b := RESULT_U8BIT; + smallrec.w := RESULT_U16BIT; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_largerecord_mixed(b1 : byte; var largerec : tlargerecord; b2: byte);popstack; + begin + largerec.b[1] := RESULT_U8BIT; + largerec.b[2] := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_smallset_mixed(b1 : byte; var smallset : tsmallset; b2: byte);popstack; + begin + smallset := [A_A,A_D]; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_largeset_mixed(b1 : byte; var largeset : tlargeset; b2: byte);popstack; + begin + largeset:= largeset + ['I']; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_smallstring_mixed(b1 : byte; var s:tsmallstring; b2: byte);popstack; + begin + s:=RESULT_SMALLSTRING; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_bigstring_mixed(b1 : byte; var s:shortstring; b2: byte);popstack; + begin + s:=RESULT_BIGSTRING; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_openstring_mixed(b1 : byte; var s: OpenString; b2: byte);popstack; + begin + global_u8bit := high(s); + s:=RESULT_SMALLSTRING; + value_u8bit := RESULT_U8BIT; + end; + + procedure proc_var_smallarray_mixed(b1 : byte; var arr : tsmallarray; b2: byte);popstack; + begin + arr[SMALL_INDEX] := RESULT_U8BIT; + arr[1] := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + + procedure proc_var_smallarray_open_mixed(b1 : byte; var arr : array of byte; b2: byte);popstack; + begin + arr[high(arr)] := RESULT_U8BIT; + arr[low(arr)] := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + + procedure proc_var_smallarray_const_1_mixed(b1 : byte; var arr : array of const; b2: byte);popstack; + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : arr[i].vinteger := RESULT_U8BIT; + vtBoolean : arr[i].vboolean := RESULT_BOOLEAN; + else + RunError(255); + end; + end; {endfor} + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_smallarray_const_2_mixed(b1 : byte; var arr : array of const; b2: byte);popstack; + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; +end; + + + procedure proc_var_formaldef_array_mixed(b1 : byte; var buf; b2: byte);popstack; + var + p: pbytearr; + begin + { array is indexed from 1 } + p := @buf; + p[SMALL_INDEX-1] := RESULT_U8BIT; + p[0] := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + + +procedure proc_var_formaldef_string_mixed(b1 : byte; var buf; b2: byte);popstack; + var + p: pbytearr; + begin + { array is indexed from 1 } + p := @buf; + p[SMALL_INDEX-1] := RESULT_U8BIT; + p[0] := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + +var + failed: boolean; + pp : ^pchar; +begin + {***************************** NORMAL TESTS *******************************} + clear_globals; + clear_values; + failed:=false; + + write('Var parameter test (src : LOC_REFERENCE (orddef)))...'); + proc_var_s32bit(global_s32bit); + if global_s32bit <> RESULT_S32BIT then + failed:=true; + + clear_globals; + clear_values; + proc_var_s64bit(global_s64bit); + if global_s64bit <> RESULT_S64BIT then + failed:=true; + + clear_globals; + clear_values; + proc_var_u8bit(global_u8bit); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + + + if failed then + fail + else + WriteLn('Passed!'); + + write('Var parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + proc_var_smallrecord(value_smallrec); + if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then + failed := true; + + clear_globals; + clear_values; + proc_var_largerecord(value_largerec); + if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + write('var parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + proc_var_smallset(value_smallset); + if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then + failed := true; + + clear_globals; + clear_values; + proc_var_largeset(value_largeset); + if not ('I' in value_largeset) then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + write('var parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + proc_var_smallstring(value_smallstring); + if value_smallstring <> RESULT_SMALLSTRING then + failed := true; + + clear_globals; + clear_values; + proc_var_bigstring(value_bigstring); + if value_bigstring <> RESULT_BIGSTRING then + failed := true; + + clear_globals; + clear_values; + proc_var_openstring(value_smallstring); + if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + + write('Var parameter test (src : LOC_REFERENCE (formaldef)))...'); + clear_globals; + clear_values; + failed:=false; + + proc_var_formaldef_array(value_smallarray); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + write('Var parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_var_smallarray(value_smallarray); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + + + + clear_globals; + clear_values; + + proc_var_smallarray_open(value_smallarray); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + +(* HOW CAN ARRAY OF CONST VAR PARAMETERS BE TESTED? + clear_globals; + clear_values; + value_u8bit := RESULT_U8BIT; + value_ptr := RESULT_PCHAR; + value_s64bit := RESULT_S64BIT; + value_smallstring := RESULT_SMALLSTRING; + value_class := tclass1.create; + value_boolean := RESULT_BOOLEAN; + value_char := RESULT_CHAR; + value_s64real:=RESULT_S64REAL; + proc_var_smallarray_var_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,value_boolean,value_class]); + + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if global_char <> RESULT_CHAR then + failed := true; + if global_boolean <> RESULT_BOOLEAN then + failed:=true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed := true; + if global_bigstring <> RESULT_SMALLSTRING then + failed := true; + if global_ptr <> value_ptr then + failed := true; +{ if value_class <> global_class then + failed := true;!!!!!!!!!!!!!!!!!!!!} + if global_s64bit <> RESULT_S64BIT then + failed := true; + if assigned(value_class) then + value_class.destroy; + global_u8bit := 0; + proc_var_smallarray_const_2([]); + if global_u8bit <> RESULT_U8BIT then + failed := true; +*) + + + if failed then + fail + else + WriteLn('Passed!'); + + {***************************** MIXED TESTS *******************************} + clear_globals; + clear_values; + failed:=false; + + write('Var parameter test (src : LOC_REFERENCE (orddef)))...'); + proc_var_s32bit_mixed(RESULT_U8BIT, global_s32bit, RESULT_U8BIT); + if global_s32bit <> RESULT_S32BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_s64bit_mixed(RESULT_U8BIT, global_s64bit, RESULT_U8BIT); + if global_s64bit <> RESULT_S64BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_u8bit_mixed(RESULT_U8BIT, global_u8bit, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + write('Var parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + proc_var_smallrecord_mixed(RESULT_U8BIT,value_smallrec, RESULT_U8BIT); + if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_largerecord_mixed(RESULT_U8BIT, value_largerec, RESULT_U8BIT); + if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + write('var parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + proc_var_smallset_mixed(RESULT_U8BIT, value_smallset, RESULT_U8BIT); + if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_largeset_mixed(RESULT_U8BIT, value_largeset, RESULT_U8BIT); + if not ('I' in value_largeset) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + write('var parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + proc_var_smallstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT); + if value_smallstring <> RESULT_SMALLSTRING then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_bigstring_mixed(RESULT_U8BIT, value_bigstring,RESULT_U8BIT); + if value_bigstring <> RESULT_BIGSTRING then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_openstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT); + if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + + write('Var parameter test (src : LOC_REFERENCE (formaldef)))...'); + clear_globals; + clear_values; + failed:=false; + + proc_var_formaldef_array_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + write('Var parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_var_smallarray_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + + + clear_globals; + clear_values; + + proc_var_smallarray_open_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + +end. + + +{ $Log$ - Revision 1.4 2002-09-22 09:08:41 carl - * gets64bit was not returning an int64! - - Revision 1.3 2002/09/07 15:40:55 peter - * old logs removed and tabs fixed - - Revision 1.2 2002/05/13 13:45:38 peter - * updated to compile tests with kylix - - Revision 1.1 2002/04/13 17:51:00 carl - + var parameter passing for different calling conventions - - -} + Revision 1.5 2003-04-22 10:24:29 florian + * fixed defines for powerpc + + Revision 1.4 2002/09/22 09:08:41 carl + * gets64bit was not returning an int64! + + Revision 1.3 2002/09/07 15:40:55 peter + * old logs removed and tabs fixed + + Revision 1.2 2002/05/13 13:45:38 peter + * updated to compile tests with kylix + + Revision 1.1 2002/04/13 17:51:00 carl + + var parameter passing for different calling conventions + + +} diff --git a/tests/test/cg/tcalvar6.pp b/tests/test/cg/tcalvar6.pp index 11eb7a055e..7b0294485f 100644 --- a/tests/test/cg/tcalvar6.pp +++ b/tests/test/cg/tcalvar6.pp @@ -1,840 +1,842 @@ -{****************************************************************} -{ 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 } -{ (var parameters with safecall calling convention) } -{****************************************************************} -program tcalvar6; -{$ifdef fpc} - {$mode objfpc} - {$INLINE ON} -{$endif} -{$R+} -{$P-} -{$V+} - -{$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; - {$endif} - {$ifdef cpui386} - 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 -{$ifdef fpc} - pbytearr=^byte; -{$else} - pbytearr=^tbytearr; - tbytearr=array[0..$fffffff] of byte; -{$endif} - - tclass1 = class - end; - - 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_s64bit : int64; - global_s32real : single; - global_s64real : double; - global_ptr : pchar; - global_proc : tprocedure; - global_class : tclass1; - global_bigstring : shortstring; - global_boolean : boolean; - global_char : char; - value_u8bit : byte; - value_u16bit : word; - value_s32bit : longint; - value_s64bit : int64; - value_s32real : single; - value_s64real : double; - value_proc : tprocedure; - value_ptr : pchar; - value_class : tclass1; - 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_s64bit := 0; - global_s32real := 0.0; - global_s64real := 0.0; - global_ptr := nil; - global_proc := nil; - global_class := nil; - global_bigstring := ''; - global_boolean := false; - global_char := #0; - end; - - - procedure clear_values; - begin - value_u8bit := 0; - value_u16bit := 0; - value_s32bit := 0; - value_s64bit := 0; - value_s32real := 0.0; - value_s64real := 0.0; - value_proc := nil; - value_ptr := nil; - value_class := 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; - end; - - - procedure testprocedure; - begin - end; - - function getu8bit : byte; - begin - getu8bit:=RESULT_U8BIT; - end; - - function getu16bit: word; - begin - getu16bit:=RESULT_U16BIT; - end; - - function gets32bit: longint; - begin - gets32bit:=RESULT_S32BIT; - end; - - function gets64bit: int64; - begin - gets64bit:=RESULT_S64BIT; - end; - - - function gets32real: single; - begin - gets32real:=RESULT_S32REAL; - end; - - function gets64real: double; - begin - gets64real:=RESULT_S64REAL; - end; - - {************************************************************************} - { VAR PARAMETERS } - {************************************************************************} - procedure proc_var_s32bit(var v : longint);safecall; - begin - v:=RESULT_S32BIT; - end; - - procedure proc_var_s64bit(var v: int64);safecall; - begin - v:=RESULT_S64BIT; - end; - - - procedure proc_var_u8bit(var v: byte);safecall; - begin - v:=RESULT_U8BIT; - end; - - procedure proc_var_smallrecord(var smallrec : tsmallrecord);safecall; - begin - smallrec.b := RESULT_U8BIT; - smallrec.w := RESULT_U16BIT; - end; - - - procedure proc_var_largerecord(var largerec : tlargerecord);safecall; - begin - largerec.b[1] := RESULT_U8BIT; - largerec.b[2] := RESULT_U8BIT; - end; - - - procedure proc_var_smallset(var smallset : tsmallset);safecall; - begin - smallset := [A_A,A_D]; - end; - - - procedure proc_var_largeset(var largeset : tlargeset);safecall; - begin - largeset:= largeset + ['I']; - end; - - - procedure proc_var_smallstring(var s:tsmallstring);safecall; - begin - s:=RESULT_SMALLSTRING; - end; - - - procedure proc_var_bigstring(var s:shortstring);safecall; - begin - s:=RESULT_BIGSTRING; - end; - - - procedure proc_var_openstring(var s: OpenString);safecall; - begin - global_u8bit := high(s); - s:=RESULT_SMALLSTRING; - end; - - procedure proc_var_smallarray(var arr : tsmallarray);safecall; - begin - arr[SMALL_INDEX] := RESULT_U8BIT; - arr[1] := RESULT_U8BIT; - end; - - procedure proc_var_smallarray_open(var arr : array of byte);safecall; - begin - arr[high(arr)] := RESULT_U8BIT; - arr[low(arr)] := RESULT_U8BIT; - end; - - procedure proc_var_smallarray_const_1(var arr : array of const);safecall; - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : arr[i].vinteger := RESULT_U8BIT; - vtBoolean : arr[i].vboolean := RESULT_BOOLEAN; - else - RunError(255); - end; - end; {endfor} - end; - - - procedure proc_var_smallarray_const_2(var arr : array of const);safecall; - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_formaldef_array(var buf);safecall; - var - p: pbytearr; - begin - { array is indexed from 1 } - p := @buf; - p[SMALL_INDEX-1] := RESULT_U8BIT; - p[0] := RESULT_U8BIT; - end; - - -procedure proc_var_formaldef_string(var buf);safecall; - var - p: pbytearr; - begin - { array is indexed from 1 } - p := @buf; - p[SMALL_INDEX-1] := RESULT_U8BIT; - p[0] := RESULT_U8BIT; - end; - - - {************************************************************************} - { MIXED VAR PARAMETERS } - {************************************************************************} - procedure proc_var_s32bit_mixed(b1 : byte;var v : longint; b2: byte);safecall; - begin - v:=RESULT_S32BIT; - value_u8bit := RESULT_U8BIT; - end; - - procedure proc_var_s64bit_mixed(b1 : byte;var v: int64; b2: byte);safecall; - begin - v:=RESULT_S64BIT; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_u8bit_mixed(b1 : byte;var v: byte; b2: byte);safecall; - begin - v:=RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - - procedure proc_var_smallrecord_mixed(b1 : byte; var smallrec : tsmallrecord; b2: byte);safecall; - begin - smallrec.b := RESULT_U8BIT; - smallrec.w := RESULT_U16BIT; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_largerecord_mixed(b1 : byte; var largerec : tlargerecord; b2: byte);safecall; - begin - largerec.b[1] := RESULT_U8BIT; - largerec.b[2] := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_smallset_mixed(b1 : byte; var smallset : tsmallset; b2: byte);safecall; - begin - smallset := [A_A,A_D]; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_largeset_mixed(b1 : byte; var largeset : tlargeset; b2: byte);safecall; - begin - largeset:= largeset + ['I']; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_smallstring_mixed(b1 : byte; var s:tsmallstring; b2: byte);safecall; - begin - s:=RESULT_SMALLSTRING; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_bigstring_mixed(b1 : byte; var s:shortstring; b2: byte);safecall; - begin - s:=RESULT_BIGSTRING; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_openstring_mixed(b1 : byte; var s: OpenString; b2: byte);safecall; - begin - global_u8bit := high(s); - s:=RESULT_SMALLSTRING; - value_u8bit := RESULT_U8BIT; - end; - - procedure proc_var_smallarray_mixed(b1 : byte; var arr : tsmallarray; b2: byte);safecall; - begin - arr[SMALL_INDEX] := RESULT_U8BIT; - arr[1] := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - - procedure proc_var_smallarray_open_mixed(b1 : byte; var arr : array of byte; b2: byte);safecall; - begin - arr[high(arr)] := RESULT_U8BIT; - arr[low(arr)] := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - - procedure proc_var_smallarray_const_1_mixed(b1 : byte; var arr : array of const; b2: byte);safecall; - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : arr[i].vinteger := RESULT_U8BIT; - vtBoolean : arr[i].vboolean := RESULT_BOOLEAN; - else - RunError(255); - end; - end; {endfor} - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_smallarray_const_2_mixed(b1 : byte; var arr : array of const; b2: byte);safecall; - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; -end; - - - procedure proc_var_formaldef_array_mixed(b1 : byte; var buf; b2: byte);safecall; - var - p: pbytearr; - begin - { array is indexed from 1 } - p := @buf; - p[SMALL_INDEX-1] := RESULT_U8BIT; - p[0] := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - - -procedure proc_var_formaldef_string_mixed(b1 : byte; var buf; b2: byte);safecall; - var - p: pbytearr; - begin - { array is indexed from 1 } - p := @buf; - p[SMALL_INDEX-1] := RESULT_U8BIT; - p[0] := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - -var - failed: boolean; - pp : ^pchar; -begin - {***************************** NORMAL TESTS *******************************} - clear_globals; - clear_values; - failed:=false; - - write('Var parameter test (src : LOC_REFERENCE (orddef)))...'); - proc_var_s32bit(global_s32bit); - if global_s32bit <> RESULT_S32BIT then - failed:=true; - - clear_globals; - clear_values; - proc_var_s64bit(global_s64bit); - if global_s64bit <> RESULT_S64BIT then - failed:=true; - - clear_globals; - clear_values; - proc_var_u8bit(global_u8bit); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - - - if failed then - fail - else - WriteLn('Passed!'); - - write('Var parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - proc_var_smallrecord(value_smallrec); - if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then - failed := true; - - clear_globals; - clear_values; - proc_var_largerecord(value_largerec); - if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - write('var parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - proc_var_smallset(value_smallset); - if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then - failed := true; - - clear_globals; - clear_values; - proc_var_largeset(value_largeset); - if not ('I' in value_largeset) then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - write('var parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - proc_var_smallstring(value_smallstring); - if value_smallstring <> RESULT_SMALLSTRING then - failed := true; - - clear_globals; - clear_values; - proc_var_bigstring(value_bigstring); - if value_bigstring <> RESULT_BIGSTRING then - failed := true; - - clear_globals; - clear_values; - proc_var_openstring(value_smallstring); - if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - - write('Var parameter test (src : LOC_REFERENCE (formaldef)))...'); - clear_globals; - clear_values; - failed:=false; - - proc_var_formaldef_array(value_smallarray); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - write('Var parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_var_smallarray(value_smallarray); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - - - - clear_globals; - clear_values; - - proc_var_smallarray_open(value_smallarray); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - -(* HOW CAN ARRAY OF CONST VAR PARAMETERS BE TESTED? - clear_globals; - clear_values; - value_u8bit := RESULT_U8BIT; - value_ptr := RESULT_PCHAR; - value_s64bit := RESULT_S64BIT; - value_smallstring := RESULT_SMALLSTRING; - value_class := tclass1.create; - value_boolean := RESULT_BOOLEAN; - value_char := RESULT_CHAR; - value_s64real:=RESULT_S64REAL; - proc_var_smallarray_var_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,value_boolean,value_class]); - - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if global_char <> RESULT_CHAR then - failed := true; - if global_boolean <> RESULT_BOOLEAN then - failed:=true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed := true; - if global_bigstring <> RESULT_SMALLSTRING then - failed := true; - if global_ptr <> value_ptr then - failed := true; -{ if value_class <> global_class then - failed := true;!!!!!!!!!!!!!!!!!!!!} - if global_s64bit <> RESULT_S64BIT then - failed := true; - if assigned(value_class) then - value_class.destroy; - global_u8bit := 0; - proc_var_smallarray_const_2([]); - if global_u8bit <> RESULT_U8BIT then - failed := true; -*) - - - if failed then - fail - else - WriteLn('Passed!'); - - {***************************** MIXED TESTS *******************************} - clear_globals; - clear_values; - failed:=false; - - write('Var parameter test (src : LOC_REFERENCE (orddef)))...'); - proc_var_s32bit_mixed(RESULT_U8BIT, global_s32bit, RESULT_U8BIT); - if global_s32bit <> RESULT_S32BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_s64bit_mixed(RESULT_U8BIT, global_s64bit, RESULT_U8BIT); - if global_s64bit <> RESULT_S64BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_u8bit_mixed(RESULT_U8BIT, global_u8bit, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - write('Var parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - proc_var_smallrecord_mixed(RESULT_U8BIT,value_smallrec, RESULT_U8BIT); - if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_largerecord_mixed(RESULT_U8BIT, value_largerec, RESULT_U8BIT); - if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - write('var parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - proc_var_smallset_mixed(RESULT_U8BIT, value_smallset, RESULT_U8BIT); - if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_largeset_mixed(RESULT_U8BIT, value_largeset, RESULT_U8BIT); - if not ('I' in value_largeset) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - write('var parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - proc_var_smallstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT); - if value_smallstring <> RESULT_SMALLSTRING then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_bigstring_mixed(RESULT_U8BIT, value_bigstring,RESULT_U8BIT); - if value_bigstring <> RESULT_BIGSTRING then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_openstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT); - if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - - write('Var parameter test (src : LOC_REFERENCE (formaldef)))...'); - clear_globals; - clear_values; - failed:=false; - - proc_var_formaldef_array_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - write('Var parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_var_smallarray_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - - - clear_globals; - clear_values; - - proc_var_smallarray_open_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - if value_u8bit <> RESULT_U8BIT 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 } +{ (var parameters with safecall calling convention) } +{****************************************************************} +program tcalvar6; +{$ifdef fpc} + {$mode objfpc} + {$INLINE ON} +{$endif} +{$R+} +{$P-} +{$V+} + +{$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 +{$ifdef fpc} + pbytearr=^byte; +{$else} + pbytearr=^tbytearr; + tbytearr=array[0..$fffffff] of byte; +{$endif} + + tclass1 = class + end; + + 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_s64bit : int64; + global_s32real : single; + global_s64real : double; + global_ptr : pchar; + global_proc : tprocedure; + global_class : tclass1; + global_bigstring : shortstring; + global_boolean : boolean; + global_char : char; + value_u8bit : byte; + value_u16bit : word; + value_s32bit : longint; + value_s64bit : int64; + value_s32real : single; + value_s64real : double; + value_proc : tprocedure; + value_ptr : pchar; + value_class : tclass1; + 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_s64bit := 0; + global_s32real := 0.0; + global_s64real := 0.0; + global_ptr := nil; + global_proc := nil; + global_class := nil; + global_bigstring := ''; + global_boolean := false; + global_char := #0; + end; + + + procedure clear_values; + begin + value_u8bit := 0; + value_u16bit := 0; + value_s32bit := 0; + value_s64bit := 0; + value_s32real := 0.0; + value_s64real := 0.0; + value_proc := nil; + value_ptr := nil; + value_class := 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; + end; + + + procedure testprocedure; + begin + end; + + function getu8bit : byte; + begin + getu8bit:=RESULT_U8BIT; + end; + + function getu16bit: word; + begin + getu16bit:=RESULT_U16BIT; + end; + + function gets32bit: longint; + begin + gets32bit:=RESULT_S32BIT; + end; + + function gets64bit: int64; + begin + gets64bit:=RESULT_S64BIT; + end; + + + function gets32real: single; + begin + gets32real:=RESULT_S32REAL; + end; + + function gets64real: double; + begin + gets64real:=RESULT_S64REAL; + end; + + {************************************************************************} + { VAR PARAMETERS } + {************************************************************************} + procedure proc_var_s32bit(var v : longint);safecall; + begin + v:=RESULT_S32BIT; + end; + + procedure proc_var_s64bit(var v: int64);safecall; + begin + v:=RESULT_S64BIT; + end; + + + procedure proc_var_u8bit(var v: byte);safecall; + begin + v:=RESULT_U8BIT; + end; + + procedure proc_var_smallrecord(var smallrec : tsmallrecord);safecall; + begin + smallrec.b := RESULT_U8BIT; + smallrec.w := RESULT_U16BIT; + end; + + + procedure proc_var_largerecord(var largerec : tlargerecord);safecall; + begin + largerec.b[1] := RESULT_U8BIT; + largerec.b[2] := RESULT_U8BIT; + end; + + + procedure proc_var_smallset(var smallset : tsmallset);safecall; + begin + smallset := [A_A,A_D]; + end; + + + procedure proc_var_largeset(var largeset : tlargeset);safecall; + begin + largeset:= largeset + ['I']; + end; + + + procedure proc_var_smallstring(var s:tsmallstring);safecall; + begin + s:=RESULT_SMALLSTRING; + end; + + + procedure proc_var_bigstring(var s:shortstring);safecall; + begin + s:=RESULT_BIGSTRING; + end; + + + procedure proc_var_openstring(var s: OpenString);safecall; + begin + global_u8bit := high(s); + s:=RESULT_SMALLSTRING; + end; + + procedure proc_var_smallarray(var arr : tsmallarray);safecall; + begin + arr[SMALL_INDEX] := RESULT_U8BIT; + arr[1] := RESULT_U8BIT; + end; + + procedure proc_var_smallarray_open(var arr : array of byte);safecall; + begin + arr[high(arr)] := RESULT_U8BIT; + arr[low(arr)] := RESULT_U8BIT; + end; + + procedure proc_var_smallarray_const_1(var arr : array of const);safecall; + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : arr[i].vinteger := RESULT_U8BIT; + vtBoolean : arr[i].vboolean := RESULT_BOOLEAN; + else + RunError(255); + end; + end; {endfor} + end; + + + procedure proc_var_smallarray_const_2(var arr : array of const);safecall; + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_formaldef_array(var buf);safecall; + var + p: pbytearr; + begin + { array is indexed from 1 } + p := @buf; + p[SMALL_INDEX-1] := RESULT_U8BIT; + p[0] := RESULT_U8BIT; + end; + + +procedure proc_var_formaldef_string(var buf);safecall; + var + p: pbytearr; + begin + { array is indexed from 1 } + p := @buf; + p[SMALL_INDEX-1] := RESULT_U8BIT; + p[0] := RESULT_U8BIT; + end; + + + {************************************************************************} + { MIXED VAR PARAMETERS } + {************************************************************************} + procedure proc_var_s32bit_mixed(b1 : byte;var v : longint; b2: byte);safecall; + begin + v:=RESULT_S32BIT; + value_u8bit := RESULT_U8BIT; + end; + + procedure proc_var_s64bit_mixed(b1 : byte;var v: int64; b2: byte);safecall; + begin + v:=RESULT_S64BIT; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_u8bit_mixed(b1 : byte;var v: byte; b2: byte);safecall; + begin + v:=RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + + procedure proc_var_smallrecord_mixed(b1 : byte; var smallrec : tsmallrecord; b2: byte);safecall; + begin + smallrec.b := RESULT_U8BIT; + smallrec.w := RESULT_U16BIT; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_largerecord_mixed(b1 : byte; var largerec : tlargerecord; b2: byte);safecall; + begin + largerec.b[1] := RESULT_U8BIT; + largerec.b[2] := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_smallset_mixed(b1 : byte; var smallset : tsmallset; b2: byte);safecall; + begin + smallset := [A_A,A_D]; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_largeset_mixed(b1 : byte; var largeset : tlargeset; b2: byte);safecall; + begin + largeset:= largeset + ['I']; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_smallstring_mixed(b1 : byte; var s:tsmallstring; b2: byte);safecall; + begin + s:=RESULT_SMALLSTRING; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_bigstring_mixed(b1 : byte; var s:shortstring; b2: byte);safecall; + begin + s:=RESULT_BIGSTRING; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_openstring_mixed(b1 : byte; var s: OpenString; b2: byte);safecall; + begin + global_u8bit := high(s); + s:=RESULT_SMALLSTRING; + value_u8bit := RESULT_U8BIT; + end; + + procedure proc_var_smallarray_mixed(b1 : byte; var arr : tsmallarray; b2: byte);safecall; + begin + arr[SMALL_INDEX] := RESULT_U8BIT; + arr[1] := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + + procedure proc_var_smallarray_open_mixed(b1 : byte; var arr : array of byte; b2: byte);safecall; + begin + arr[high(arr)] := RESULT_U8BIT; + arr[low(arr)] := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + + procedure proc_var_smallarray_const_1_mixed(b1 : byte; var arr : array of const; b2: byte);safecall; + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : arr[i].vinteger := RESULT_U8BIT; + vtBoolean : arr[i].vboolean := RESULT_BOOLEAN; + else + RunError(255); + end; + end; {endfor} + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_smallarray_const_2_mixed(b1 : byte; var arr : array of const; b2: byte);safecall; + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; +end; + + + procedure proc_var_formaldef_array_mixed(b1 : byte; var buf; b2: byte);safecall; + var + p: pbytearr; + begin + { array is indexed from 1 } + p := @buf; + p[SMALL_INDEX-1] := RESULT_U8BIT; + p[0] := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + + +procedure proc_var_formaldef_string_mixed(b1 : byte; var buf; b2: byte);safecall; + var + p: pbytearr; + begin + { array is indexed from 1 } + p := @buf; + p[SMALL_INDEX-1] := RESULT_U8BIT; + p[0] := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + +var + failed: boolean; + pp : ^pchar; +begin + {***************************** NORMAL TESTS *******************************} + clear_globals; + clear_values; + failed:=false; + + write('Var parameter test (src : LOC_REFERENCE (orddef)))...'); + proc_var_s32bit(global_s32bit); + if global_s32bit <> RESULT_S32BIT then + failed:=true; + + clear_globals; + clear_values; + proc_var_s64bit(global_s64bit); + if global_s64bit <> RESULT_S64BIT then + failed:=true; + + clear_globals; + clear_values; + proc_var_u8bit(global_u8bit); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + + + if failed then + fail + else + WriteLn('Passed!'); + + write('Var parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + proc_var_smallrecord(value_smallrec); + if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then + failed := true; + + clear_globals; + clear_values; + proc_var_largerecord(value_largerec); + if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + write('var parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + proc_var_smallset(value_smallset); + if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then + failed := true; + + clear_globals; + clear_values; + proc_var_largeset(value_largeset); + if not ('I' in value_largeset) then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + write('var parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + proc_var_smallstring(value_smallstring); + if value_smallstring <> RESULT_SMALLSTRING then + failed := true; + + clear_globals; + clear_values; + proc_var_bigstring(value_bigstring); + if value_bigstring <> RESULT_BIGSTRING then + failed := true; + + clear_globals; + clear_values; + proc_var_openstring(value_smallstring); + if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + + write('Var parameter test (src : LOC_REFERENCE (formaldef)))...'); + clear_globals; + clear_values; + failed:=false; + + proc_var_formaldef_array(value_smallarray); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + write('Var parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_var_smallarray(value_smallarray); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + + + + clear_globals; + clear_values; + + proc_var_smallarray_open(value_smallarray); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + +(* HOW CAN ARRAY OF CONST VAR PARAMETERS BE TESTED? + clear_globals; + clear_values; + value_u8bit := RESULT_U8BIT; + value_ptr := RESULT_PCHAR; + value_s64bit := RESULT_S64BIT; + value_smallstring := RESULT_SMALLSTRING; + value_class := tclass1.create; + value_boolean := RESULT_BOOLEAN; + value_char := RESULT_CHAR; + value_s64real:=RESULT_S64REAL; + proc_var_smallarray_var_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,value_boolean,value_class]); + + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if global_char <> RESULT_CHAR then + failed := true; + if global_boolean <> RESULT_BOOLEAN then + failed:=true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed := true; + if global_bigstring <> RESULT_SMALLSTRING then + failed := true; + if global_ptr <> value_ptr then + failed := true; +{ if value_class <> global_class then + failed := true;!!!!!!!!!!!!!!!!!!!!} + if global_s64bit <> RESULT_S64BIT then + failed := true; + if assigned(value_class) then + value_class.destroy; + global_u8bit := 0; + proc_var_smallarray_const_2([]); + if global_u8bit <> RESULT_U8BIT then + failed := true; +*) + + + if failed then + fail + else + WriteLn('Passed!'); + + {***************************** MIXED TESTS *******************************} + clear_globals; + clear_values; + failed:=false; + + write('Var parameter test (src : LOC_REFERENCE (orddef)))...'); + proc_var_s32bit_mixed(RESULT_U8BIT, global_s32bit, RESULT_U8BIT); + if global_s32bit <> RESULT_S32BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_s64bit_mixed(RESULT_U8BIT, global_s64bit, RESULT_U8BIT); + if global_s64bit <> RESULT_S64BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_u8bit_mixed(RESULT_U8BIT, global_u8bit, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + write('Var parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + proc_var_smallrecord_mixed(RESULT_U8BIT,value_smallrec, RESULT_U8BIT); + if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_largerecord_mixed(RESULT_U8BIT, value_largerec, RESULT_U8BIT); + if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + write('var parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + proc_var_smallset_mixed(RESULT_U8BIT, value_smallset, RESULT_U8BIT); + if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_largeset_mixed(RESULT_U8BIT, value_largeset, RESULT_U8BIT); + if not ('I' in value_largeset) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + write('var parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + proc_var_smallstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT); + if value_smallstring <> RESULT_SMALLSTRING then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_bigstring_mixed(RESULT_U8BIT, value_bigstring,RESULT_U8BIT); + if value_bigstring <> RESULT_BIGSTRING then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_openstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT); + if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + + write('Var parameter test (src : LOC_REFERENCE (formaldef)))...'); + clear_globals; + clear_values; + failed:=false; + + proc_var_formaldef_array_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + write('Var parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_var_smallarray_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + + + clear_globals; + clear_values; + + proc_var_smallarray_open_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + +end. + + +{ $Log$ - Revision 1.4 2002-09-22 09:08:41 carl - * gets64bit was not returning an int64! - - Revision 1.3 2002/09/07 15:40:55 peter - * old logs removed and tabs fixed - - Revision 1.2 2002/05/13 13:45:38 peter - * updated to compile tests with kylix - - Revision 1.1 2002/04/13 17:51:00 carl - + var parameter passing for different calling conventions - - -} + Revision 1.5 2003-04-22 10:24:29 florian + * fixed defines for powerpc + + Revision 1.4 2002/09/22 09:08:41 carl + * gets64bit was not returning an int64! + + Revision 1.3 2002/09/07 15:40:55 peter + * old logs removed and tabs fixed + + Revision 1.2 2002/05/13 13:45:38 peter + * updated to compile tests with kylix + + Revision 1.1 2002/04/13 17:51:00 carl + + var parameter passing for different calling conventions + + +} diff --git a/tests/test/cg/tcalvar7.pp b/tests/test/cg/tcalvar7.pp index 08e245384b..96509b434f 100644 --- a/tests/test/cg/tcalvar7.pp +++ b/tests/test/cg/tcalvar7.pp @@ -1,840 +1,842 @@ -{****************************************************************} -{ 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 } -{ (var parameters with register calling convention) } -{****************************************************************} -program tcalvar7; -{$ifdef fpc} - {$mode objfpc} - {$INLINE ON} -{$endif} -{$R+} -{$P-} -{$V+} - -{$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; - {$endif} - {$ifdef cpui386} - 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 -{$ifdef fpc} - pbytearr=^byte; -{$else} - pbytearr=^tbytearr; - tbytearr=array[0..$fffffff] of byte; -{$endif} - - tclass1 = class - end; - - 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_s64bit : int64; - global_s32real : single; - global_s64real : double; - global_ptr : pchar; - global_proc : tprocedure; - global_class : tclass1; - global_bigstring : shortstring; - global_boolean : boolean; - global_char : char; - value_u8bit : byte; - value_u16bit : word; - value_s32bit : longint; - value_s64bit : int64; - value_s32real : single; - value_s64real : double; - value_proc : tprocedure; - value_ptr : pchar; - value_class : tclass1; - 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_s64bit := 0; - global_s32real := 0.0; - global_s64real := 0.0; - global_ptr := nil; - global_proc := nil; - global_class := nil; - global_bigstring := ''; - global_boolean := false; - global_char := #0; - end; - - - procedure clear_values; - begin - value_u8bit := 0; - value_u16bit := 0; - value_s32bit := 0; - value_s64bit := 0; - value_s32real := 0.0; - value_s64real := 0.0; - value_proc := nil; - value_ptr := nil; - value_class := 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; - end; - - - procedure testprocedure; - begin - end; - - function getu8bit : byte; - begin - getu8bit:=RESULT_U8BIT; - end; - - function getu16bit: word; - begin - getu16bit:=RESULT_U16BIT; - end; - - function gets32bit: longint; - begin - gets32bit:=RESULT_S32BIT; - end; - - function gets64bit: int64; - begin - gets64bit:=RESULT_S64BIT; - end; - - - function gets32real: single; - begin - gets32real:=RESULT_S32REAL; - end; - - function gets64real: double; - begin - gets64real:=RESULT_S64REAL; - end; - - {************************************************************************} - { VAR PARAMETERS } - {************************************************************************} - procedure proc_var_s32bit(var v : longint);register; - begin - v:=RESULT_S32BIT; - end; - - procedure proc_var_s64bit(var v: int64);register; - begin - v:=RESULT_S64BIT; - end; - - - procedure proc_var_u8bit(var v: byte);register; - begin - v:=RESULT_U8BIT; - end; - - procedure proc_var_smallrecord(var smallrec : tsmallrecord);register; - begin - smallrec.b := RESULT_U8BIT; - smallrec.w := RESULT_U16BIT; - end; - - - procedure proc_var_largerecord(var largerec : tlargerecord);register; - begin - largerec.b[1] := RESULT_U8BIT; - largerec.b[2] := RESULT_U8BIT; - end; - - - procedure proc_var_smallset(var smallset : tsmallset);register; - begin - smallset := [A_A,A_D]; - end; - - - procedure proc_var_largeset(var largeset : tlargeset);register; - begin - largeset:= largeset + ['I']; - end; - - - procedure proc_var_smallstring(var s:tsmallstring);register; - begin - s:=RESULT_SMALLSTRING; - end; - - - procedure proc_var_bigstring(var s:shortstring);register; - begin - s:=RESULT_BIGSTRING; - end; - - - procedure proc_var_openstring(var s: OpenString);register; - begin - global_u8bit := high(s); - s:=RESULT_SMALLSTRING; - end; - - procedure proc_var_smallarray(var arr : tsmallarray);register; - begin - arr[SMALL_INDEX] := RESULT_U8BIT; - arr[1] := RESULT_U8BIT; - end; - - procedure proc_var_smallarray_open(var arr : array of byte);register; - begin - arr[high(arr)] := RESULT_U8BIT; - arr[low(arr)] := RESULT_U8BIT; - end; - - procedure proc_var_smallarray_const_1(var arr : array of const);register; - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : arr[i].vinteger := RESULT_U8BIT; - vtBoolean : arr[i].vboolean := RESULT_BOOLEAN; - else - RunError(255); - end; - end; {endfor} - end; - - - procedure proc_var_smallarray_const_2(var arr : array of const);register; - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_formaldef_array(var buf);register; - var - p: pbytearr; - begin - { array is indexed from 1 } - p := @buf; - p[SMALL_INDEX-1] := RESULT_U8BIT; - p[0] := RESULT_U8BIT; - end; - - -procedure proc_var_formaldef_string(var buf);register; - var - p: pbytearr; - begin - { array is indexed from 1 } - p := @buf; - p[SMALL_INDEX-1] := RESULT_U8BIT; - p[0] := RESULT_U8BIT; - end; - - - {************************************************************************} - { MIXED VAR PARAMETERS } - {************************************************************************} - procedure proc_var_s32bit_mixed(b1 : byte;var v : longint; b2: byte);register; - begin - v:=RESULT_S32BIT; - value_u8bit := RESULT_U8BIT; - end; - - procedure proc_var_s64bit_mixed(b1 : byte;var v: int64; b2: byte);register; - begin - v:=RESULT_S64BIT; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_u8bit_mixed(b1 : byte;var v: byte; b2: byte);register; - begin - v:=RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - - procedure proc_var_smallrecord_mixed(b1 : byte; var smallrec : tsmallrecord; b2: byte);register; - begin - smallrec.b := RESULT_U8BIT; - smallrec.w := RESULT_U16BIT; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_largerecord_mixed(b1 : byte; var largerec : tlargerecord; b2: byte);register; - begin - largerec.b[1] := RESULT_U8BIT; - largerec.b[2] := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_smallset_mixed(b1 : byte; var smallset : tsmallset; b2: byte);register; - begin - smallset := [A_A,A_D]; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_largeset_mixed(b1 : byte; var largeset : tlargeset; b2: byte);register; - begin - largeset:= largeset + ['I']; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_smallstring_mixed(b1 : byte; var s:tsmallstring; b2: byte);register; - begin - s:=RESULT_SMALLSTRING; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_bigstring_mixed(b1 : byte; var s:shortstring; b2: byte);register; - begin - s:=RESULT_BIGSTRING; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_openstring_mixed(b1 : byte; var s: OpenString; b2: byte);register; - begin - global_u8bit := high(s); - s:=RESULT_SMALLSTRING; - value_u8bit := RESULT_U8BIT; - end; - - procedure proc_var_smallarray_mixed(b1 : byte; var arr : tsmallarray; b2: byte);register; - begin - arr[SMALL_INDEX] := RESULT_U8BIT; - arr[1] := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - - procedure proc_var_smallarray_open_mixed(b1 : byte; var arr : array of byte; b2: byte);register; - begin - arr[high(arr)] := RESULT_U8BIT; - arr[low(arr)] := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - - procedure proc_var_smallarray_const_1_mixed(b1 : byte; var arr : array of const; b2: byte);register; - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : arr[i].vinteger := RESULT_U8BIT; - vtBoolean : arr[i].vboolean := RESULT_BOOLEAN; - else - RunError(255); - end; - end; {endfor} - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_smallarray_const_2_mixed(b1 : byte; var arr : array of const; b2: byte);register; - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; -end; - - - procedure proc_var_formaldef_array_mixed(b1 : byte; var buf; b2: byte);register; - var - p: pbytearr; - begin - { array is indexed from 1 } - p := @buf; - p[SMALL_INDEX-1] := RESULT_U8BIT; - p[0] := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - - -procedure proc_var_formaldef_string_mixed(b1 : byte; var buf; b2: byte);register; - var - p: pbytearr; - begin - { array is indexed from 1 } - p := @buf; - p[SMALL_INDEX-1] := RESULT_U8BIT; - p[0] := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - -var - failed: boolean; - pp : ^pchar; -begin - {***************************** NORMAL TESTS *******************************} - clear_globals; - clear_values; - failed:=false; - - write('Var parameter test (src : LOC_REFERENCE (orddef)))...'); - proc_var_s32bit(global_s32bit); - if global_s32bit <> RESULT_S32BIT then - failed:=true; - - clear_globals; - clear_values; - proc_var_s64bit(global_s64bit); - if global_s64bit <> RESULT_S64BIT then - failed:=true; - - clear_globals; - clear_values; - proc_var_u8bit(global_u8bit); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - - - if failed then - fail - else - WriteLn('Passed!'); - - write('Var parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - proc_var_smallrecord(value_smallrec); - if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then - failed := true; - - clear_globals; - clear_values; - proc_var_largerecord(value_largerec); - if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - write('var parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - proc_var_smallset(value_smallset); - if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then - failed := true; - - clear_globals; - clear_values; - proc_var_largeset(value_largeset); - if not ('I' in value_largeset) then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - write('var parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - proc_var_smallstring(value_smallstring); - if value_smallstring <> RESULT_SMALLSTRING then - failed := true; - - clear_globals; - clear_values; - proc_var_bigstring(value_bigstring); - if value_bigstring <> RESULT_BIGSTRING then - failed := true; - - clear_globals; - clear_values; - proc_var_openstring(value_smallstring); - if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - - write('Var parameter test (src : LOC_REFERENCE (formaldef)))...'); - clear_globals; - clear_values; - failed:=false; - - proc_var_formaldef_array(value_smallarray); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - write('Var parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_var_smallarray(value_smallarray); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - - - - clear_globals; - clear_values; - - proc_var_smallarray_open(value_smallarray); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - -(* HOW CAN ARRAY OF CONST VAR PARAMETERS BE TESTED? - clear_globals; - clear_values; - value_u8bit := RESULT_U8BIT; - value_ptr := RESULT_PCHAR; - value_s64bit := RESULT_S64BIT; - value_smallstring := RESULT_SMALLSTRING; - value_class := tclass1.create; - value_boolean := RESULT_BOOLEAN; - value_char := RESULT_CHAR; - value_s64real:=RESULT_S64REAL; - proc_var_smallarray_var_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,value_boolean,value_class]); - - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if global_char <> RESULT_CHAR then - failed := true; - if global_boolean <> RESULT_BOOLEAN then - failed:=true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed := true; - if global_bigstring <> RESULT_SMALLSTRING then - failed := true; - if global_ptr <> value_ptr then - failed := true; -{ if value_class <> global_class then - failed := true;!!!!!!!!!!!!!!!!!!!!} - if global_s64bit <> RESULT_S64BIT then - failed := true; - if assigned(value_class) then - value_class.destroy; - global_u8bit := 0; - proc_var_smallarray_const_2([]); - if global_u8bit <> RESULT_U8BIT then - failed := true; -*) - - - if failed then - fail - else - WriteLn('Passed!'); - - {***************************** MIXED TESTS *******************************} - clear_globals; - clear_values; - failed:=false; - - write('Var parameter test (src : LOC_REFERENCE (orddef)))...'); - proc_var_s32bit_mixed(RESULT_U8BIT, global_s32bit, RESULT_U8BIT); - if global_s32bit <> RESULT_S32BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_s64bit_mixed(RESULT_U8BIT, global_s64bit, RESULT_U8BIT); - if global_s64bit <> RESULT_S64BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_u8bit_mixed(RESULT_U8BIT, global_u8bit, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - write('Var parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - proc_var_smallrecord_mixed(RESULT_U8BIT,value_smallrec, RESULT_U8BIT); - if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_largerecord_mixed(RESULT_U8BIT, value_largerec, RESULT_U8BIT); - if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - write('var parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - proc_var_smallset_mixed(RESULT_U8BIT, value_smallset, RESULT_U8BIT); - if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_largeset_mixed(RESULT_U8BIT, value_largeset, RESULT_U8BIT); - if not ('I' in value_largeset) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - write('var parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - proc_var_smallstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT); - if value_smallstring <> RESULT_SMALLSTRING then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_bigstring_mixed(RESULT_U8BIT, value_bigstring,RESULT_U8BIT); - if value_bigstring <> RESULT_BIGSTRING then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_openstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT); - if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - - write('Var parameter test (src : LOC_REFERENCE (formaldef)))...'); - clear_globals; - clear_values; - failed:=false; - - proc_var_formaldef_array_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - write('Var parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_var_smallarray_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - - - clear_globals; - clear_values; - - proc_var_smallarray_open_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - if value_u8bit <> RESULT_U8BIT 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 } +{ (var parameters with register calling convention) } +{****************************************************************} +program tcalvar7; +{$ifdef fpc} + {$mode objfpc} + {$INLINE ON} +{$endif} +{$R+} +{$P-} +{$V+} + +{$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 +{$ifdef fpc} + pbytearr=^byte; +{$else} + pbytearr=^tbytearr; + tbytearr=array[0..$fffffff] of byte; +{$endif} + + tclass1 = class + end; + + 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_s64bit : int64; + global_s32real : single; + global_s64real : double; + global_ptr : pchar; + global_proc : tprocedure; + global_class : tclass1; + global_bigstring : shortstring; + global_boolean : boolean; + global_char : char; + value_u8bit : byte; + value_u16bit : word; + value_s32bit : longint; + value_s64bit : int64; + value_s32real : single; + value_s64real : double; + value_proc : tprocedure; + value_ptr : pchar; + value_class : tclass1; + 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_s64bit := 0; + global_s32real := 0.0; + global_s64real := 0.0; + global_ptr := nil; + global_proc := nil; + global_class := nil; + global_bigstring := ''; + global_boolean := false; + global_char := #0; + end; + + + procedure clear_values; + begin + value_u8bit := 0; + value_u16bit := 0; + value_s32bit := 0; + value_s64bit := 0; + value_s32real := 0.0; + value_s64real := 0.0; + value_proc := nil; + value_ptr := nil; + value_class := 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; + end; + + + procedure testprocedure; + begin + end; + + function getu8bit : byte; + begin + getu8bit:=RESULT_U8BIT; + end; + + function getu16bit: word; + begin + getu16bit:=RESULT_U16BIT; + end; + + function gets32bit: longint; + begin + gets32bit:=RESULT_S32BIT; + end; + + function gets64bit: int64; + begin + gets64bit:=RESULT_S64BIT; + end; + + + function gets32real: single; + begin + gets32real:=RESULT_S32REAL; + end; + + function gets64real: double; + begin + gets64real:=RESULT_S64REAL; + end; + + {************************************************************************} + { VAR PARAMETERS } + {************************************************************************} + procedure proc_var_s32bit(var v : longint);register; + begin + v:=RESULT_S32BIT; + end; + + procedure proc_var_s64bit(var v: int64);register; + begin + v:=RESULT_S64BIT; + end; + + + procedure proc_var_u8bit(var v: byte);register; + begin + v:=RESULT_U8BIT; + end; + + procedure proc_var_smallrecord(var smallrec : tsmallrecord);register; + begin + smallrec.b := RESULT_U8BIT; + smallrec.w := RESULT_U16BIT; + end; + + + procedure proc_var_largerecord(var largerec : tlargerecord);register; + begin + largerec.b[1] := RESULT_U8BIT; + largerec.b[2] := RESULT_U8BIT; + end; + + + procedure proc_var_smallset(var smallset : tsmallset);register; + begin + smallset := [A_A,A_D]; + end; + + + procedure proc_var_largeset(var largeset : tlargeset);register; + begin + largeset:= largeset + ['I']; + end; + + + procedure proc_var_smallstring(var s:tsmallstring);register; + begin + s:=RESULT_SMALLSTRING; + end; + + + procedure proc_var_bigstring(var s:shortstring);register; + begin + s:=RESULT_BIGSTRING; + end; + + + procedure proc_var_openstring(var s: OpenString);register; + begin + global_u8bit := high(s); + s:=RESULT_SMALLSTRING; + end; + + procedure proc_var_smallarray(var arr : tsmallarray);register; + begin + arr[SMALL_INDEX] := RESULT_U8BIT; + arr[1] := RESULT_U8BIT; + end; + + procedure proc_var_smallarray_open(var arr : array of byte);register; + begin + arr[high(arr)] := RESULT_U8BIT; + arr[low(arr)] := RESULT_U8BIT; + end; + + procedure proc_var_smallarray_const_1(var arr : array of const);register; + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : arr[i].vinteger := RESULT_U8BIT; + vtBoolean : arr[i].vboolean := RESULT_BOOLEAN; + else + RunError(255); + end; + end; {endfor} + end; + + + procedure proc_var_smallarray_const_2(var arr : array of const);register; + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_formaldef_array(var buf);register; + var + p: pbytearr; + begin + { array is indexed from 1 } + p := @buf; + p[SMALL_INDEX-1] := RESULT_U8BIT; + p[0] := RESULT_U8BIT; + end; + + +procedure proc_var_formaldef_string(var buf);register; + var + p: pbytearr; + begin + { array is indexed from 1 } + p := @buf; + p[SMALL_INDEX-1] := RESULT_U8BIT; + p[0] := RESULT_U8BIT; + end; + + + {************************************************************************} + { MIXED VAR PARAMETERS } + {************************************************************************} + procedure proc_var_s32bit_mixed(b1 : byte;var v : longint; b2: byte);register; + begin + v:=RESULT_S32BIT; + value_u8bit := RESULT_U8BIT; + end; + + procedure proc_var_s64bit_mixed(b1 : byte;var v: int64; b2: byte);register; + begin + v:=RESULT_S64BIT; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_u8bit_mixed(b1 : byte;var v: byte; b2: byte);register; + begin + v:=RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + + procedure proc_var_smallrecord_mixed(b1 : byte; var smallrec : tsmallrecord; b2: byte);register; + begin + smallrec.b := RESULT_U8BIT; + smallrec.w := RESULT_U16BIT; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_largerecord_mixed(b1 : byte; var largerec : tlargerecord; b2: byte);register; + begin + largerec.b[1] := RESULT_U8BIT; + largerec.b[2] := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_smallset_mixed(b1 : byte; var smallset : tsmallset; b2: byte);register; + begin + smallset := [A_A,A_D]; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_largeset_mixed(b1 : byte; var largeset : tlargeset; b2: byte);register; + begin + largeset:= largeset + ['I']; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_smallstring_mixed(b1 : byte; var s:tsmallstring; b2: byte);register; + begin + s:=RESULT_SMALLSTRING; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_bigstring_mixed(b1 : byte; var s:shortstring; b2: byte);register; + begin + s:=RESULT_BIGSTRING; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_openstring_mixed(b1 : byte; var s: OpenString; b2: byte);register; + begin + global_u8bit := high(s); + s:=RESULT_SMALLSTRING; + value_u8bit := RESULT_U8BIT; + end; + + procedure proc_var_smallarray_mixed(b1 : byte; var arr : tsmallarray; b2: byte);register; + begin + arr[SMALL_INDEX] := RESULT_U8BIT; + arr[1] := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + + procedure proc_var_smallarray_open_mixed(b1 : byte; var arr : array of byte; b2: byte);register; + begin + arr[high(arr)] := RESULT_U8BIT; + arr[low(arr)] := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + + procedure proc_var_smallarray_const_1_mixed(b1 : byte; var arr : array of const; b2: byte);register; + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : arr[i].vinteger := RESULT_U8BIT; + vtBoolean : arr[i].vboolean := RESULT_BOOLEAN; + else + RunError(255); + end; + end; {endfor} + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_smallarray_const_2_mixed(b1 : byte; var arr : array of const; b2: byte);register; + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; +end; + + + procedure proc_var_formaldef_array_mixed(b1 : byte; var buf; b2: byte);register; + var + p: pbytearr; + begin + { array is indexed from 1 } + p := @buf; + p[SMALL_INDEX-1] := RESULT_U8BIT; + p[0] := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + + +procedure proc_var_formaldef_string_mixed(b1 : byte; var buf; b2: byte);register; + var + p: pbytearr; + begin + { array is indexed from 1 } + p := @buf; + p[SMALL_INDEX-1] := RESULT_U8BIT; + p[0] := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + +var + failed: boolean; + pp : ^pchar; +begin + {***************************** NORMAL TESTS *******************************} + clear_globals; + clear_values; + failed:=false; + + write('Var parameter test (src : LOC_REFERENCE (orddef)))...'); + proc_var_s32bit(global_s32bit); + if global_s32bit <> RESULT_S32BIT then + failed:=true; + + clear_globals; + clear_values; + proc_var_s64bit(global_s64bit); + if global_s64bit <> RESULT_S64BIT then + failed:=true; + + clear_globals; + clear_values; + proc_var_u8bit(global_u8bit); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + + + if failed then + fail + else + WriteLn('Passed!'); + + write('Var parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + proc_var_smallrecord(value_smallrec); + if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then + failed := true; + + clear_globals; + clear_values; + proc_var_largerecord(value_largerec); + if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + write('var parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + proc_var_smallset(value_smallset); + if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then + failed := true; + + clear_globals; + clear_values; + proc_var_largeset(value_largeset); + if not ('I' in value_largeset) then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + write('var parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + proc_var_smallstring(value_smallstring); + if value_smallstring <> RESULT_SMALLSTRING then + failed := true; + + clear_globals; + clear_values; + proc_var_bigstring(value_bigstring); + if value_bigstring <> RESULT_BIGSTRING then + failed := true; + + clear_globals; + clear_values; + proc_var_openstring(value_smallstring); + if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + + write('Var parameter test (src : LOC_REFERENCE (formaldef)))...'); + clear_globals; + clear_values; + failed:=false; + + proc_var_formaldef_array(value_smallarray); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + write('Var parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_var_smallarray(value_smallarray); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + + + + clear_globals; + clear_values; + + proc_var_smallarray_open(value_smallarray); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + +(* HOW CAN ARRAY OF CONST VAR PARAMETERS BE TESTED? + clear_globals; + clear_values; + value_u8bit := RESULT_U8BIT; + value_ptr := RESULT_PCHAR; + value_s64bit := RESULT_S64BIT; + value_smallstring := RESULT_SMALLSTRING; + value_class := tclass1.create; + value_boolean := RESULT_BOOLEAN; + value_char := RESULT_CHAR; + value_s64real:=RESULT_S64REAL; + proc_var_smallarray_var_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,value_boolean,value_class]); + + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if global_char <> RESULT_CHAR then + failed := true; + if global_boolean <> RESULT_BOOLEAN then + failed:=true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed := true; + if global_bigstring <> RESULT_SMALLSTRING then + failed := true; + if global_ptr <> value_ptr then + failed := true; +{ if value_class <> global_class then + failed := true;!!!!!!!!!!!!!!!!!!!!} + if global_s64bit <> RESULT_S64BIT then + failed := true; + if assigned(value_class) then + value_class.destroy; + global_u8bit := 0; + proc_var_smallarray_const_2([]); + if global_u8bit <> RESULT_U8BIT then + failed := true; +*) + + + if failed then + fail + else + WriteLn('Passed!'); + + {***************************** MIXED TESTS *******************************} + clear_globals; + clear_values; + failed:=false; + + write('Var parameter test (src : LOC_REFERENCE (orddef)))...'); + proc_var_s32bit_mixed(RESULT_U8BIT, global_s32bit, RESULT_U8BIT); + if global_s32bit <> RESULT_S32BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_s64bit_mixed(RESULT_U8BIT, global_s64bit, RESULT_U8BIT); + if global_s64bit <> RESULT_S64BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_u8bit_mixed(RESULT_U8BIT, global_u8bit, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + write('Var parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + proc_var_smallrecord_mixed(RESULT_U8BIT,value_smallrec, RESULT_U8BIT); + if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_largerecord_mixed(RESULT_U8BIT, value_largerec, RESULT_U8BIT); + if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + write('var parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + proc_var_smallset_mixed(RESULT_U8BIT, value_smallset, RESULT_U8BIT); + if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_largeset_mixed(RESULT_U8BIT, value_largeset, RESULT_U8BIT); + if not ('I' in value_largeset) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + write('var parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + proc_var_smallstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT); + if value_smallstring <> RESULT_SMALLSTRING then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_bigstring_mixed(RESULT_U8BIT, value_bigstring,RESULT_U8BIT); + if value_bigstring <> RESULT_BIGSTRING then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_openstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT); + if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + + write('Var parameter test (src : LOC_REFERENCE (formaldef)))...'); + clear_globals; + clear_values; + failed:=false; + + proc_var_formaldef_array_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + write('Var parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_var_smallarray_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + + + clear_globals; + clear_values; + + proc_var_smallarray_open_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + +end. + + +{ $Log$ - Revision 1.4 2002-09-22 09:08:41 carl - * gets64bit was not returning an int64! - - Revision 1.3 2002/09/07 15:40:55 peter - * old logs removed and tabs fixed - - Revision 1.2 2002/05/13 13:45:38 peter - * updated to compile tests with kylix - - Revision 1.1 2002/04/13 17:51:00 carl - + var parameter passing for different calling conventions - - -} + Revision 1.5 2003-04-22 10:24:29 florian + * fixed defines for powerpc + + Revision 1.4 2002/09/22 09:08:41 carl + * gets64bit was not returning an int64! + + Revision 1.3 2002/09/07 15:40:55 peter + * old logs removed and tabs fixed + + Revision 1.2 2002/05/13 13:45:38 peter + * updated to compile tests with kylix + + Revision 1.1 2002/04/13 17:51:00 carl + + var parameter passing for different calling conventions + + +} diff --git a/tests/test/cg/tcalvar8.pp b/tests/test/cg/tcalvar8.pp index c635758a30..2d101aeafc 100644 --- a/tests/test/cg/tcalvar8.pp +++ b/tests/test/cg/tcalvar8.pp @@ -1,839 +1,841 @@ -{****************************************************************} -{ 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 } -{ (var parameters with stdcall calling convention) } -{****************************************************************} -program tcalvar8; -{$ifdef fpc} - {$mode objfpc} - {$INLINE ON} -{$endif} -{$R+} -{$P-} -{$V+} - -{$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; - {$endif} - {$ifdef cpui386} - 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 -{$ifdef fpc} - pbytearr=^byte; -{$else} - pbytearr=^tbytearr; - tbytearr=array[0..$fffffff] of byte; -{$endif} - - tclass1 = class - end; - - 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_s64bit : int64; - global_s32real : single; - global_s64real : double; - global_ptr : pchar; - global_proc : tprocedure; - global_class : tclass1; - global_bigstring : shortstring; - global_boolean : boolean; - global_char : char; - value_u8bit : byte; - value_u16bit : word; - value_s32bit : longint; - value_s64bit : int64; - value_s32real : single; - value_s64real : double; - value_proc : tprocedure; - value_ptr : pchar; - value_class : tclass1; - 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_s64bit := 0; - global_s32real := 0.0; - global_s64real := 0.0; - global_ptr := nil; - global_proc := nil; - global_class := nil; - global_bigstring := ''; - global_boolean := false; - global_char := #0; - end; - - - procedure clear_values; - begin - value_u8bit := 0; - value_u16bit := 0; - value_s32bit := 0; - value_s64bit := 0; - value_s32real := 0.0; - value_s64real := 0.0; - value_proc := nil; - value_ptr := nil; - value_class := 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; - end; - - - procedure testprocedure; - begin - end; - - function getu8bit : byte; - begin - getu8bit:=RESULT_U8BIT; - end; - - function getu16bit: word; - begin - getu16bit:=RESULT_U16BIT; - end; - - function gets32bit: longint; - begin - gets32bit:=RESULT_S32BIT; - end; - - function gets64bit: int64; - begin - gets64bit:=RESULT_S64BIT; - end; - - function gets32real: single; - begin - gets32real:=RESULT_S32REAL; - end; - - function gets64real: double; - begin - gets64real:=RESULT_S64REAL; - end; - - {************************************************************************} - { VAR PARAMETERS } - {************************************************************************} - procedure proc_var_s32bit(var v : longint);stdcall; - begin - v:=RESULT_S32BIT; - end; - - procedure proc_var_s64bit(var v: int64);stdcall; - begin - v:=RESULT_S64BIT; - end; - - - procedure proc_var_u8bit(var v: byte);stdcall; - begin - v:=RESULT_U8BIT; - end; - - procedure proc_var_smallrecord(var smallrec : tsmallrecord);stdcall; - begin - smallrec.b := RESULT_U8BIT; - smallrec.w := RESULT_U16BIT; - end; - - - procedure proc_var_largerecord(var largerec : tlargerecord);stdcall; - begin - largerec.b[1] := RESULT_U8BIT; - largerec.b[2] := RESULT_U8BIT; - end; - - - procedure proc_var_smallset(var smallset : tsmallset);stdcall; - begin - smallset := [A_A,A_D]; - end; - - - procedure proc_var_largeset(var largeset : tlargeset);stdcall; - begin - largeset:= largeset + ['I']; - end; - - - procedure proc_var_smallstring(var s:tsmallstring);stdcall; - begin - s:=RESULT_SMALLSTRING; - end; - - - procedure proc_var_bigstring(var s:shortstring);stdcall; - begin - s:=RESULT_BIGSTRING; - end; - - - procedure proc_var_openstring(var s: OpenString);stdcall; - begin - global_u8bit := high(s); - s:=RESULT_SMALLSTRING; - end; - - procedure proc_var_smallarray(var arr : tsmallarray);stdcall; - begin - arr[SMALL_INDEX] := RESULT_U8BIT; - arr[1] := RESULT_U8BIT; - end; - - procedure proc_var_smallarray_open(var arr : array of byte);stdcall; - begin - arr[high(arr)] := RESULT_U8BIT; - arr[low(arr)] := RESULT_U8BIT; - end; - - procedure proc_var_smallarray_const_1(var arr : array of const);stdcall; - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : arr[i].vinteger := RESULT_U8BIT; - vtBoolean : arr[i].vboolean := RESULT_BOOLEAN; - else - RunError(255); - end; - end; {endfor} - end; - - - procedure proc_var_smallarray_const_2(var arr : array of const);stdcall; - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_formaldef_array(var buf);stdcall; - var - p: pbytearr; - begin - { array is indexed from 1 } - p := @buf; - p[SMALL_INDEX-1] := RESULT_U8BIT; - p[0] := RESULT_U8BIT; - end; - - -procedure proc_var_formaldef_string(var buf);stdcall; - var - p: pbytearr; - begin - { array is indexed from 1 } - p := @buf; - p[SMALL_INDEX-1] := RESULT_U8BIT; - p[0] := RESULT_U8BIT; - end; - - - {************************************************************************} - { MIXED VAR PARAMETERS } - {************************************************************************} - procedure proc_var_s32bit_mixed(b1 : byte;var v : longint; b2: byte);stdcall; - begin - v:=RESULT_S32BIT; - value_u8bit := RESULT_U8BIT; - end; - - procedure proc_var_s64bit_mixed(b1 : byte;var v: int64; b2: byte);stdcall; - begin - v:=RESULT_S64BIT; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_u8bit_mixed(b1 : byte;var v: byte; b2: byte);stdcall; - begin - v:=RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - - procedure proc_var_smallrecord_mixed(b1 : byte; var smallrec : tsmallrecord; b2: byte);stdcall; - begin - smallrec.b := RESULT_U8BIT; - smallrec.w := RESULT_U16BIT; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_largerecord_mixed(b1 : byte; var largerec : tlargerecord; b2: byte);stdcall; - begin - largerec.b[1] := RESULT_U8BIT; - largerec.b[2] := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_smallset_mixed(b1 : byte; var smallset : tsmallset; b2: byte);stdcall; - begin - smallset := [A_A,A_D]; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_largeset_mixed(b1 : byte; var largeset : tlargeset; b2: byte);stdcall; - begin - largeset:= largeset + ['I']; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_smallstring_mixed(b1 : byte; var s:tsmallstring; b2: byte);stdcall; - begin - s:=RESULT_SMALLSTRING; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_bigstring_mixed(b1 : byte; var s:shortstring; b2: byte);stdcall; - begin - s:=RESULT_BIGSTRING; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_openstring_mixed(b1 : byte; var s: OpenString; b2: byte);stdcall; - begin - global_u8bit := high(s); - s:=RESULT_SMALLSTRING; - value_u8bit := RESULT_U8BIT; - end; - - procedure proc_var_smallarray_mixed(b1 : byte; var arr : tsmallarray; b2: byte);stdcall; - begin - arr[SMALL_INDEX] := RESULT_U8BIT; - arr[1] := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - - procedure proc_var_smallarray_open_mixed(b1 : byte; var arr : array of byte; b2: byte);stdcall; - begin - arr[high(arr)] := RESULT_U8BIT; - arr[low(arr)] := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - - procedure proc_var_smallarray_const_1_mixed(b1 : byte; var arr : array of const; b2: byte);stdcall; - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : arr[i].vinteger := RESULT_U8BIT; - vtBoolean : arr[i].vboolean := RESULT_BOOLEAN; - else - RunError(255); - end; - end; {endfor} - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_smallarray_const_2_mixed(b1 : byte; var arr : array of const; b2: byte);stdcall; - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; -end; - - - procedure proc_var_formaldef_array_mixed(b1 : byte; var buf; b2: byte);stdcall; - var - p: pbytearr; - begin - { array is indexed from 1 } - p := @buf; - p[SMALL_INDEX-1] := RESULT_U8BIT; - p[0] := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - - -procedure proc_var_formaldef_string_mixed(b1 : byte; var buf; b2: byte);stdcall; - var - p: pbytearr; - begin - { array is indexed from 1 } - p := @buf; - p[SMALL_INDEX-1] := RESULT_U8BIT; - p[0] := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - -var - failed: boolean; - pp : ^pchar; -begin - {***************************** NORMAL TESTS *******************************} - clear_globals; - clear_values; - failed:=false; - - write('Var parameter test (src : LOC_REFERENCE (orddef)))...'); - proc_var_s32bit(global_s32bit); - if global_s32bit <> RESULT_S32BIT then - failed:=true; - - clear_globals; - clear_values; - proc_var_s64bit(global_s64bit); - if global_s64bit <> RESULT_S64BIT then - failed:=true; - - clear_globals; - clear_values; - proc_var_u8bit(global_u8bit); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - - - if failed then - fail - else - WriteLn('Passed!'); - - write('Var parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - proc_var_smallrecord(value_smallrec); - if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then - failed := true; - - clear_globals; - clear_values; - proc_var_largerecord(value_largerec); - if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - write('var parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - proc_var_smallset(value_smallset); - if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then - failed := true; - - clear_globals; - clear_values; - proc_var_largeset(value_largeset); - if not ('I' in value_largeset) then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - write('var parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - proc_var_smallstring(value_smallstring); - if value_smallstring <> RESULT_SMALLSTRING then - failed := true; - - clear_globals; - clear_values; - proc_var_bigstring(value_bigstring); - if value_bigstring <> RESULT_BIGSTRING then - failed := true; - - clear_globals; - clear_values; - proc_var_openstring(value_smallstring); - if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - - write('Var parameter test (src : LOC_REFERENCE (formaldef)))...'); - clear_globals; - clear_values; - failed:=false; - - proc_var_formaldef_array(value_smallarray); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - write('Var parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_var_smallarray(value_smallarray); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - - - - clear_globals; - clear_values; - - proc_var_smallarray_open(value_smallarray); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - -(* HOW CAN ARRAY OF CONST VAR PARAMETERS BE TESTED? - clear_globals; - clear_values; - value_u8bit := RESULT_U8BIT; - value_ptr := RESULT_PCHAR; - value_s64bit := RESULT_S64BIT; - value_smallstring := RESULT_SMALLSTRING; - value_class := tclass1.create; - value_boolean := RESULT_BOOLEAN; - value_char := RESULT_CHAR; - value_s64real:=RESULT_S64REAL; - proc_var_smallarray_var_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,value_boolean,value_class]); - - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if global_char <> RESULT_CHAR then - failed := true; - if global_boolean <> RESULT_BOOLEAN then - failed:=true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed := true; - if global_bigstring <> RESULT_SMALLSTRING then - failed := true; - if global_ptr <> value_ptr then - failed := true; -{ if value_class <> global_class then - failed := true;!!!!!!!!!!!!!!!!!!!!} - if global_s64bit <> RESULT_S64BIT then - failed := true; - if assigned(value_class) then - value_class.destroy; - global_u8bit := 0; - proc_var_smallarray_const_2([]); - if global_u8bit <> RESULT_U8BIT then - failed := true; -*) - - - if failed then - fail - else - WriteLn('Passed!'); - - {***************************** MIXED TESTS *******************************} - clear_globals; - clear_values; - failed:=false; - - write('Var parameter test (src : LOC_REFERENCE (orddef)))...'); - proc_var_s32bit_mixed(RESULT_U8BIT, global_s32bit, RESULT_U8BIT); - if global_s32bit <> RESULT_S32BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_s64bit_mixed(RESULT_U8BIT, global_s64bit, RESULT_U8BIT); - if global_s64bit <> RESULT_S64BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_u8bit_mixed(RESULT_U8BIT, global_u8bit, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - write('Var parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - proc_var_smallrecord_mixed(RESULT_U8BIT,value_smallrec, RESULT_U8BIT); - if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_largerecord_mixed(RESULT_U8BIT, value_largerec, RESULT_U8BIT); - if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - write('var parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - proc_var_smallset_mixed(RESULT_U8BIT, value_smallset, RESULT_U8BIT); - if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_largeset_mixed(RESULT_U8BIT, value_largeset, RESULT_U8BIT); - if not ('I' in value_largeset) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - write('var parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - proc_var_smallstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT); - if value_smallstring <> RESULT_SMALLSTRING then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_bigstring_mixed(RESULT_U8BIT, value_bigstring,RESULT_U8BIT); - if value_bigstring <> RESULT_BIGSTRING then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_openstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT); - if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - - write('Var parameter test (src : LOC_REFERENCE (formaldef)))...'); - clear_globals; - clear_values; - failed:=false; - - proc_var_formaldef_array_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - write('Var parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_var_smallarray_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - - - clear_globals; - clear_values; - - proc_var_smallarray_open_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - if value_u8bit <> RESULT_U8BIT 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 } +{ (var parameters with stdcall calling convention) } +{****************************************************************} +program tcalvar8; +{$ifdef fpc} + {$mode objfpc} + {$INLINE ON} +{$endif} +{$R+} +{$P-} +{$V+} + +{$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 +{$ifdef fpc} + pbytearr=^byte; +{$else} + pbytearr=^tbytearr; + tbytearr=array[0..$fffffff] of byte; +{$endif} + + tclass1 = class + end; + + 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_s64bit : int64; + global_s32real : single; + global_s64real : double; + global_ptr : pchar; + global_proc : tprocedure; + global_class : tclass1; + global_bigstring : shortstring; + global_boolean : boolean; + global_char : char; + value_u8bit : byte; + value_u16bit : word; + value_s32bit : longint; + value_s64bit : int64; + value_s32real : single; + value_s64real : double; + value_proc : tprocedure; + value_ptr : pchar; + value_class : tclass1; + 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_s64bit := 0; + global_s32real := 0.0; + global_s64real := 0.0; + global_ptr := nil; + global_proc := nil; + global_class := nil; + global_bigstring := ''; + global_boolean := false; + global_char := #0; + end; + + + procedure clear_values; + begin + value_u8bit := 0; + value_u16bit := 0; + value_s32bit := 0; + value_s64bit := 0; + value_s32real := 0.0; + value_s64real := 0.0; + value_proc := nil; + value_ptr := nil; + value_class := 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; + end; + + + procedure testprocedure; + begin + end; + + function getu8bit : byte; + begin + getu8bit:=RESULT_U8BIT; + end; + + function getu16bit: word; + begin + getu16bit:=RESULT_U16BIT; + end; + + function gets32bit: longint; + begin + gets32bit:=RESULT_S32BIT; + end; + + function gets64bit: int64; + begin + gets64bit:=RESULT_S64BIT; + end; + + function gets32real: single; + begin + gets32real:=RESULT_S32REAL; + end; + + function gets64real: double; + begin + gets64real:=RESULT_S64REAL; + end; + + {************************************************************************} + { VAR PARAMETERS } + {************************************************************************} + procedure proc_var_s32bit(var v : longint);stdcall; + begin + v:=RESULT_S32BIT; + end; + + procedure proc_var_s64bit(var v: int64);stdcall; + begin + v:=RESULT_S64BIT; + end; + + + procedure proc_var_u8bit(var v: byte);stdcall; + begin + v:=RESULT_U8BIT; + end; + + procedure proc_var_smallrecord(var smallrec : tsmallrecord);stdcall; + begin + smallrec.b := RESULT_U8BIT; + smallrec.w := RESULT_U16BIT; + end; + + + procedure proc_var_largerecord(var largerec : tlargerecord);stdcall; + begin + largerec.b[1] := RESULT_U8BIT; + largerec.b[2] := RESULT_U8BIT; + end; + + + procedure proc_var_smallset(var smallset : tsmallset);stdcall; + begin + smallset := [A_A,A_D]; + end; + + + procedure proc_var_largeset(var largeset : tlargeset);stdcall; + begin + largeset:= largeset + ['I']; + end; + + + procedure proc_var_smallstring(var s:tsmallstring);stdcall; + begin + s:=RESULT_SMALLSTRING; + end; + + + procedure proc_var_bigstring(var s:shortstring);stdcall; + begin + s:=RESULT_BIGSTRING; + end; + + + procedure proc_var_openstring(var s: OpenString);stdcall; + begin + global_u8bit := high(s); + s:=RESULT_SMALLSTRING; + end; + + procedure proc_var_smallarray(var arr : tsmallarray);stdcall; + begin + arr[SMALL_INDEX] := RESULT_U8BIT; + arr[1] := RESULT_U8BIT; + end; + + procedure proc_var_smallarray_open(var arr : array of byte);stdcall; + begin + arr[high(arr)] := RESULT_U8BIT; + arr[low(arr)] := RESULT_U8BIT; + end; + + procedure proc_var_smallarray_const_1(var arr : array of const);stdcall; + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : arr[i].vinteger := RESULT_U8BIT; + vtBoolean : arr[i].vboolean := RESULT_BOOLEAN; + else + RunError(255); + end; + end; {endfor} + end; + + + procedure proc_var_smallarray_const_2(var arr : array of const);stdcall; + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_formaldef_array(var buf);stdcall; + var + p: pbytearr; + begin + { array is indexed from 1 } + p := @buf; + p[SMALL_INDEX-1] := RESULT_U8BIT; + p[0] := RESULT_U8BIT; + end; + + +procedure proc_var_formaldef_string(var buf);stdcall; + var + p: pbytearr; + begin + { array is indexed from 1 } + p := @buf; + p[SMALL_INDEX-1] := RESULT_U8BIT; + p[0] := RESULT_U8BIT; + end; + + + {************************************************************************} + { MIXED VAR PARAMETERS } + {************************************************************************} + procedure proc_var_s32bit_mixed(b1 : byte;var v : longint; b2: byte);stdcall; + begin + v:=RESULT_S32BIT; + value_u8bit := RESULT_U8BIT; + end; + + procedure proc_var_s64bit_mixed(b1 : byte;var v: int64; b2: byte);stdcall; + begin + v:=RESULT_S64BIT; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_u8bit_mixed(b1 : byte;var v: byte; b2: byte);stdcall; + begin + v:=RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + + procedure proc_var_smallrecord_mixed(b1 : byte; var smallrec : tsmallrecord; b2: byte);stdcall; + begin + smallrec.b := RESULT_U8BIT; + smallrec.w := RESULT_U16BIT; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_largerecord_mixed(b1 : byte; var largerec : tlargerecord; b2: byte);stdcall; + begin + largerec.b[1] := RESULT_U8BIT; + largerec.b[2] := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_smallset_mixed(b1 : byte; var smallset : tsmallset; b2: byte);stdcall; + begin + smallset := [A_A,A_D]; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_largeset_mixed(b1 : byte; var largeset : tlargeset; b2: byte);stdcall; + begin + largeset:= largeset + ['I']; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_smallstring_mixed(b1 : byte; var s:tsmallstring; b2: byte);stdcall; + begin + s:=RESULT_SMALLSTRING; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_bigstring_mixed(b1 : byte; var s:shortstring; b2: byte);stdcall; + begin + s:=RESULT_BIGSTRING; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_openstring_mixed(b1 : byte; var s: OpenString; b2: byte);stdcall; + begin + global_u8bit := high(s); + s:=RESULT_SMALLSTRING; + value_u8bit := RESULT_U8BIT; + end; + + procedure proc_var_smallarray_mixed(b1 : byte; var arr : tsmallarray; b2: byte);stdcall; + begin + arr[SMALL_INDEX] := RESULT_U8BIT; + arr[1] := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + + procedure proc_var_smallarray_open_mixed(b1 : byte; var arr : array of byte; b2: byte);stdcall; + begin + arr[high(arr)] := RESULT_U8BIT; + arr[low(arr)] := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + + procedure proc_var_smallarray_const_1_mixed(b1 : byte; var arr : array of const; b2: byte);stdcall; + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : arr[i].vinteger := RESULT_U8BIT; + vtBoolean : arr[i].vboolean := RESULT_BOOLEAN; + else + RunError(255); + end; + end; {endfor} + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_smallarray_const_2_mixed(b1 : byte; var arr : array of const; b2: byte);stdcall; + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; +end; + + + procedure proc_var_formaldef_array_mixed(b1 : byte; var buf; b2: byte);stdcall; + var + p: pbytearr; + begin + { array is indexed from 1 } + p := @buf; + p[SMALL_INDEX-1] := RESULT_U8BIT; + p[0] := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + + +procedure proc_var_formaldef_string_mixed(b1 : byte; var buf; b2: byte);stdcall; + var + p: pbytearr; + begin + { array is indexed from 1 } + p := @buf; + p[SMALL_INDEX-1] := RESULT_U8BIT; + p[0] := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + +var + failed: boolean; + pp : ^pchar; +begin + {***************************** NORMAL TESTS *******************************} + clear_globals; + clear_values; + failed:=false; + + write('Var parameter test (src : LOC_REFERENCE (orddef)))...'); + proc_var_s32bit(global_s32bit); + if global_s32bit <> RESULT_S32BIT then + failed:=true; + + clear_globals; + clear_values; + proc_var_s64bit(global_s64bit); + if global_s64bit <> RESULT_S64BIT then + failed:=true; + + clear_globals; + clear_values; + proc_var_u8bit(global_u8bit); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + + + if failed then + fail + else + WriteLn('Passed!'); + + write('Var parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + proc_var_smallrecord(value_smallrec); + if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then + failed := true; + + clear_globals; + clear_values; + proc_var_largerecord(value_largerec); + if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + write('var parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + proc_var_smallset(value_smallset); + if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then + failed := true; + + clear_globals; + clear_values; + proc_var_largeset(value_largeset); + if not ('I' in value_largeset) then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + write('var parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + proc_var_smallstring(value_smallstring); + if value_smallstring <> RESULT_SMALLSTRING then + failed := true; + + clear_globals; + clear_values; + proc_var_bigstring(value_bigstring); + if value_bigstring <> RESULT_BIGSTRING then + failed := true; + + clear_globals; + clear_values; + proc_var_openstring(value_smallstring); + if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + + write('Var parameter test (src : LOC_REFERENCE (formaldef)))...'); + clear_globals; + clear_values; + failed:=false; + + proc_var_formaldef_array(value_smallarray); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + write('Var parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_var_smallarray(value_smallarray); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + + + + clear_globals; + clear_values; + + proc_var_smallarray_open(value_smallarray); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + +(* HOW CAN ARRAY OF CONST VAR PARAMETERS BE TESTED? + clear_globals; + clear_values; + value_u8bit := RESULT_U8BIT; + value_ptr := RESULT_PCHAR; + value_s64bit := RESULT_S64BIT; + value_smallstring := RESULT_SMALLSTRING; + value_class := tclass1.create; + value_boolean := RESULT_BOOLEAN; + value_char := RESULT_CHAR; + value_s64real:=RESULT_S64REAL; + proc_var_smallarray_var_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,value_boolean,value_class]); + + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if global_char <> RESULT_CHAR then + failed := true; + if global_boolean <> RESULT_BOOLEAN then + failed:=true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed := true; + if global_bigstring <> RESULT_SMALLSTRING then + failed := true; + if global_ptr <> value_ptr then + failed := true; +{ if value_class <> global_class then + failed := true;!!!!!!!!!!!!!!!!!!!!} + if global_s64bit <> RESULT_S64BIT then + failed := true; + if assigned(value_class) then + value_class.destroy; + global_u8bit := 0; + proc_var_smallarray_const_2([]); + if global_u8bit <> RESULT_U8BIT then + failed := true; +*) + + + if failed then + fail + else + WriteLn('Passed!'); + + {***************************** MIXED TESTS *******************************} + clear_globals; + clear_values; + failed:=false; + + write('Var parameter test (src : LOC_REFERENCE (orddef)))...'); + proc_var_s32bit_mixed(RESULT_U8BIT, global_s32bit, RESULT_U8BIT); + if global_s32bit <> RESULT_S32BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_s64bit_mixed(RESULT_U8BIT, global_s64bit, RESULT_U8BIT); + if global_s64bit <> RESULT_S64BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_u8bit_mixed(RESULT_U8BIT, global_u8bit, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + write('Var parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + proc_var_smallrecord_mixed(RESULT_U8BIT,value_smallrec, RESULT_U8BIT); + if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_largerecord_mixed(RESULT_U8BIT, value_largerec, RESULT_U8BIT); + if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + write('var parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + proc_var_smallset_mixed(RESULT_U8BIT, value_smallset, RESULT_U8BIT); + if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_largeset_mixed(RESULT_U8BIT, value_largeset, RESULT_U8BIT); + if not ('I' in value_largeset) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + write('var parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + proc_var_smallstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT); + if value_smallstring <> RESULT_SMALLSTRING then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_bigstring_mixed(RESULT_U8BIT, value_bigstring,RESULT_U8BIT); + if value_bigstring <> RESULT_BIGSTRING then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_openstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT); + if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + + write('Var parameter test (src : LOC_REFERENCE (formaldef)))...'); + clear_globals; + clear_values; + failed:=false; + + proc_var_formaldef_array_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + write('Var parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_var_smallarray_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + + + clear_globals; + clear_values; + + proc_var_smallarray_open_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + +end. + + +{ $Log$ - Revision 1.4 2002-09-22 09:08:41 carl - * gets64bit was not returning an int64! - - Revision 1.3 2002/09/07 15:40:55 peter - * old logs removed and tabs fixed - - Revision 1.2 2002/05/13 13:45:38 peter - * updated to compile tests with kylix - - Revision 1.1 2002/04/13 17:51:00 carl - + var parameter passing for different calling conventions - - -} + Revision 1.5 2003-04-22 10:24:29 florian + * fixed defines for powerpc + + Revision 1.4 2002/09/22 09:08:41 carl + * gets64bit was not returning an int64! + + Revision 1.3 2002/09/07 15:40:55 peter + * old logs removed and tabs fixed + + Revision 1.2 2002/05/13 13:45:38 peter + * updated to compile tests with kylix + + Revision 1.1 2002/04/13 17:51:00 carl + + var parameter passing for different calling conventions + + +} diff --git a/tests/test/cg/tcalvar9.pp b/tests/test/cg/tcalvar9.pp index 1b98fac76b..4b2a4c3582 100644 --- a/tests/test/cg/tcalvar9.pp +++ b/tests/test/cg/tcalvar9.pp @@ -1,840 +1,842 @@ -{****************************************************************} -{ 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 } -{ (var parameters with saveregs calling convention) } -{****************************************************************} -program tcalvar9; -{$ifdef fpc} - {$mode objfpc} - {$INLINE ON} -{$endif} -{$R+} -{$P-} -{$V+} - -{$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; - {$endif} - {$ifdef cpui386} - 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 -{$ifdef fpc} - pbytearr=^byte; -{$else} - pbytearr=^tbytearr; - tbytearr=array[0..$fffffff] of byte; -{$endif} - - tclass1 = class - end; - - 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_s64bit : int64; - global_s32real : single; - global_s64real : double; - global_ptr : pchar; - global_proc : tprocedure; - global_class : tclass1; - global_bigstring : shortstring; - global_boolean : boolean; - global_char : char; - value_u8bit : byte; - value_u16bit : word; - value_s32bit : longint; - value_s64bit : int64; - value_s32real : single; - value_s64real : double; - value_proc : tprocedure; - value_ptr : pchar; - value_class : tclass1; - 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_s64bit := 0; - global_s32real := 0.0; - global_s64real := 0.0; - global_ptr := nil; - global_proc := nil; - global_class := nil; - global_bigstring := ''; - global_boolean := false; - global_char := #0; - end; - - - procedure clear_values; - begin - value_u8bit := 0; - value_u16bit := 0; - value_s32bit := 0; - value_s64bit := 0; - value_s32real := 0.0; - value_s64real := 0.0; - value_proc := nil; - value_ptr := nil; - value_class := 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; - end; - - - procedure testprocedure; - begin - end; - - function getu8bit : byte; - begin - getu8bit:=RESULT_U8BIT; - end; - - function getu16bit: word; - begin - getu16bit:=RESULT_U16BIT; - end; - - function gets32bit: longint; - begin - gets32bit:=RESULT_S32BIT; - end; - - function gets64bit: int64; - begin - gets64bit:=RESULT_S64BIT; - end; - - - function gets32real: single; - begin - gets32real:=RESULT_S32REAL; - end; - - function gets64real: double; - begin - gets64real:=RESULT_S64REAL; - end; - - {************************************************************************} - { VAR PARAMETERS } - {************************************************************************} - procedure proc_var_s32bit(var v : longint);saveregisters; - begin - v:=RESULT_S32BIT; - end; - - procedure proc_var_s64bit(var v: int64);saveregisters; - begin - v:=RESULT_S64BIT; - end; - - - procedure proc_var_u8bit(var v: byte);saveregisters; - begin - v:=RESULT_U8BIT; - end; - - procedure proc_var_smallrecord(var smallrec : tsmallrecord);saveregisters; - begin - smallrec.b := RESULT_U8BIT; - smallrec.w := RESULT_U16BIT; - end; - - - procedure proc_var_largerecord(var largerec : tlargerecord);saveregisters; - begin - largerec.b[1] := RESULT_U8BIT; - largerec.b[2] := RESULT_U8BIT; - end; - - - procedure proc_var_smallset(var smallset : tsmallset);saveregisters; - begin - smallset := [A_A,A_D]; - end; - - - procedure proc_var_largeset(var largeset : tlargeset);saveregisters; - begin - largeset:= largeset + ['I']; - end; - - - procedure proc_var_smallstring(var s:tsmallstring);saveregisters; - begin - s:=RESULT_SMALLSTRING; - end; - - - procedure proc_var_bigstring(var s:shortstring);saveregisters; - begin - s:=RESULT_BIGSTRING; - end; - - - procedure proc_var_openstring(var s: OpenString);saveregisters; - begin - global_u8bit := high(s); - s:=RESULT_SMALLSTRING; - end; - - procedure proc_var_smallarray(var arr : tsmallarray);saveregisters; - begin - arr[SMALL_INDEX] := RESULT_U8BIT; - arr[1] := RESULT_U8BIT; - end; - - procedure proc_var_smallarray_open(var arr : array of byte);saveregisters; - begin - arr[high(arr)] := RESULT_U8BIT; - arr[low(arr)] := RESULT_U8BIT; - end; - - procedure proc_var_smallarray_const_1(var arr : array of const);saveregisters; - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : arr[i].vinteger := RESULT_U8BIT; - vtBoolean : arr[i].vboolean := RESULT_BOOLEAN; - else - RunError(255); - end; - end; {endfor} - end; - - - procedure proc_var_smallarray_const_2(var arr : array of const);saveregisters; - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_formaldef_array(var buf);saveregisters; - var - p: pbytearr; - begin - { array is indexed from 1 } - p := @buf; - p[SMALL_INDEX-1] := RESULT_U8BIT; - p[0] := RESULT_U8BIT; - end; - - -procedure proc_var_formaldef_string(var buf);saveregisters; - var - p: pbytearr; - begin - { array is indexed from 1 } - p := @buf; - p[SMALL_INDEX-1] := RESULT_U8BIT; - p[0] := RESULT_U8BIT; - end; - - - {************************************************************************} - { MIXED VAR PARAMETERS } - {************************************************************************} - procedure proc_var_s32bit_mixed(b1 : byte;var v : longint; b2: byte);saveregisters; - begin - v:=RESULT_S32BIT; - value_u8bit := RESULT_U8BIT; - end; - - procedure proc_var_s64bit_mixed(b1 : byte;var v: int64; b2: byte);saveregisters; - begin - v:=RESULT_S64BIT; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_u8bit_mixed(b1 : byte;var v: byte; b2: byte);saveregisters; - begin - v:=RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - - procedure proc_var_smallrecord_mixed(b1 : byte; var smallrec : tsmallrecord; b2: byte);saveregisters; - begin - smallrec.b := RESULT_U8BIT; - smallrec.w := RESULT_U16BIT; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_largerecord_mixed(b1 : byte; var largerec : tlargerecord; b2: byte);saveregisters; - begin - largerec.b[1] := RESULT_U8BIT; - largerec.b[2] := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_smallset_mixed(b1 : byte; var smallset : tsmallset; b2: byte);saveregisters; - begin - smallset := [A_A,A_D]; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_largeset_mixed(b1 : byte; var largeset : tlargeset; b2: byte);saveregisters; - begin - largeset:= largeset + ['I']; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_smallstring_mixed(b1 : byte; var s:tsmallstring; b2: byte);saveregisters; - begin - s:=RESULT_SMALLSTRING; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_bigstring_mixed(b1 : byte; var s:shortstring; b2: byte);saveregisters; - begin - s:=RESULT_BIGSTRING; - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_openstring_mixed(b1 : byte; var s: OpenString; b2: byte);saveregisters; - begin - global_u8bit := high(s); - s:=RESULT_SMALLSTRING; - value_u8bit := RESULT_U8BIT; - end; - - procedure proc_var_smallarray_mixed(b1 : byte; var arr : tsmallarray; b2: byte);saveregisters; - begin - arr[SMALL_INDEX] := RESULT_U8BIT; - arr[1] := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - - procedure proc_var_smallarray_open_mixed(b1 : byte; var arr : array of byte; b2: byte);saveregisters; - begin - arr[high(arr)] := RESULT_U8BIT; - arr[low(arr)] := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - - procedure proc_var_smallarray_const_1_mixed(b1 : byte; var arr : array of const; b2: byte);saveregisters; - var - i: integer; - begin - for i:=0 to high(arr) do - begin - case arr[i].vtype of - vtInteger : arr[i].vinteger := RESULT_U8BIT; - vtBoolean : arr[i].vboolean := RESULT_BOOLEAN; - else - RunError(255); - end; - end; {endfor} - value_u8bit := RESULT_U8BIT; - end; - - - procedure proc_var_smallarray_const_2_mixed(b1 : byte; var arr : array of const; b2: byte);saveregisters; - var - i: integer; - begin - if high(arr)<0 then - global_u8bit := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; -end; - - - procedure proc_var_formaldef_array_mixed(b1 : byte; var buf; b2: byte);saveregisters; - var - p: pbytearr; - begin - { array is indexed from 1 } - p := @buf; - p[SMALL_INDEX-1] := RESULT_U8BIT; - p[0] := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - - -procedure proc_var_formaldef_string_mixed(b1 : byte; var buf; b2: byte);saveregisters; - var - p: pbytearr; - begin - { array is indexed from 1 } - p := @buf; - p[SMALL_INDEX-1] := RESULT_U8BIT; - p[0] := RESULT_U8BIT; - value_u8bit := RESULT_U8BIT; - end; - -var - failed: boolean; - pp : ^pchar; -begin - {***************************** NORMAL TESTS *******************************} - clear_globals; - clear_values; - failed:=false; - - write('Var parameter test (src : LOC_REFERENCE (orddef)))...'); - proc_var_s32bit(global_s32bit); - if global_s32bit <> RESULT_S32BIT then - failed:=true; - - clear_globals; - clear_values; - proc_var_s64bit(global_s64bit); - if global_s64bit <> RESULT_S64BIT then - failed:=true; - - clear_globals; - clear_values; - proc_var_u8bit(global_u8bit); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - - - if failed then - fail - else - WriteLn('Passed!'); - - write('Var parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - proc_var_smallrecord(value_smallrec); - if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then - failed := true; - - clear_globals; - clear_values; - proc_var_largerecord(value_largerec); - if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - write('var parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - proc_var_smallset(value_smallset); - if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then - failed := true; - - clear_globals; - clear_values; - proc_var_largeset(value_largeset); - if not ('I' in value_largeset) then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - write('var parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - proc_var_smallstring(value_smallstring); - if value_smallstring <> RESULT_SMALLSTRING then - failed := true; - - clear_globals; - clear_values; - proc_var_bigstring(value_bigstring); - if value_bigstring <> RESULT_BIGSTRING then - failed := true; - - clear_globals; - clear_values; - proc_var_openstring(value_smallstring); - if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - - write('Var parameter test (src : LOC_REFERENCE (formaldef)))...'); - clear_globals; - clear_values; - failed:=false; - - proc_var_formaldef_array(value_smallarray); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - write('Var parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_var_smallarray(value_smallarray); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - - - - clear_globals; - clear_values; - - proc_var_smallarray_open(value_smallarray); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - -(* HOW CAN ARRAY OF CONST VAR PARAMETERS BE TESTED? - clear_globals; - clear_values; - value_u8bit := RESULT_U8BIT; - value_ptr := RESULT_PCHAR; - value_s64bit := RESULT_S64BIT; - value_smallstring := RESULT_SMALLSTRING; - value_class := tclass1.create; - value_boolean := RESULT_BOOLEAN; - value_char := RESULT_CHAR; - value_s64real:=RESULT_S64REAL; - proc_var_smallarray_var_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,value_boolean,value_class]); - - if global_u8bit <> RESULT_U8BIT then - failed := true; - - if global_char <> RESULT_CHAR then - failed := true; - if global_boolean <> RESULT_BOOLEAN then - failed:=true; - if trunc(global_s64real) <> trunc(RESULT_S64REAL) then - failed := true; - if global_bigstring <> RESULT_SMALLSTRING then - failed := true; - if global_ptr <> value_ptr then - failed := true; -{ if value_class <> global_class then - failed := true;!!!!!!!!!!!!!!!!!!!!} - if global_s64bit <> RESULT_S64BIT then - failed := true; - if assigned(value_class) then - value_class.destroy; - global_u8bit := 0; - proc_var_smallarray_const_2([]); - if global_u8bit <> RESULT_U8BIT then - failed := true; -*) - - - if failed then - fail - else - WriteLn('Passed!'); - - {***************************** MIXED TESTS *******************************} - clear_globals; - clear_values; - failed:=false; - - write('Var parameter test (src : LOC_REFERENCE (orddef)))...'); - proc_var_s32bit_mixed(RESULT_U8BIT, global_s32bit, RESULT_U8BIT); - if global_s32bit <> RESULT_S32BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_s64bit_mixed(RESULT_U8BIT, global_s64bit, RESULT_U8BIT); - if global_s64bit <> RESULT_S64BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_u8bit_mixed(RESULT_U8BIT, global_u8bit, RESULT_U8BIT); - if global_u8bit <> RESULT_U8BIT then - failed:=true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - write('Var parameter test (src : LOC_REFERENCE (recorddef)))...'); - clear_globals; - clear_values; - failed := false; - - proc_var_smallrecord_mixed(RESULT_U8BIT,value_smallrec, RESULT_U8BIT); - if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_largerecord_mixed(RESULT_U8BIT, value_largerec, RESULT_U8BIT); - if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - write('var parameter test (src : LOC_REFERENCE (setdef)))...'); - clear_globals; - clear_values; - failed := false; - - proc_var_smallset_mixed(RESULT_U8BIT, value_smallset, RESULT_U8BIT); - if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_largeset_mixed(RESULT_U8BIT, value_largeset, RESULT_U8BIT); - if not ('I' in value_largeset) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - if failed then - fail - else - WriteLn('Passed!'); - - - write('var parameter test (src : LOC_REFERENCE (stringdef)))...'); - clear_globals; - clear_values; - failed := false; - proc_var_smallstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT); - if value_smallstring <> RESULT_SMALLSTRING then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_bigstring_mixed(RESULT_U8BIT, value_bigstring,RESULT_U8BIT); - if value_bigstring <> RESULT_BIGSTRING then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - clear_globals; - clear_values; - proc_var_openstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT); - if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - - write('Var parameter test (src : LOC_REFERENCE (formaldef)))...'); - clear_globals; - clear_values; - failed:=false; - - proc_var_formaldef_array_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - - if failed then - fail - else - WriteLn('Passed!'); - - write('Var parameter test (src : LOC_REFERENCE (arraydef)))...'); - - clear_globals; - clear_values; - failed:=false; - - value_smallarray[SMALL_INDEX] := RESULT_U8BIT; - proc_var_smallarray_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - if value_u8bit <> RESULT_U8BIT then - failed := true; - - - - clear_globals; - clear_values; - - proc_var_smallarray_open_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); - if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then - failed := true; - if value_u8bit <> RESULT_U8BIT 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 } +{ (var parameters with saveregs calling convention) } +{****************************************************************} +program tcalvar9; +{$ifdef fpc} + {$mode objfpc} + {$INLINE ON} +{$endif} +{$R+} +{$P-} +{$V+} + +{$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 +{$ifdef fpc} + pbytearr=^byte; +{$else} + pbytearr=^tbytearr; + tbytearr=array[0..$fffffff] of byte; +{$endif} + + tclass1 = class + end; + + 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_s64bit : int64; + global_s32real : single; + global_s64real : double; + global_ptr : pchar; + global_proc : tprocedure; + global_class : tclass1; + global_bigstring : shortstring; + global_boolean : boolean; + global_char : char; + value_u8bit : byte; + value_u16bit : word; + value_s32bit : longint; + value_s64bit : int64; + value_s32real : single; + value_s64real : double; + value_proc : tprocedure; + value_ptr : pchar; + value_class : tclass1; + 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_s64bit := 0; + global_s32real := 0.0; + global_s64real := 0.0; + global_ptr := nil; + global_proc := nil; + global_class := nil; + global_bigstring := ''; + global_boolean := false; + global_char := #0; + end; + + + procedure clear_values; + begin + value_u8bit := 0; + value_u16bit := 0; + value_s32bit := 0; + value_s64bit := 0; + value_s32real := 0.0; + value_s64real := 0.0; + value_proc := nil; + value_ptr := nil; + value_class := 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; + end; + + + procedure testprocedure; + begin + end; + + function getu8bit : byte; + begin + getu8bit:=RESULT_U8BIT; + end; + + function getu16bit: word; + begin + getu16bit:=RESULT_U16BIT; + end; + + function gets32bit: longint; + begin + gets32bit:=RESULT_S32BIT; + end; + + function gets64bit: int64; + begin + gets64bit:=RESULT_S64BIT; + end; + + + function gets32real: single; + begin + gets32real:=RESULT_S32REAL; + end; + + function gets64real: double; + begin + gets64real:=RESULT_S64REAL; + end; + + {************************************************************************} + { VAR PARAMETERS } + {************************************************************************} + procedure proc_var_s32bit(var v : longint);saveregisters; + begin + v:=RESULT_S32BIT; + end; + + procedure proc_var_s64bit(var v: int64);saveregisters; + begin + v:=RESULT_S64BIT; + end; + + + procedure proc_var_u8bit(var v: byte);saveregisters; + begin + v:=RESULT_U8BIT; + end; + + procedure proc_var_smallrecord(var smallrec : tsmallrecord);saveregisters; + begin + smallrec.b := RESULT_U8BIT; + smallrec.w := RESULT_U16BIT; + end; + + + procedure proc_var_largerecord(var largerec : tlargerecord);saveregisters; + begin + largerec.b[1] := RESULT_U8BIT; + largerec.b[2] := RESULT_U8BIT; + end; + + + procedure proc_var_smallset(var smallset : tsmallset);saveregisters; + begin + smallset := [A_A,A_D]; + end; + + + procedure proc_var_largeset(var largeset : tlargeset);saveregisters; + begin + largeset:= largeset + ['I']; + end; + + + procedure proc_var_smallstring(var s:tsmallstring);saveregisters; + begin + s:=RESULT_SMALLSTRING; + end; + + + procedure proc_var_bigstring(var s:shortstring);saveregisters; + begin + s:=RESULT_BIGSTRING; + end; + + + procedure proc_var_openstring(var s: OpenString);saveregisters; + begin + global_u8bit := high(s); + s:=RESULT_SMALLSTRING; + end; + + procedure proc_var_smallarray(var arr : tsmallarray);saveregisters; + begin + arr[SMALL_INDEX] := RESULT_U8BIT; + arr[1] := RESULT_U8BIT; + end; + + procedure proc_var_smallarray_open(var arr : array of byte);saveregisters; + begin + arr[high(arr)] := RESULT_U8BIT; + arr[low(arr)] := RESULT_U8BIT; + end; + + procedure proc_var_smallarray_const_1(var arr : array of const);saveregisters; + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : arr[i].vinteger := RESULT_U8BIT; + vtBoolean : arr[i].vboolean := RESULT_BOOLEAN; + else + RunError(255); + end; + end; {endfor} + end; + + + procedure proc_var_smallarray_const_2(var arr : array of const);saveregisters; + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_formaldef_array(var buf);saveregisters; + var + p: pbytearr; + begin + { array is indexed from 1 } + p := @buf; + p[SMALL_INDEX-1] := RESULT_U8BIT; + p[0] := RESULT_U8BIT; + end; + + +procedure proc_var_formaldef_string(var buf);saveregisters; + var + p: pbytearr; + begin + { array is indexed from 1 } + p := @buf; + p[SMALL_INDEX-1] := RESULT_U8BIT; + p[0] := RESULT_U8BIT; + end; + + + {************************************************************************} + { MIXED VAR PARAMETERS } + {************************************************************************} + procedure proc_var_s32bit_mixed(b1 : byte;var v : longint; b2: byte);saveregisters; + begin + v:=RESULT_S32BIT; + value_u8bit := RESULT_U8BIT; + end; + + procedure proc_var_s64bit_mixed(b1 : byte;var v: int64; b2: byte);saveregisters; + begin + v:=RESULT_S64BIT; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_u8bit_mixed(b1 : byte;var v: byte; b2: byte);saveregisters; + begin + v:=RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + + procedure proc_var_smallrecord_mixed(b1 : byte; var smallrec : tsmallrecord; b2: byte);saveregisters; + begin + smallrec.b := RESULT_U8BIT; + smallrec.w := RESULT_U16BIT; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_largerecord_mixed(b1 : byte; var largerec : tlargerecord; b2: byte);saveregisters; + begin + largerec.b[1] := RESULT_U8BIT; + largerec.b[2] := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_smallset_mixed(b1 : byte; var smallset : tsmallset; b2: byte);saveregisters; + begin + smallset := [A_A,A_D]; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_largeset_mixed(b1 : byte; var largeset : tlargeset; b2: byte);saveregisters; + begin + largeset:= largeset + ['I']; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_smallstring_mixed(b1 : byte; var s:tsmallstring; b2: byte);saveregisters; + begin + s:=RESULT_SMALLSTRING; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_bigstring_mixed(b1 : byte; var s:shortstring; b2: byte);saveregisters; + begin + s:=RESULT_BIGSTRING; + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_openstring_mixed(b1 : byte; var s: OpenString; b2: byte);saveregisters; + begin + global_u8bit := high(s); + s:=RESULT_SMALLSTRING; + value_u8bit := RESULT_U8BIT; + end; + + procedure proc_var_smallarray_mixed(b1 : byte; var arr : tsmallarray; b2: byte);saveregisters; + begin + arr[SMALL_INDEX] := RESULT_U8BIT; + arr[1] := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + + procedure proc_var_smallarray_open_mixed(b1 : byte; var arr : array of byte; b2: byte);saveregisters; + begin + arr[high(arr)] := RESULT_U8BIT; + arr[low(arr)] := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + + procedure proc_var_smallarray_const_1_mixed(b1 : byte; var arr : array of const; b2: byte);saveregisters; + var + i: integer; + begin + for i:=0 to high(arr) do + begin + case arr[i].vtype of + vtInteger : arr[i].vinteger := RESULT_U8BIT; + vtBoolean : arr[i].vboolean := RESULT_BOOLEAN; + else + RunError(255); + end; + end; {endfor} + value_u8bit := RESULT_U8BIT; + end; + + + procedure proc_var_smallarray_const_2_mixed(b1 : byte; var arr : array of const; b2: byte);saveregisters; + var + i: integer; + begin + if high(arr)<0 then + global_u8bit := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; +end; + + + procedure proc_var_formaldef_array_mixed(b1 : byte; var buf; b2: byte);saveregisters; + var + p: pbytearr; + begin + { array is indexed from 1 } + p := @buf; + p[SMALL_INDEX-1] := RESULT_U8BIT; + p[0] := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + + +procedure proc_var_formaldef_string_mixed(b1 : byte; var buf; b2: byte);saveregisters; + var + p: pbytearr; + begin + { array is indexed from 1 } + p := @buf; + p[SMALL_INDEX-1] := RESULT_U8BIT; + p[0] := RESULT_U8BIT; + value_u8bit := RESULT_U8BIT; + end; + +var + failed: boolean; + pp : ^pchar; +begin + {***************************** NORMAL TESTS *******************************} + clear_globals; + clear_values; + failed:=false; + + write('Var parameter test (src : LOC_REFERENCE (orddef)))...'); + proc_var_s32bit(global_s32bit); + if global_s32bit <> RESULT_S32BIT then + failed:=true; + + clear_globals; + clear_values; + proc_var_s64bit(global_s64bit); + if global_s64bit <> RESULT_S64BIT then + failed:=true; + + clear_globals; + clear_values; + proc_var_u8bit(global_u8bit); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + + + if failed then + fail + else + WriteLn('Passed!'); + + write('Var parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + proc_var_smallrecord(value_smallrec); + if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then + failed := true; + + clear_globals; + clear_values; + proc_var_largerecord(value_largerec); + if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + write('var parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + proc_var_smallset(value_smallset); + if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then + failed := true; + + clear_globals; + clear_values; + proc_var_largeset(value_largeset); + if not ('I' in value_largeset) then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + write('var parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + proc_var_smallstring(value_smallstring); + if value_smallstring <> RESULT_SMALLSTRING then + failed := true; + + clear_globals; + clear_values; + proc_var_bigstring(value_bigstring); + if value_bigstring <> RESULT_BIGSTRING then + failed := true; + + clear_globals; + clear_values; + proc_var_openstring(value_smallstring); + if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + + write('Var parameter test (src : LOC_REFERENCE (formaldef)))...'); + clear_globals; + clear_values; + failed:=false; + + proc_var_formaldef_array(value_smallarray); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + write('Var parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_var_smallarray(value_smallarray); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + + + + clear_globals; + clear_values; + + proc_var_smallarray_open(value_smallarray); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + +(* HOW CAN ARRAY OF CONST VAR PARAMETERS BE TESTED? + clear_globals; + clear_values; + value_u8bit := RESULT_U8BIT; + value_ptr := RESULT_PCHAR; + value_s64bit := RESULT_S64BIT; + value_smallstring := RESULT_SMALLSTRING; + value_class := tclass1.create; + value_boolean := RESULT_BOOLEAN; + value_char := RESULT_CHAR; + value_s64real:=RESULT_S64REAL; + proc_var_smallarray_var_1([value_u8bit,value_ptr,value_s64bit,value_char,value_smallstring,value_s64real,value_boolean,value_class]); + + if global_u8bit <> RESULT_U8BIT then + failed := true; + + if global_char <> RESULT_CHAR then + failed := true; + if global_boolean <> RESULT_BOOLEAN then + failed:=true; + if trunc(global_s64real) <> trunc(RESULT_S64REAL) then + failed := true; + if global_bigstring <> RESULT_SMALLSTRING then + failed := true; + if global_ptr <> value_ptr then + failed := true; +{ if value_class <> global_class then + failed := true;!!!!!!!!!!!!!!!!!!!!} + if global_s64bit <> RESULT_S64BIT then + failed := true; + if assigned(value_class) then + value_class.destroy; + global_u8bit := 0; + proc_var_smallarray_const_2([]); + if global_u8bit <> RESULT_U8BIT then + failed := true; +*) + + + if failed then + fail + else + WriteLn('Passed!'); + + {***************************** MIXED TESTS *******************************} + clear_globals; + clear_values; + failed:=false; + + write('Var parameter test (src : LOC_REFERENCE (orddef)))...'); + proc_var_s32bit_mixed(RESULT_U8BIT, global_s32bit, RESULT_U8BIT); + if global_s32bit <> RESULT_S32BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_s64bit_mixed(RESULT_U8BIT, global_s64bit, RESULT_U8BIT); + if global_s64bit <> RESULT_S64BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_u8bit_mixed(RESULT_U8BIT, global_u8bit, RESULT_U8BIT); + if global_u8bit <> RESULT_U8BIT then + failed:=true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + write('Var parameter test (src : LOC_REFERENCE (recorddef)))...'); + clear_globals; + clear_values; + failed := false; + + proc_var_smallrecord_mixed(RESULT_U8BIT,value_smallrec, RESULT_U8BIT); + if (value_smallrec.b <> RESULT_U8BIT) or (value_smallrec.w <> RESULT_U16BIT) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_largerecord_mixed(RESULT_U8BIT, value_largerec, RESULT_U8BIT); + if (value_largerec.b[1] <> RESULT_U8BIT) or (value_largerec.b[2] <> RESULT_U8BIT) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + write('var parameter test (src : LOC_REFERENCE (setdef)))...'); + clear_globals; + clear_values; + failed := false; + + proc_var_smallset_mixed(RESULT_U8BIT, value_smallset, RESULT_U8BIT); + if (not (A_A in value_smallset)) or (not (A_D in value_smallset)) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_largeset_mixed(RESULT_U8BIT, value_largeset, RESULT_U8BIT); + if not ('I' in value_largeset) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + + + write('var parameter test (src : LOC_REFERENCE (stringdef)))...'); + clear_globals; + clear_values; + failed := false; + proc_var_smallstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT); + if value_smallstring <> RESULT_SMALLSTRING then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_bigstring_mixed(RESULT_U8BIT, value_bigstring,RESULT_U8BIT); + if value_bigstring <> RESULT_BIGSTRING then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + clear_globals; + clear_values; + proc_var_openstring_mixed(RESULT_U8BIT, value_smallstring, RESULT_U8BIT); + if (value_smallstring <> RESULT_SMALLSTRING) or (global_u8bit <> high(value_smallstring)) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + + write('Var parameter test (src : LOC_REFERENCE (formaldef)))...'); + clear_globals; + clear_values; + failed:=false; + + proc_var_formaldef_array_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + + if failed then + fail + else + WriteLn('Passed!'); + + write('Var parameter test (src : LOC_REFERENCE (arraydef)))...'); + + clear_globals; + clear_values; + failed:=false; + + value_smallarray[SMALL_INDEX] := RESULT_U8BIT; + proc_var_smallarray_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + + + clear_globals; + clear_values; + + proc_var_smallarray_open_mixed(RESULT_U8BIT, value_smallarray, RESULT_U8BIT); + if (value_smallarray[SMALL_INDEX] <> RESULT_U8BIT) or (value_smallarray[1] <> RESULT_U8BIT) then + failed := true; + if value_u8bit <> RESULT_U8BIT then + failed := true; + + if failed then + fail + else + WriteLn('Passed!'); + +end. + + +{ $Log$ - Revision 1.4 2002-09-22 09:08:41 carl - * gets64bit was not returning an int64! - - Revision 1.3 2002/09/07 15:40:55 peter - * old logs removed and tabs fixed - - Revision 1.2 2002/05/13 13:45:38 peter - * updated to compile tests with kylix - - Revision 1.1 2002/04/13 17:51:00 carl - + var parameter passing for different calling conventions - - -} + Revision 1.5 2003-04-22 10:24:29 florian + * fixed defines for powerpc + + Revision 1.4 2002/09/22 09:08:41 carl + * gets64bit was not returning an int64! + + Revision 1.3 2002/09/07 15:40:55 peter + * old logs removed and tabs fixed + + Revision 1.2 2002/05/13 13:45:38 peter + * updated to compile tests with kylix + + Revision 1.1 2002/04/13 17:51:00 carl + + var parameter passing for different calling conventions + + +}