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

* Fix callback interface treatment

Browse Source
This commit is contained in:
Michaël Van Canneyt 2024-04-24 16:38:26 +02:00
parent 55dee03ad0
commit 328ff5f0c3
3 changed files with 84 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
packages/webidl/src/webidldefs.pp
View File

@ -224,6 +224,7 @@ type
Function Add(aClass : TIDLDefinitionClass; Const AName : UTF8String; const aFile: string; aLine, aCol: integer) : TIDLDefinition; override;
Function Add(aItem : TIDLDefinition) : Integer;
Function Delete(aItem : TIDLDefinition) : boolean; // true if found and deleted
Function Extract(aItem : TIDLDefinition) : TIDLDefinition;
Function IndexOfName(aName : UTF8String) : Integer;
Function HasName(aName : UTF8String) : Boolean;
function GetEnumerator: TIDLDefinitionEnumerator;
@ -1474,6 +1475,12 @@ begin
Result:=false;
end;
function TIDLDefinitionList.Extract(aItem: TIDLDefinition): TIDLDefinition;
begin
Result:=TIDLDefinition(FList.Extract(aItem));
end;
function TIDLDefinitionList.IndexOfName(aName: UTF8String): Integer;
begin
Result:=Count-1;

32
packages/webidl/src/webidlparser.pp
View File

@ -51,6 +51,7 @@ Type
function FindDictionary(aName: UTF8String): TIDLDictionaryDefinition; virtual;
function FindInterface(aName: UTF8String): TIDLInterfaceDefinition; virtual;
function FindNamespace(aName: UTF8String): TIDLNamespaceDefinition; virtual;
procedure AppendDictionaryPartials; virtual;
procedure AppendInterfacePartials; virtual;
procedure AppendInterfaceIncludes; virtual;
@ -63,6 +64,8 @@ Type
Procedure AppendIncludes; virtual;
Function GetInterfacesTopologically: TIDLDefinitionList; virtual;
Procedure ResolveTypes; virtual;
procedure ResolveCallbackInterfaces; virtual;
function CreateCallBackFromInterface(aDef: TIDLInterfaceDefinition): TIDLCallBackDefinition;
function GetDefPos(Def: TIDLBaseObject; WithoutFile: boolean = false): string; virtual;
function IndexOfDefinition(const AName: String): Integer;
Function FindDefinition(const AName : String) : TIDLDefinition;
@ -2016,8 +2019,37 @@ begin
DD.ParentDictionary:=FindDictionary(DD.ParentName);
end;
Function TWebIDLContext.CreateCallBackFromInterface(aDef : TIDLInterfaceDefinition) : TIDLCallBackDefinition;
begin
if (aDef.Members.Count<>1) then
Raise EWebIDLParser.CreateFmt('Callback Interface %s has wrong member count',[aDef.Name]);
if (aDef.Member[0] is TIDLFunctionDefinition) then
Raise EWebIDLParser.CreateFmt('Callback Interface %s member %s is not a function',[aDef.Name,aDef.Members[0].Name]);
Result:=TIDLCallBackDefinition(FDefinitions.Add(TIDLCallBackDefinition,aDef.Name,aDef.SrcFile,aDef.Line,aDef.Column));
Result.FunctionDef:=TIDLFunctionDefinition(aDef.Members.Extract(aDef.Member[0]));
end;
procedure TWebIDLContext.ResolveCallbackInterfaces;
var
D : TIDLDefinition;
DI : TIDLInterfaceDefinition absolute D;
begin
For D In FDefinitions do
if (D is TIDLInterfaceDefinition) and DI.IsCallBack then
begin
CreateCallBackFromInterface(DI);
FDefinitions.Delete(D);
FreeAndNil(FHash);
end;
end;
procedure TWebIDLContext.ResolveTypes;
begin
ResolveCallbackInterfaces;
ResolveParentTypes;
end;

46
packages/webidl/src/webidltopas.pp
View File

@ -148,6 +148,8 @@ type
FTypeAliases: TStrings; // user defined type maping name to name
FVerbose: Boolean;
FWebIDLVersion: TWebIDLVersion;
function CreateCallBackFromInterface(aDef: TIDLInterfaceDefinition): TIDLCallBackDefinition;
procedure ResolveCallbackInterfaces;
procedure SetGlobalVars(const AValue: TStrings);
procedure SetIncludeImplementationCode(AValue: TStrings);
procedure SetIncludeInterfaceCode(AValue: TStrings);
@ -3026,21 +3028,63 @@ begin
AllocatePasName(D,ParentName,True);
end;
Function TBaseWebIDLToPas.CreateCallBackFromInterface(aDef : TIDLInterfaceDefinition) : TIDLCallBackDefinition;
var
I,Idx,Count : Integer;
begin
DoLog('Converting callback interface %s to callback',[aDef.Name]);
Count:=0;
For I:=0 to aDef.Members.Count-1 do
if (aDef.Member[I] is TIDLFunctionDefinition) then
begin
Idx:=I;
Inc(Count);
end;
if (Count<>1) then
Raise EWebIDLParser.CreateFmt('Callback Interface %s has wrong function member count',[aDef.Name]);
if not (aDef.Member[Idx] is TIDLFunctionDefinition) then
Raise EWebIDLParser.CreateFmt('Callback Interface %s member %s is not a function',[aDef.Name,aDef.Members[Idx].Name]);
Result:=TIDLCallBackDefinition(FContext.Add(TIDLCallBackDefinition,aDef.Name,aDef.SrcFile,aDef.Line,aDef.Column));
Result.FunctionDef:=TIDLFunctionDefinition(aDef.Members.Extract(aDef.Member[Idx]));
Result.FunctionDef.Name:=Result.Name;
end;
procedure TBaseWebIDLToPas.ResolveCallbackInterfaces;
var
D : TIDLDefinition;
DI : TIDLInterfaceDefinition absolute D;
begin
For D In FContext.Definitions do
if (D is TIDLInterfaceDefinition) and DI.IsCallBack then
begin
CreateCallBackFromInterface(DI);
FContext.Definitions.Delete(D);
end;
end;
procedure TBaseWebIDLToPas.ProcessDefinitions;
var
D : TIDLDefinition;
begin
ResolveCallbackInterfaces;
RemoveInterfaceForwards(FContext.Definitions);
FContext.AppendPartials;
FContext.AppendIncludes;
For D in FContext.Definitions do
if D.Name<>'' then
AddGlobalJSIdentifier(D);
AddGlobalJSIdentifier(D);
AllocatePasNames(FContext.Definitions);
ResolveParentInterfaces(FContext.Definitions);
ResolveTypeDefs(FContext.Definitions);
end;
procedure TBaseWebIDLToPas.Execute;