mirror of
https://gitlab.com/freepascal.org/fpc/pas2js.git
synced 2025-04-06 02:27:48 +02:00
fcl-passrc: check class intf impl proc type modifiers match
This commit is contained in:
mattias
parent
f9b7f1dbb2
commit
94cee0dc39
@ -1710,7 +1710,8 @@ type
|
||||
function CreateClassIntfMap(El: TPasClassType; Index: integer): TPasClassIntfMap;
|
||||
procedure CheckConditionExpr(El: TPasExpr; const ResolvedEl: TPasResolverResult); virtual;
|
||||
procedure CheckProcSignatureMatch(DeclProc, ImplProc: TPasProcedure;
|
||||
IsOverride: boolean);
|
||||
IsOverride: boolean // override or class intf implementation
|
||||
);
|
||||
procedure CheckPointerCycle(El: TPasPointerType);
|
||||
procedure CheckGenericTemplateTypes(El: TPasGenericType); virtual;
|
||||
procedure ComputeUnaryNot(El: TUnaryExpr; var ResolvedEl: TPasResolverResult;
|
||||
@ -6453,6 +6454,10 @@ begin
|
||||
RaiseMsg(20180322143202,nNoMatchingImplForIntfMethodXFound,
|
||||
sNoMatchingImplForIntfMethodXFound,
|
||||
[GetProcTypeDescription(IntfProc.ProcType,[prptdUseName,prptdAddPaths,prptdResolveSimpleAlias])],El); // ToDo: jump to interface list
|
||||
// check calling conventions
|
||||
//writeln('TPasResolver.FinishClassType Intf=',GetObjPath(IntfProc),' Found=',GetObjPath(FindData.Found));
|
||||
CheckProcSignatureMatch(IntfProc,TPasProcedure(FindData.Found),true);
|
||||
|
||||
Map.Procs[j]:=FindData.Found;
|
||||
end;
|
||||
Map:=Map.AncestorMap;
|
||||
@ -9396,7 +9401,7 @@ var
|
||||
DeclName, ImplName: String;
|
||||
ImplResult, DeclResult: TPasType;
|
||||
ImplTemplType, DeclTemplType: TPasGenericTemplateType;
|
||||
NewImplPTMods: TProcTypeModifiers;
|
||||
NewImplPTMods, DeclPTMods, ImplPTMods: TProcTypeModifiers;
|
||||
ptm: TProcTypeModifier;
|
||||
NewImplProcMods: TProcedureModifiers;
|
||||
pm: TProcedureModifier;
|
||||
@ -9409,6 +9414,9 @@ begin
|
||||
if DeclArgs.Count<>ImplArgs.Count then
|
||||
RaiseNotYetImplemented(20190912110642,ImplProc);
|
||||
|
||||
DeclPTMods:=DeclProc.ProcType.Modifiers;
|
||||
ImplPTMods:=ImplProc.ProcType.Modifiers;
|
||||
|
||||
DeclTemplates:=GetProcTemplateTypes(DeclProc);
|
||||
ImplTemplates:=GetProcTemplateTypes(ImplProc);
|
||||
if DeclTemplates<>nil then
|
||||
@ -9465,33 +9473,36 @@ begin
|
||||
if CheckElTypeCompatibility(ImplResult,DeclResult,prraSimple)>cGenericExact then
|
||||
RaiseIncompatibleType(20170216151734,nResultTypeMismatchExpectedButFound,
|
||||
[],DeclResult,ImplResult,ImplProc);
|
||||
|
||||
if ImplProc.IsAsync and not DeclProc.IsAsync then
|
||||
RaiseMsg(20200524111856,nXModifierMismatchY,sXModifierMismatchY,['procedure type','async'],ImplProc);
|
||||
end;
|
||||
|
||||
// calling convention
|
||||
if ImplProc.CallingConvention<>DeclProc.CallingConvention then
|
||||
RaiseMsg(20170216151731,nCallingConventionMismatch,sCallingConventionMismatch,[],ImplProc);
|
||||
|
||||
// proc modifiers
|
||||
NewImplProcMods:=ImplProc.Modifiers-DeclProc.Modifiers-[pmAssembler];
|
||||
if not IsOverride then
|
||||
// modifiers
|
||||
if IsOverride then
|
||||
begin
|
||||
// override/class-intf-impl: calling conventions must match
|
||||
NewImplPTMods:=ImplPTMods><DeclPTMods;
|
||||
for ptm in NewImplPTMods do
|
||||
RaiseMsg(20201227213020,nXModifierMismatchY,sXModifierMismatchY,
|
||||
['procedure type',ProcTypeModifiers[ptm]],ImplProc.ProcType);
|
||||
end
|
||||
else
|
||||
begin
|
||||
// implementation proc must not add modifiers, except "assembler"
|
||||
NewImplProcMods:=ImplProc.Modifiers-DeclProc.Modifiers-[pmAssembler];
|
||||
if NewImplProcMods<>[] then
|
||||
for pm in NewImplProcMods do
|
||||
RaiseMsg(20200518182445,nDirectiveXNotAllowedHere,sDirectiveXNotAllowedHere,
|
||||
[ModifierNames[pm]],ImplProc.ProcType);
|
||||
// implementation proc must not add modifiers
|
||||
NewImplPTMods:=ImplPTMods-DeclPTMods;
|
||||
if NewImplPTMods<>[] then
|
||||
for ptm in NewImplPTMods do
|
||||
RaiseMsg(20200425154821,nDirectiveXNotAllowedHere,sDirectiveXNotAllowedHere,
|
||||
[ProcTypeModifiers[ptm]],ImplProc.ProcType);
|
||||
end;
|
||||
|
||||
// proc type modifiers
|
||||
NewImplPTMods:=ImplProc.ProcType.Modifiers-DeclProc.ProcType.Modifiers;
|
||||
// implementation proc must not add modifiers
|
||||
if NewImplPTMods<>[] then
|
||||
for ptm in NewImplPTMods do
|
||||
RaiseMsg(20200425154821,nDirectiveXNotAllowedHere,sDirectiveXNotAllowedHere,
|
||||
[ProcTypeModifiers[ptm]],ImplProc.ProcType);
|
||||
end;
|
||||
|
||||
procedure TPasResolver.ResolveImplBlock(Block: TPasImplBlock);
|
||||
|
||||
@ -3000,7 +3000,7 @@ begin
|
||||
'procedure TBird.Run<S>(a: TArray<S>);',
|
||||
'begin',
|
||||
' a:=TArray<S>(a);',
|
||||
//' F:=TArray<TObject>(a);',
|
||||
' F:=TArray<TObject>(a);',
|
||||
'end;',
|
||||
'']);
|
||||
ParseUnit;
|
||||
|
||||
@ -890,6 +890,7 @@ type
|
||||
Procedure TestAsync_ProcTypeAsyncModMismatchFail;
|
||||
Procedure TestAsync_Inherited;
|
||||
Procedure TestAsync_ClassInterface;
|
||||
Procedure TestAsync_ClassInterface_AsyncMissmatchFail;
|
||||
end;
|
||||
|
||||
function LinesToStr(Args: array of const): string;
|
||||
@ -32942,8 +32943,18 @@ begin
|
||||
' function _AddRef: longint;',
|
||||
' function _Release: longint;',
|
||||
' end;',
|
||||
'function Say(i: IUnknown): IUnknown; async;',
|
||||
'begin',
|
||||
'end;',
|
||||
'function Run: IUnknown; async;',
|
||||
'begin',
|
||||
' Result:=await(Run);',
|
||||
' Result:=await(Run());',
|
||||
' Result:=await(Run) as IUnknown;',
|
||||
' Result:=await(Say(nil));',
|
||||
' Result:=await(Say(await(Run())));',
|
||||
' Result:=await(Say(await(Run()) as IUnknown));',
|
||||
' Result:=await(Say(await(Run()) as IUnknown)) as IUnknown;',
|
||||
'end;',
|
||||
'procedure Fly;',
|
||||
'var p: TJSPromise;',
|
||||
@ -32959,8 +32970,25 @@ begin
|
||||
CheckSource('TestAsync_ClassInterface',
|
||||
LinesToStr([ // statements
|
||||
'rtl.createInterface(this, "IUnknown", "{D7ADB0E1-758A-322B-BDDF-21CD521DDFA9}", ["_AddRef", "_Release"], null);',
|
||||
'this.Say = async function (i) {',
|
||||
' var Result = null;',
|
||||
' return Result;',
|
||||
'};',
|
||||
'this.Run = async function () {',
|
||||
' var Result = null;',
|
||||
' var $ok = false;',
|
||||
' try {',
|
||||
' Result = rtl.setIntfL(Result, await $mod.Run());',
|
||||
' Result = rtl.setIntfL(Result, await $mod.Run());',
|
||||
' Result = rtl.setIntfL(Result, rtl.intfAsIntfT(await $mod.Run(), $mod.IUnknown));',
|
||||
' Result = rtl.setIntfL(Result, await $mod.Say(null));',
|
||||
' Result = rtl.setIntfL(Result, await $mod.Say(await $mod.Run()));',
|
||||
' Result = rtl.setIntfL(Result, await $mod.Say(rtl.intfAsIntfT(await $mod.Run(), $mod.IUnknown)));',
|
||||
' Result = rtl.setIntfL(Result, rtl.intfAsIntfT(await $mod.Say(rtl.intfAsIntfT(await $mod.Run(), $mod.IUnknown)), $mod.IUnknown));',
|
||||
' $ok = true;',
|
||||
' } finally {',
|
||||
' if (!$ok) rtl._Release(Result);',
|
||||
' };',
|
||||
' return Result;',
|
||||
'};',
|
||||
'this.Fly = function () {',
|
||||
@ -32976,6 +33004,29 @@ begin
|
||||
CheckResolverUnexpectedHints();
|
||||
end;
|
||||
|
||||
procedure TTestModule.TestAsync_ClassInterface_AsyncMissmatchFail;
|
||||
begin
|
||||
StartProgram(true,[supTInterfacedObject]);
|
||||
Add([
|
||||
'{$mode objfpc}',
|
||||
'{$modeswitch externalclass}',
|
||||
'type',
|
||||
' TJSPromise = class external name ''Promise''',
|
||||
' end;',
|
||||
' IBird = interface',
|
||||
' procedure Run;',
|
||||
' end;',
|
||||
' TBird = class(TInterfacedObject,IBird)',
|
||||
' procedure Run; async;',
|
||||
' end;',
|
||||
'procedure TBird.Run;',
|
||||
'begin',
|
||||
'end;',
|
||||
'begin',
|
||||
' ']);
|
||||
SetExpectedPasResolverError('procedure type modifier "async" mismatch',nXModifierMismatchY);
|
||||
ConvertProgram;
|
||||
end;
|
||||
|
||||
Initialization
|
||||
RegisterTests([TTestModule]);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user