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

fcl-passrc: resolver: fixed typecast a(b.func) marking implicit call

Browse Source 
git-svn-id: trunk@47914 -
This commit is contained in:
Mattias Gaertner 2020-12-30 16:12:47 +00:00
parent 32999fbaba
commit 7032cba91e
2 changed files with 47 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
packages/fcl-passrc/src/pasresolver.pp
View File

@ -13938,7 +13938,7 @@ begin
begin begin
// type cast // type cast
Param0:=Params.Params[0]; Param0:=Params.Params[0];
ComputeElement(Param0,ParamResolved,[]); ComputeElement(Param0,ParamResolved,Flags);
ComputeTypeCast(ResolvedEl.LoTypeEl,ResolvedEl.HiTypeEl,Param0, ComputeTypeCast(ResolvedEl.LoTypeEl,ResolvedEl.HiTypeEl,Param0,
ParamResolved,ResolvedEl,Flags); ParamResolved,ResolvedEl,Flags);
end end

46
packages/pastojs/tests/tcgenerics.pas
View File

@ -83,6 +83,7 @@ type
// generic array // generic array
procedure TestGen_Array_OtherUnit; procedure TestGen_Array_OtherUnit;
procedure TestGen_ArrayOfUnitImplRec; procedure TestGen_ArrayOfUnitImplRec;
procedure TestGen_Array_TypecastJSValueResultToArg;
// generic procedure type // generic procedure type
procedure TestGen_ProcType_ProcLocal; procedure TestGen_ProcType_ProcLocal;
@ -2373,6 +2374,51 @@ begin
''])); '']));
end; end;
procedure TTestGenerics.TestGen_Array_TypecastJSValueResultToArg;
begin
StartProgram(false);
Add([
'{$mode delphi}',
'type',
' TArray<T> = array of T;',
' TFunc = function: JSValue of object;',
' TObject = class',
' f: TFunc;',
' function Run: jsvalue; virtual; abstract;',
' end;',
'procedure Sit(Arr: TArray<TObject>);',
'begin',
'end;',
'procedure Fly(o: TObject);',
'begin',
' Sit(TArray<TObject>(o.f()));',
' Sit(TArray<TObject>(o.Run));',
' Sit(TArray<TObject>(o.Run()));',
'end;',
'begin']);
ConvertProgram;
CheckSource('TestGen_Array_TypecastJSValueResultToArg',
LinesToStr([ // statements
'rtl.createClass(this, "TObject", null, function () {',
' this.$init = function () {',
' this.f = null;',
' };',
' this.$final = function () {',
' this.f = undefined;',
' };',
'});',
'this.Sit = function (Arr) {',
'};',
'this.Fly = function (o) {',
' $mod.Sit(o.f());',
' $mod.Sit(o.Run());',
' $mod.Sit(o.Run());',
'};',
'']),
LinesToStr([ // $mod.$main
'']));
end;
procedure TTestGenerics.TestGen_ProcType_ProcLocal; procedure TTestGenerics.TestGen_ProcType_ProcLocal;
begin begin
StartProgram(false); StartProgram(false);