paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-11 18:46:01 +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

69
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;
@ -233,10 +233,10 @@ begin
Definition:='('; Definition:='(';
// Definition := Definition+'('; // Definition := Definition+'(';
CurrentParamPosition := 0; CurrentParamPosition := 0;
for i:= 1 to DTypeData^.ParamCount do for i:= 1 to DTypeData^.ParamCount do
begin begin
{ First Handle the ParamFlag } { First Handle the ParamFlag }
Flag:=integer(DTypeData^.ParamList[CurrentParamPosition]); Flag:=integer(DTypeData^.ParamList[CurrentParamPosition]);
Flags:=TParamFlags(Flag); Flags:=TParamFlags(Flag);
writeln('ord(Flags):',ord(DTypeData^.ParamList[CurrentParamPosition])); writeln('ord(Flags):',ord(DTypeData^.ParamList[CurrentParamPosition]));
// For i:= 1 to NumI do // For i:= 1 to NumI do
@ -254,33 +254,28 @@ begin
if pfout in Flags if pfout in Flags
then Definition := Definition+('out '); then Definition := Definition+('out ');
{ Next char is the length of the ParamName} { Next char is the length of the ParamName}
inc(CurrentParamPosition); inc(CurrentParamPosition);
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]; { Next extract the Type of the Parameter }
CurrentParamPosition := CurrentParamPosition + inc(CurrentParamPosition);
ParamNameLength; ParamNameLength := ord( DTypeData^.ParamList[CurrentParamPosition]);
{ Next extract the Type of the Parameter } writeln('Length type:',ParamNameLength);
inc(CurrentParamPosition); TypeName := '';
ParamNameLength := ord( DTypeData^.ParamList[CurrentParamPosition]); for j := CurrentParamPosition + 1 to CurrentParamPosition + ParamNameLength do
writeln('Length type:',ParamNameLength); TypeName := TypeName + DTypeData^.ParamList[j];
TypeName := ''; CurrentParamPosition := CurrentParamPosition +
for j := CurrentParamPosition + 1 to ParamNameLength + 1;
CurrentParamPosition + ParamNameLength do writeln('ParamName:',i,':', ParamName);
TypeName := TypeName +
DTypeData^.ParamList[j];
CurrentParamPosition := CurrentParamPosition +
ParamNameLength + 1;
writeln('ParamName:',i,':', ParamName);
writeln('TypeName:',i,':', TypeName); writeln('TypeName:',i,':', TypeName);
Definition := Format('%s%s: %s', [Definition, ParamName, TypeName]); Definition := Format('%s%s: %s', [Definition, ParamName, TypeName]);
If I<DTypeData^.ParamCount then Definition := Definition + '; ' If I<DTypeData^.ParamCount then Definition := Definition + '; '
end; end;
if DTypeData^.MethodKind = mkFunction then if DTypeData^.MethodKind = mkFunction then
begin begin
ParamNameLength := ord( DTypeData^.ParamList[CurrentParamPosition]); ParamNameLength := ord( DTypeData^.ParamList[CurrentParamPosition]);
@ -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