Browse Source

* Various small fixes

Michaël Van Canneyt 1 year ago
parent
commit
3f8bbd3b00

+ 14 - 0
packages/webidl/src/webidldefs.pp

@@ -223,6 +223,8 @@ type
     Function Add(aClass : TIDLDefinitionClass; Const AName : UTF8String; const aFile: string; aLine, aCol: integer) : TIDLDefinition; override;
     Function Add(aClass : TIDLDefinitionClass; Const AName : UTF8String; const aFile: string; aLine, aCol: integer) : TIDLDefinition; override;
     Function Add(aItem : TIDLDefinition) : Integer;
     Function Add(aItem : TIDLDefinition) : Integer;
     Function Delete(aItem : TIDLDefinition) : boolean; // true if found and deleted
     Function Delete(aItem : TIDLDefinition) : boolean; // true if found and deleted
+    Function IndexOfName(aName : UTF8String) : Integer;
+    Function HasName(aName : UTF8String) : Boolean;
     function GetEnumerator: TIDLDefinitionEnumerator;
     function GetEnumerator: TIDLDefinitionEnumerator;
     Property Parent : TIDLDefinition Read FParent;
     Property Parent : TIDLDefinition Read FParent;
     Property Definitions[aIndex : Integer] : TIDLDefinition Read GetD;default;
     Property Definitions[aIndex : Integer] : TIDLDefinition Read GetD;default;
@@ -1463,6 +1465,18 @@ begin
   Result:=false;
   Result:=false;
 end;
 end;
 
 
+function TIDLDefinitionList.IndexOfName(aName: UTF8String): Integer;
+begin
+  Result:=Count-1;
+  While (Result>=0) and (Definitions[Result].Name<>aName) do
+    Dec(Result);
+end;
+
+function TIDLDefinitionList.HasName(aName: UTF8String): Boolean;
+begin
+  Result:=IndexOfName(aName)<>-1;
+end;
+
 function TIDLDefinitionList.GetEnumerator: TIDLDefinitionEnumerator;
 function TIDLDefinitionList.GetEnumerator: TIDLDefinitionEnumerator;
 begin
 begin
   Result:=TIDLDefinitionEnumerator.Create(Self);
   Result:=TIDLDefinitionEnumerator.Create(Self);

+ 104 - 40
packages/webidl/src/webidltopas.pp

@@ -341,38 +341,46 @@ end;
 
 
 function TBaseWebIDLToPas.WriteFunctionImplicitTypes(aList: TIDLDefinitionList): Integer;
 function TBaseWebIDLToPas.WriteFunctionImplicitTypes(aList: TIDLDefinitionList): Integer;
 
 
+  procedure DoFunction(FD : TIDLFunctionDefinition);
+
+  var
+    D2,D3: TIDLDefinition;
+    DA: TIDLArgumentDefinition absolute D2;
+    UT: TIDLUnionTypeDefDefinition;
+
+  begin
+    if (FD.ReturnType is TIDLSequenceTypeDefDefinition) then
+      if AddSequenceDef(FD.ReturnType as TIDLSequenceTypeDefDefinition) then
+        Inc(Result);
+    For D2 in FD.Arguments do
+      if (DA.ArgumentType is TIDLSequenceTypeDefDefinition) then
+        begin
+        if AddSequenceDef(DA.ArgumentType as TIDLSequenceTypeDefDefinition) then
+          Inc(Result);
+        end
+      else
+        begin
+        UT:=CheckUnionTypeDefinition(DA.ArgumentType);
+        if Assigned(UT) then
+          For D3 in UT.Union do
+            if (D3 is TIDLSequenceTypeDefDefinition) then
+              if AddSequenceDef(D3 as TIDLSequenceTypeDefDefinition) then
+                Inc(Result);
+        end;
+
+  end;
+
 Var
 Var
-  D,D2,D3: TIDLDefinition;
-  FD: TIDLFunctionDefinition absolute D;
-  DA: TIDLArgumentDefinition absolute D2;
-  UT: TIDLUnionTypeDefDefinition;
+  D : TIDLDefinition;
 
 
 begin
 begin
   Result:=0;
   Result:=0;
   for D in aList do
   for D in aList do
     if ConvertDef(D) then
     if ConvertDef(D) then
       if D is TIDLFunctionDefinition then
       if D is TIDLFunctionDefinition then
-        if Not (foCallBack in FD.Options) then
-          begin
-          if (FD.ReturnType is TIDLSequenceTypeDefDefinition) then
-            if AddSequenceDef(FD.ReturnType as TIDLSequenceTypeDefDefinition) then
-              Inc(Result);
-          For D2 in FD.Arguments do
-            if (DA.ArgumentType is TIDLSequenceTypeDefDefinition) then
-              begin
-              if AddSequenceDef(DA.ArgumentType as TIDLSequenceTypeDefDefinition) then
-                Inc(Result);
-              end
-            else
-              begin
-              UT:=CheckUnionTypeDefinition(DA.ArgumentType);
-              if Assigned(UT) then
-                For D3 in UT.Union do
-                  if (D3 is TIDLSequenceTypeDefDefinition) then
-                    if AddSequenceDef(D3 as TIDLSequenceTypeDefDefinition) then
-                      Inc(Result);
-              end;
-          end;
+        DoFunction(TIDLFunctionDefinition(D))
+      else if D is TIDLCallBackDefinition then
+        DoFunction(TIDLCallBackDefinition(D).FunctionDef);
   if Result>0 then
   if Result>0 then
     AddLn('');
     AddLn('');
 end;
 end;
@@ -611,6 +619,7 @@ function TBaseWebIDLToPas.WriteMapLikeMethodDefinitions(aParent: TIDLStructuredD
 var
 var
   D1,KeyType,ValueType : String;
   D1,KeyType,ValueType : String;
   lReadOnly : Boolean;
   lReadOnly : Boolean;
+  L : TIDLDefinitionList;
 
 
 begin
 begin
   Result:=0;
   Result:=0;
@@ -619,19 +628,33 @@ begin
 //  KeyType:=GetResolName();
 //  KeyType:=GetResolName();
 //  ValueType:=GetName(aMap.ValueType);
 //  ValueType:=GetName(aMap.ValueType);
   lReadOnly:=aMap.IsReadonly;
   lReadOnly:=aMap.IsReadonly;
-  AddLn('function get(key: %s) : %s;',[KeyType,ValueType]);
-  AddLn('function has(key: %s) : Boolean;',[KeyType]);
-  AddLn('function entries : IJSIterator;');
-  AddLn('function keys : IJSIterator;');
-  AddLn('function values : IJSIterator;');
-  Inc(Result,5);
-  if not lReadOnly then
-    begin
-    AddLn('procedure set_(key: %s; value : %s);',[KeyType,ValueType]);
-    AddLn('procedure clear;');
-    AddLn('procedure delete(key: %s);');
-    Inc(Result,3);
-    end;
+  L:=TIDLDefinitionList.Create(Nil,False);
+  try
+    aParent.GetFullMemberList(L);
+    if Not L.HasName('get') then
+      AddLn('function get(key: %s) : %s;',[KeyType,ValueType]);
+    if Not L.HasName('has') then
+    AddLn('function has(key: %s) : Boolean;',[KeyType]);
+    if Not L.HasName('entries') then
+      AddLn('function entries : IJSIterator;');
+    if Not L.HasName('keys') then
+      AddLn('function keys : IJSIterator;');
+    if Not L.HasName('values') then
+      AddLn('function values : IJSIterator;');
+    Inc(Result,5);
+    if not lReadOnly then
+      begin
+      if Not L.HasName('set') then
+        AddLn('procedure set_(key: %s; value : %s);',[KeyType,ValueType]);
+      if Not L.HasName('clear') then
+        AddLn('procedure clear;');
+      if Not L.HasName('delete') then
+        AddLn('procedure delete(key: %s);',[KeyType]);
+      Inc(Result,3);
+      end;
+  finally
+    L.Free;
+  end;
 end;
 end;
 
 
 function TBaseWebIDLToPas.WriteUtilityMethods(Intf: TIDLStructuredDefinition
 function TBaseWebIDLToPas.WriteUtilityMethods(Intf: TIDLStructuredDefinition
@@ -1484,7 +1507,7 @@ begin
       begin
       begin
       CD:=TIDLArgumentDefinition.Create(Nil,aName,PosEl.SrcFile,PosEl.Line,PosEl.Column);
       CD:=TIDLArgumentDefinition.Create(Nil,aName,PosEl.SrcFile,PosEl.Line,PosEl.Column);
       if PosEl is TIDLTypeDefDefinition then
       if PosEl is TIDLTypeDefDefinition then
-        CD.ArgumentType:=TIDLTypeDefDefinitionClass(Posel.ClassType).Create(CD,'',PosEl.SrcFile,PosEl.Line,PosEl.Column)
+        CD.ArgumentType:=TIDLTypeDefDefinition(PosEl).Clone(CD)
       else
       else
         CD.ArgumentType:=TIDLTypeDefDefinition.Create(CD,'',PosEl.SrcFile,PosEl.Line,PosEl.Column);
         CD.ArgumentType:=TIDLTypeDefDefinition.Create(CD,'',PosEl.SrcFile,PosEl.Line,PosEl.Column);
       CD.ArgumentType.TypeName:=aTypeName;
       CD.ArgumentType.TypeName:=aTypeName;
@@ -1593,9 +1616,10 @@ function TBaseWebIDLToPas.CloneArgument(Arg: TIDLArgumentDefinition
   ): TIDLArgumentDefinition;
   ): TIDLArgumentDefinition;
 begin
 begin
   Result:=Arg.Clone(nil);
   Result:=Arg.Clone(nil);
-  ResolveTypeDef(Result);
+  ResolveTypeDef(Result.ArgumentType);
   if Arg.Data<>nil then
   if Arg.Data<>nil then
     Result.Data:=ClonePasData(TPasData(Arg.Data),Result);
     Result.Data:=ClonePasData(TPasData(Arg.Data),Result);
+//  if Assigned(Result.ArgumentType)
 end;
 end;
 
 
 procedure TBaseWebIDLToPas.AddOverloads(aList: TFPObjectlist;
 procedure TBaseWebIDLToPas.AddOverloads(aList: TFPObjectlist;
@@ -1833,6 +1857,8 @@ begin
   Indent;
   Indent;
   WriteForwardClassDefs(Context.Definitions);
   WriteForwardClassDefs(Context.Definitions);
   WriteEnumDefs(Context.Definitions);
   WriteEnumDefs(Context.Definitions);
+  // Callbacks
+  WriteFunctionImplicitTypes(Context.Definitions);
   WriteTypeDefsAndCallbacks(Context.Definitions);
   WriteTypeDefsAndCallbacks(Context.Definitions);
   WriteDictionaryDefs(Context.Definitions);
   WriteDictionaryDefs(Context.Definitions);
   WriteInterfaceDefs(Context.GetInterfacesTopologically);
   WriteInterfaceDefs(Context.GetInterfacesTopologically);
@@ -2215,8 +2241,46 @@ begin
 end;
 end;
 
 
 function TBaseWebIDLToPas.ConvertDef(D: TIDLDefinition): Boolean;
 function TBaseWebIDLToPas.ConvertDef(D: TIDLDefinition): Boolean;
+
+var
+  AD : TIDLAttributeDefinition absolute D;
+  FD : TIDLFunctionDefinition;
+  A,RT : TIDLDefinition;
+  FAD : TIDLArgumentDefinition absolute A;
+  RN,N : String;
+
 begin
 begin
   Result:=(coChromeWindow in BaseOptions) or Not D.HasSimpleAttribute('ChromeOnly');
   Result:=(coChromeWindow in BaseOptions) or Not D.HasSimpleAttribute('ChromeOnly');
+  if not Result then
+    exit;
+  if (D is TIDLAttributeDefinition) and Assigned(AD.AttributeType) then
+    begin
+    ResolveTypeDef(AD.AttributeType);
+    RT:=GetResolvedType(AD.AttributeType,N,RN);
+    Result:=ConvertDef(RT);
+    end
+  else if (D is TIDLFunctionDefinition) then
+    begin
+    FD:=TIDLFunctionDefinition(D);
+    For A in FD.Arguments do
+      begin
+      ResolveTypeDef(FAD.ArgumentType);
+      RT:=GetResolvedType(FAD.ArgumentType,N,RN);
+      Result:=ConvertDef(RT);
+      if not Result then break;
+      end;
+    end
+  else if (D is TIDLCallbackDefinition) then
+    begin
+    FD:=TIDLCallbackDefinition(D).FunctionDef;
+    For A in FD.Arguments do
+      begin
+      ResolveTypeDef(FAD.ArgumentType);
+      RT:=GetResolvedType(FAD.ArgumentType,N,RN);
+      Result:=ConvertDef(RT);
+      if not Result then break;
+      end;
+    end;
 end;
 end;
 
 
 function TBaseWebIDLToPas.FindGlobalDef(const aName: UTF8String
 function TBaseWebIDLToPas.FindGlobalDef(const aName: UTF8String

+ 25 - 10
packages/webidl/src/webidltowasmjob.pp

@@ -1413,11 +1413,12 @@ var
 begin
 begin
   for I:=0 to Context.Definitions.Count-1 do
   for I:=0 to Context.Definitions.Count-1 do
     if Context.Definitions[i] is TIDLNamespaceDefinition then
     if Context.Definitions[i] is TIDLNamespaceDefinition then
-      begin
-      VarName:=Context.Definitions[i].Name;
-      VarType:=GetPasIntfName(Context.Definitions[i]);
-      AddLn(VarName+': '+VarType+';');
-      end;
+      if ConvertDef(Context.Definitions[i]) then
+        begin
+        VarName:=Context.Definitions[i].Name;
+        VarType:=GetPasIntfName(Context.Definitions[i]);
+        AddLn(VarName+': '+VarType+';');
+        end;
 end;
 end;
 
 
 procedure TWebIDLToPasWasmJob.WriteGlobalVar(aDef : String);
 procedure TWebIDLToPasWasmJob.WriteGlobalVar(aDef : String);
@@ -1578,12 +1579,26 @@ end;
 
 
 procedure TWebIDLToPasWasmJob.WriteMapLikeFunctionImplementations(aDef : TIDLStructuredDefinition; MD : TIDLMapLikeDefinition);
 procedure TWebIDLToPasWasmJob.WriteMapLikeFunctionImplementations(aDef : TIDLStructuredDefinition; MD : TIDLMapLikeDefinition);
 
 
+Var
+  L : TIDLDefinitionList;
+
 begin
 begin
-  WriteMapLikeGetFunctionImplementation(aDef,MD);
-  WriteMapLikeHasFunctionImplementation(aDef,MD);
-  WriteMapLikeEntriesFunctionImplementation(aDef,MD);
-  WriteMapLikeKeysFunctionImplementation(aDef,MD);
-  WriteMapLikeValuesFunctionImplementation(aDef,MD);
+  L:=TIDLDefinitionList.Create(Nil,False);
+  try
+    aDef.GetFullMemberList(L);
+    if not L.HasName('get') then
+      WriteMapLikeGetFunctionImplementation(aDef,MD);
+    if not L.HasName('has') then
+      WriteMapLikeHasFunctionImplementation(aDef,MD);
+    if not L.HasName('entries') then
+      WriteMapLikeEntriesFunctionImplementation(aDef,MD);
+    if not L.HasName('keys') then
+      WriteMapLikeKeysFunctionImplementation(aDef,MD);
+    if not L.HasName('values') then
+      WriteMapLikeValuesFunctionImplementation(aDef,MD);
+  finally
+    L.Free;
+  end;
 end;
 end;
 
 
 procedure TWebIDLToPasWasmJob.WriteUtilityMethodImplementations(aDef : TIDLStructuredDefinition; ML : TIDLDefinitionList);
 procedure TWebIDLToPasWasmJob.WriteUtilityMethodImplementations(aDef : TIDLStructuredDefinition; ML : TIDLDefinitionList);

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

@@ -70,6 +70,7 @@ type
     procedure TestWJ_IntfFunction_DictionaryResult;
     procedure TestWJ_IntfFunction_DictionaryResult;
     procedure TestWJ_IntfFunction_AliasResult;
     procedure TestWJ_IntfFunction_AliasResult;
     procedure TestWJ_IntfFunction_NestedUnionSequence;
     procedure TestWJ_IntfFunction_NestedUnionSequence;
+    procedure TestWJ_intfFunction_UnionOptional;
     // Namespace attribute
     // Namespace attribute
     procedure TestWJ_NamespaceAttribute_Boolean;
     procedure TestWJ_NamespaceAttribute_Boolean;
     // maplike
     // maplike
@@ -1596,6 +1597,72 @@ begin
 ]);
 ]);
 end;
 end;
 
 
+procedure TTestWebIDL2WasmJob.TestWJ_intfFunction_UnionOptional;
+begin
+  TestwebIDL(
+  ['interface Attr {',
+  '  void roundRect((DOMString or sequence<DOMString>) a, optional long b);',
+  '};'
+  ],[
+  'Type',
+  '',
+  '  // Forward class definitions',
+  '  IJSAttr = interface;',
+  '  TJSAttr = class;',
+  '',
+  '  { --------------------------------------------------------------------',
+  '    TJSAttr',
+  '    --------------------------------------------------------------------}',
+  '  TUnicodeStringDynArray = IJSArray; // array of UnicodeString',
+  '  IJSAttr = interface(IJSObject)',
+  '    [''{AA94F48A-0CA1-3A6F-A546-208CA4B2AF2A}'']',
+  '    procedure roundRect(const a: UnicodeString; aB: Integer); overload;',
+  '    procedure roundRect(const a: TUnicodeStringDynArray; aB: Integer); overload;',
+  '    procedure roundRect(const a: TUnicodeStringDynArray); overload;',
+  '    procedure roundRect(const a: UnicodeString); overload;',
+  '  end;',
+  '',
+  '  TJSAttr = class(TJSObject,IJSAttr)',
+  '  Private',
+  '  Public',
+  '    procedure roundRect(const a: UnicodeString; aB: Integer); overload;',
+  '    procedure roundRect(const a: TUnicodeStringDynArray; aB: Integer); overload;',
+  '    procedure roundRect(const a: TUnicodeStringDynArray); overload;',
+  '    procedure roundRect(const a: UnicodeString); overload;',
+  '    class function Cast(const Intf: IJSObject): IJSAttr;',
+  '  end;',
+  '',
+  'implementation',
+  '',
+  'procedure TJSAttr.roundRect(const a: UnicodeString; aB: Integer); overload;',
+  'begin',
+  '  InvokeJSNoResult(''roundRect'',[a,aB]);',
+  'end;',
+  '',
+  'procedure TJSAttr.roundRect(const a: TUnicodeStringDynArray; aB: Integer); overload;',
+  'begin',
+  '  InvokeJSNoResult(''roundRect'',[a,aB]);',
+  'end;',
+  '',
+  'procedure TJSAttr.roundRect(const a: TUnicodeStringDynArray); overload;',
+  'begin',
+  '  InvokeJSNoResult(''roundRect'',[a]);',
+  'end;',
+  '',
+  'procedure TJSAttr.roundRect(const a: UnicodeString); overload;',
+  'begin',
+  '  InvokeJSNoResult(''roundRect'',[a]);',
+  '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