* Better support for Alias types

This commit is contained in:
Michaël Van Canneyt 2024-04-11 15:34:49 +02:00
parent c720e30fac
commit ea64142bac
3 changed files with 123 additions and 6 deletions

View File

@ -1103,6 +1103,7 @@ function TBaseWebIDLToPas.GetTypeName(const aTypeName: String; ForTypeDef: Boole
Var
A: UTF8String;
D: TIDLDefinition;
P: Integer;
begin
Case aTypeName of
'boolean': Result:='Boolean';
@ -1161,7 +1162,12 @@ begin
begin
A:=FTypeAliases.Values[Result];
If (A<>'') then
begin
Result:=A;
P:=Pos(',',A);
if P>0 then
SetLength(Result,P-1);
end;
end;
end;
end;

View File

@ -77,7 +77,9 @@ type
function GetArgName(d: TIDLDefinition): string;
function GetFunctionSuffix(aDef: TIDLFunctionDefinition; Overloads: TFPObjectList): String;
function GetInvokeClassName(aResultDef: TIDLDefinition; aName: TIDLString; aDef: TIDLFunctionDefinition=nil): TIDLString;
function GetInvokeNameFromTypeName(aTypeName: TIDLString; aType: TIDLDefinition): TIDLString;
function GetInvokeClassNameFromTypeAlias(aName: TIDLString; aDef: TIDLDefinition): TIDLString;
function GetInvokeNameFromAliasName(const aTypeName: TIDLString; aType: TIDLDefinition): string;
function GetInvokeNameFromTypeName(const aTypeName: TIDLString; aType: TIDLDefinition): TIDLString;
Protected
function BaseUnits: String; override;
@ -532,7 +534,28 @@ begin
end;
end;
function TWebIDLToPasWasmJob.GetInvokeNameFromTypeName(aTypeName : TIDLString; aType : TIDLDefinition): TIDLString;
function TWebIDLToPasWasmJob.GetInvokeNameFromAliasName(const aTypeName : TIDLString; aType : TIDLDefinition) : string;
// Heuristic to determine what the base type of an aliased type is.
// We could enhance this by having support for aType=aAlias,InvokeType:InvokeClass
var
aLower : String;
begin
aLower:=LowerCase(aTypeName);
if Pos('bool',aLower)>0 then
Result:='InvokeJSBooleanResult'
else if Pos('array',aLower)>0 then
Result:='InvokeJSObjectResult'
else if Pos('string',aLower)>0 then
Result:='InvokeJSUnicodeStringResult'
else if Pos(PasInterfacePrefix,aLower)=1 then
Result:='InvokeJSObjectResult'
else
Result:='';
end;
function TWebIDLToPasWasmJob.GetInvokeNameFromTypeName(const aTypeName : TIDLString; aType : TIDLDefinition): TIDLString;
begin
case aTypeName of
@ -558,17 +581,42 @@ begin
Result:='InvokeJSNoResult';
end;
else
if aType is TIDLEnumDefinition then
if (aType is TIDLTypeDefDefinition) then
begin
if (TypeAliases.IndexOfName((aType as TIDLTypeDefDefinition).TypeName)<>-1) then
Result:=GetInvokeNameFromAliasName((aType as TIDLTypeDefDefinition).TypeName,aType)
else if TypeAliases.IndexOfName(GetName(aType))<>-1 then
Result:=GetInvokeNameFromAliasName(aTypeName,aType);
if Result='' then
Raise EConvertError.CreateFmt('Unable to determine invoke name from alias type %s',[aTypeName]);
end
else if aType is TIDLEnumDefinition then
Result:='InvokeJSUnicodeStringResult'
else
Result:='InvokeJSObjectResult';
end;
end;
function TWebIDLToPasWasmJob.GetInvokeClassNameFromTypeAlias(aName : TIDLString; aDef : TIDLDefinition): TIDLString;
// Heuristic to determine what the base type of an aliased type is.
// We could enhance this by having support for aType=aAlias,InvokeType:InvokeClass
var
aLower : String;
begin
aLower:=LowerCase(aName);
if Pos('array',aLower)>0 then
Result:='TJSArray'
else if Pos(PasInterfacePrefix,aLower)=1 then
Result:='TJSObject'
else
Result:='';
end;
function TWebIDLToPasWasmJob.GetInvokeClassName(aResultDef : TIDLDefinition; aName : TIDLString; aDef : TIDLFunctionDefinition = Nil): TIDLString;
var
Msg : String;
aTypeName, Msg : String;
begin
// ResolvedReturnTypeName
@ -585,14 +633,28 @@ begin
begin
Result:=ClassPrefix+'Object'+ClassSuffix;
end
else if aResultDef is TIDLTypeDefDefinition then
begin
aTypeName:=(aResultDef as TIDLTypeDefDefinition).TypeName;
if TypeAliases.IndexOfName(aTypeName)=-1 then
begin
Msg:='[20220725172242] not yet supported: function "'+Msg+'" return type: '+aName;
if assigned(aDef) then
Msg:=Msg+' at '+GetDefPos(aDef);
raise EConvertError.Create(Msg);
end
else
begin
Result:=GetInvokeClassNameFromTypeAlias(aTypeName,aResultDef);
end;
end
else
begin
Msg:=GetName(aDef);
Msg:='[20220725172242] not yet supported: function return type '+aName+' '+Msg;
Msg:='[20220725172242] not yet supported: function "'+Msg+'" return type: '+aName;
if assigned(aDef) then
Msg:=Msg+' at '+GetDefPos(aDef);
raise EConvertError.Create(Msg);
end;
end;

View File

@ -63,6 +63,7 @@ type
procedure TestWJ_IntfFunction_ChromeOnly;
procedure TestWJ_IntfFunction_ChromeOnlyNewObject;
procedure TestWJ_IntfFunction_DictionaryResult;
procedure TestWJ_IntfFunction_AliasResult;
// Namespace attribute
procedure TestWJ_NamespaceAttribute_Boolean;
// maplike
@ -1406,6 +1407,54 @@ begin
]);
end;
procedure TTestWebIDL2WasmJob.TestWJ_IntfFunction_AliasResult;
begin
WebIDLToPas.TypeAliases.Add('Float32Array=IJSFloat32Array');
TestWebIDL([
'interface Attr {',
' Float32Array vibrate();',
'};',
''],
[
'Type',
'',
' // Forward class definitions',
' IJSAttr = interface;',
' TJSAttr = class;',
'',
' { --------------------------------------------------------------------',
' TJSAttr',
' --------------------------------------------------------------------}',
'',
' IJSAttr = interface(IJSObject)',
' [''{AA94F48A-2BFB-3877-82A6-208CA4B2AF2A}'']',
' function vibrate: IJSFloat32Array;',
' end;',
'',
' TJSAttr = class(TJSObject,IJSAttr)',
' Private',
' Public',
' function vibrate: IJSFloat32Array;',
' class function Cast(const Intf: IJSObject): IJSAttr;',
' end;',
'',
'implementation',
'',
'function TJSAttr.vibrate: IJSFloat32Array;',
'begin',
' Result:=InvokeJSObjectResult(''vibrate'',[],TJSArray) as IJSFloat32Array;',
'end;',
'',
'class function TJSAttr.Cast(const Intf: IJSObject): IJSAttr;',
'begin',
' Result:=TJSAttr.JOBCast(Intf);',
'end;',
'',
'end.'
]);
end;
procedure TTestWebIDL2WasmJob.TestWJ_NamespaceAttribute_Boolean;
begin