paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-11 21:46:00 +02:00
Code Issues Packages Projects Releases Wiki Activity

* use stdcall for the tested procvar definitions, so that the parameter

Browse Source 
pushing order is the same on all platforms

git-svn-id: trunk@12890 -
This commit is contained in:
Jonas Maebe 2009-03-15 10:22:24 +00:00
parent 442333d05f
commit e4d52bb118
1 changed files with 32 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
tests/webtbs/tw12038.pp
View File

@ -15,9 +15,9 @@ uses
type type
TBatch = Procedure (Var S:String) of Object; TBatch = Procedure (Var S:String) of Object; stdcall;
TProcess = function (Var S:String; const A:integer):int64 of Object; TProcess = function (Var S:String; const A:integer):int64 of Object; stdcall;
TArray = function (Var Array1:Array of String; const P:Pointer; Out Out1:int64):int64 of Object; TArray = function (Var Array1:Array of String; const P:Pointer; Out Out1:int64):int64 of Object; stdcall;
TMyObject=Class(TObject) TMyObject=Class(TObject)
private private
@ -27,8 +27,8 @@ type
FOnProcess : TProcess; FOnProcess : TProcess;
FOnArray: TArray; FOnArray: TArray;
Procedure ProcNo1(Var S:String); Procedure ProcNo1(Var S:String); stdcall;
Procedure ProcNo2(Var S:String); Procedure ProcNo2(Var S:String); stdcall;
public public
Function IF_Exist:Boolean; Function IF_Exist:Boolean;
Property FP1:Integer read FFieldOne Write FFieldOne; Property FP1:Integer read FFieldOne Write FFieldOne;
@ -67,12 +67,12 @@ Begin
result:=True; result:=True;
end; end;
Procedure TMyObject.ProcNo1(Var S:String); Procedure TMyObject.ProcNo1(Var S:String); stdcall;
Begin Begin
S:='The Batch execute the procedure TMyObject.ProcNo1'; S:='The Batch execute the procedure TMyObject.ProcNo1';
end; end;
Procedure TMyObject.ProcNo2(Var S:String); Procedure TMyObject.ProcNo2(Var S:String); stdcall;
Begin Begin
S:='The Batch execute the procedure TMyObject.ProcNo2'; S:='The Batch execute the procedure TMyObject.ProcNo2';
end; end;
@ -259,21 +259,16 @@ begin
ParamNameLength := ord( DTypeData^.ParamList[CurrentParamPosition]); ParamNameLength := ord( DTypeData^.ParamList[CurrentParamPosition]);
{ Next extract the Name of the Parameter } { Next extract the Name of the Parameter }
ParamName := ''; ParamName := '';
for j := CurrentParamPosition + 1 to for j := CurrentParamPosition + 1 to CurrentParamPosition + ParamNameLength do
CurrentParamPosition + ParamNameLength do ParamName := ParamName + DTypeData^.ParamList[j];
ParamName := ParamName + CurrentParamPosition := CurrentParamPosition + ParamNameLength;
DTypeData^.ParamList[j];
CurrentParamPosition := CurrentParamPosition +
ParamNameLength;
{ Next extract the Type of the Parameter } { Next extract the Type of the Parameter }
inc(CurrentParamPosition); inc(CurrentParamPosition);
ParamNameLength := ord( DTypeData^.ParamList[CurrentParamPosition]); ParamNameLength := ord( DTypeData^.ParamList[CurrentParamPosition]);
writeln('Length type:',ParamNameLength); writeln('Length type:',ParamNameLength);
TypeName := ''; TypeName := '';
for j := CurrentParamPosition + 1 to for j := CurrentParamPosition + 1 to CurrentParamPosition + ParamNameLength do
CurrentParamPosition + ParamNameLength do TypeName := TypeName + DTypeData^.ParamList[j];
TypeName := TypeName +
DTypeData^.ParamList[j];
CurrentParamPosition := CurrentParamPosition + CurrentParamPosition := CurrentParamPosition +
ParamNameLength + 1; ParamNameLength + 1;
writeln('ParamName:',i,':', ParamName); writeln('ParamName:',i,':', ParamName);
@ -321,8 +316,8 @@ end;
const const
expectedresults: array[0..3] of ansistring = ( expectedresults: array[0..3] of ansistring = (
'', '',
'function (var array of reference ?Array1: AnsiString; const P: Pointer; out Out1: Int64): Int64 of object;', 'function (out Out1: Int64; const P: Pointer; var array of reference ?Array1: AnsiString): Int64 of object;',
'function (var S: AnsiString; const A: LongInt): Int64 of object;', 'function (const A: LongInt; var S: AnsiString): Int64 of object;',
'procedure (var S: AnsiString) of object;' 'procedure (var S: AnsiString) of object;'
); );
begin begin