Browse Source

* Better support for Alias types

Michaël Van Canneyt 1 year ago
parent
commit
ea64142bac

+ 6 - 0
packages/webidl/src/webidltopas.pp

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

+ 68 - 6
packages/webidl/src/webidltowasmjob.pp

@@ -77,7 +77,9 @@ type
     function GetArgName(d: TIDLDefinition): string;
     function GetArgName(d: TIDLDefinition): string;
     function GetFunctionSuffix(aDef: TIDLFunctionDefinition; Overloads: TFPObjectList): String;
     function GetFunctionSuffix(aDef: TIDLFunctionDefinition; Overloads: TFPObjectList): String;
     function GetInvokeClassName(aResultDef: TIDLDefinition; aName: TIDLString; aDef: TIDLFunctionDefinition=nil): TIDLString;
     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
   Protected
     function BaseUnits: String; override;
     function BaseUnits: String; override;
@@ -532,7 +534,28 @@ begin
     end;
     end;
 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
 begin
   case aTypeName of
   case aTypeName of
@@ -558,17 +581,42 @@ begin
     Result:='InvokeJSNoResult';
     Result:='InvokeJSNoResult';
     end;
     end;
   else
   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'
       Result:='InvokeJSUnicodeStringResult'
     else
     else
       Result:='InvokeJSObjectResult';
       Result:='InvokeJSObjectResult';
   end;
   end;
 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;
 function TWebIDLToPasWasmJob.GetInvokeClassName(aResultDef : TIDLDefinition; aName : TIDLString; aDef : TIDLFunctionDefinition = Nil): TIDLString;
 
 
 var
 var
-  Msg : String;
+  aTypeName, Msg : String;
 
 
 begin
 begin
 //  ResolvedReturnTypeName
 //  ResolvedReturnTypeName
@@ -585,14 +633,28 @@ begin
     begin
     begin
     Result:=ClassPrefix+'Object'+ClassSuffix;
     Result:=ClassPrefix+'Object'+ClassSuffix;
     end
     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
   else
     begin
     begin
     Msg:=GetName(aDef);
     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
     if assigned(aDef) then
       Msg:=Msg+' at '+GetDefPos(aDef);
       Msg:=Msg+' at '+GetDefPos(aDef);
     raise EConvertError.Create(Msg);
     raise EConvertError.Create(Msg);
-
     end;
     end;
 end;
 end;
 
 

+ 49 - 0
packages/webidl/tests/tcwebidl2wasmjob.pas

@@ -63,6 +63,7 @@ type
     procedure TestWJ_IntfFunction_ChromeOnly;
     procedure TestWJ_IntfFunction_ChromeOnly;
     procedure TestWJ_IntfFunction_ChromeOnlyNewObject;
     procedure TestWJ_IntfFunction_ChromeOnlyNewObject;
     procedure TestWJ_IntfFunction_DictionaryResult;
     procedure TestWJ_IntfFunction_DictionaryResult;
+    procedure TestWJ_IntfFunction_AliasResult;
     // Namespace attribute
     // Namespace attribute
     procedure TestWJ_NamespaceAttribute_Boolean;
     procedure TestWJ_NamespaceAttribute_Boolean;
     // maplike
     // maplike
@@ -1406,6 +1407,54 @@ begin
     ]);
     ]);
 end;
 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;
 procedure TTestWebIDL2WasmJob.TestWJ_NamespaceAttribute_Boolean;
 begin
 begin