mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2026-01-04 21:10:34 +01:00
* Better support for Alias types
This commit is contained in:
parent
c720e30fac
commit
ea64142bac
@ -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;
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user