Browse Source

* Add sequence support

Michaël Van Canneyt 1 year ago
parent
commit
a08b15831b

+ 25 - 3
packages/webidl/src/webidltopas.pp

@@ -634,13 +634,18 @@ function TBaseWebIDLToPas.AddSequenceDef(ST: TIDLSequenceTypeDefDefinition
 var
   TN: String;
 begin
-  TN:=GetTypeName(ST);
+  if ST.Data=Nil then
+    begin
+    TN:=GetTypeName(ST);
+    ST.Data:=CreatePasData(TN,ST,true);
+    end
+  else
+    TN:=TPasData(ST.Data).PasName;
   Result:=FAutoTypes.IndexOf(TN)=-1;
   if Result then
     begin
     FAutoTypes.Add(TN);
     DoLog('Automatically adding %s sequence definition for %s.',[TN,GetDefPos(ST)]);
-    ST.Data:=CreatePasData(TN,ST,true);
     WriteSequenceDef(ST);
     end;
 end;
@@ -1827,6 +1832,7 @@ function TBaseWebIDLToPas.AllocatePasName(D: TIDLDefinition; ParentName: String)
 Var
   CN: String;
   aData: TPasData;
+  sDef : TIDLDefinition;
 
 begin
   //writeln('TBaseWebIDLToPas.AllocatePasName ',ParentName,'.',D.Name,':',D.ClassName);
@@ -1865,6 +1871,22 @@ begin
     D.Data:=Result;
     AllocatePasNames((D as TIDLDictionaryDefinition).Members,D.Name);
     end
+  else if D Is TIDLSequenceTypeDefDefinition then
+    begin
+    CN:=GetTypeName(TIDLSequenceTypeDefDefinition(D));
+    sDef:=FindGlobalDef(CN);
+    if (SDef=Nil) or (sDef.Data=Nil) then
+      Result:=CreatePasData(EscapeKeyWord(CN),D,true)
+    else
+      Result:=ClonePasData(TPasData(sDef.Data),D);
+    D.Data:=Result;
+    end
+  else if D Is TIDLArgumentDefinition then
+    begin
+    Result:=CreatePasData(CN,D,true);
+    D.Data:=Result;
+    AllocatePasName(TIDLArgumentDefinition(D).ArgumentType,ParentName+'_'+D.Name);
+    end
   else
     begin
     if (D is TIDLTypeDefDefinition)
@@ -1877,7 +1899,7 @@ begin
     Result:=CreatePasData(CN,D,true);
     D.Data:=Result;
     if D Is TIDLFunctionDefinition then
-      AllocatePasNames((D as TIDLFunctionDefinition).Arguments,D.Name);
+      AllocatePasNames((D as TIDLFunctionDefinition).Arguments,D.Name)
     end;
   aData:=TPasData(D.Data);
   if Verbose and (aData.PasName<>D.Name) then

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

@@ -425,6 +425,7 @@ begin
   finally
     FGeneratingInterface:=False;
   end;
+
 end;
 
 function TWebIDLToPasWasmJob.WritePrivateGetters(aParent: TIDLStructuredDefinition;
@@ -730,15 +731,7 @@ begin
             Args:=Args+',';
           ArgName:=GetArgName(ArgDef);
           ArgType:=GetResolvedType(ArgDef.ArgumentType,ArgTypeName,ArgResolvedTypeName);
-          //writeln('TWebIDLToPasWasmJob.WriteFunctionDefinition ',ArgType.Name,':',ArgType.ClassName,' ',ArgResolvedTypeName,' ArgType=',hexstr(ptruint(ArgType),sizeof(ptruint)*2));
-          if ArgType is TIDLSequenceTypeDefDefinition then
-            begin
-            ArgTypeName:=TIDLSequenceTypeDefDefinition(ArgType).ElementType.TypeName;
-            if Verbose then
-              writeln('Hint: TWebIDLToPasWasmJob.WriteFunctionDefinition sequence of ',ArgTypeName);
-            raise EConvertError.Create('[20220725172246] not yet supported: passing an array of '+ArgTypeName+' as argument at '+GetDefPos(ArgDef));
-            end
-          else if (ArgType is TIDLFunctionDefinition) and (foCallBack in TIDLFunctionDefinition(ArgType).Options) then
+          if (ArgType is TIDLFunctionDefinition) and (foCallBack in TIDLFunctionDefinition(ArgType).Options) then
             begin
             LocalName:=CreateLocal('m');
             VarSection:=Concat(VarSection,[ (LocalName+': '+JOB_JSValueTypeNames[jivkMethod]+';')]);
@@ -1283,8 +1276,13 @@ end;
 
 procedure TWebIDLToPasWasmJob.WriteSequenceDef(
   aDef: TIDLSequenceTypeDefDefinition);
+
+var
+  aLine : String;
+
 begin
-  Addln(GetName(aDef)+' = '+PasInterfacePrefix+'Array'+PasInterfaceSuffix+'; // array of '+GetTypeName(aDef.ElementType));
+  aLine:=GetName(aDef)+' = '+PasInterfacePrefix+'Array'+PasInterfaceSuffix+'; // array of '+GetTypeName(aDef.ElementType);
+  Addln(aLine);
 end;
 
 procedure TWebIDLToPasWasmJob.WriteNamespaceVars;

+ 97 - 4
packages/webidl/tests/tcwebidl2wasmjob.pas

@@ -53,6 +53,7 @@ type
     procedure TestWJ_IntfFunction_ArgAny;
     procedure TestWJ_IntfFunction_EnumResult;
     procedure TestWJ_IntfFunction_SequenceArg;
+    procedure TestWJ_IntfFunction_2SequenceArg;
     procedure TestWJ_IntfFunction_Constructor;
     procedure TestWJ_IntfFunction_ArrayBufferArg;
     procedure TestWJ_IntfFunction_ArrayBufferViewArg;
@@ -897,13 +898,105 @@ end;
 procedure TTestWebIDL2WasmJob.TestWJ_IntfFunction_SequenceArg;
 begin
   TestWebIDL([
-  'namespace Attr {',
-  '    boolean vibrate(sequence<long> pattern);',
+  'interface Attr {',
+  '  boolean vibrate(sequence<long> pattern);',
   '};',
   ''],
+  [
+   'Type',
+   '',
+   '  // Forward class definitions',
+   '  IJSAttr = interface;',
+   '  TJSAttr = class;',
+   '',
+   '  { --------------------------------------------------------------------',
+   '    TJSAttr',
+   '    --------------------------------------------------------------------}',
+   '',
+   '  TIntegerDynArray = IJSArray; // array of Integer',
+   '',
+   '  IJSAttr = interface(IJSObject)',
+   '    [''{AA94F48A-2BFB-3877-82A6-208CA4B2AF2A}'']',
+   '    function vibrate(const aPattern: TIntegerDynArray): Boolean;',
+   '  end;',
+   '',
+   '  TJSAttr = class(TJSObject,IJSAttr)',
+   '  Private',
+   '  Public',
+   '     function vibrate(const aPattern: TIntegerDynArray): Boolean;',
+   '     class function Cast(const Intf: IJSObject): IJSAttr;',
+   '  end;',
+   '',
+   'implementation',
+   '',
+   'function TJSAttr.vibrate(const aPattern: TIntegerDynArray): Boolean;',
+   'begin',
+   '  Result:=InvokeJSBooleanResult(''vibrate'',[aPattern]);',
+   'end;',
+   '',
+   'class function TJSAttr.Cast(const Intf: IJSObject): IJSAttr;',
+   'begin',
+   '  Result:=TJSAttr.JOBCast(Intf);',
+   'end;',
+   '',
+   'end.'
+    ]);
+end;
 
-  []);
-
+procedure TTestWebIDL2WasmJob.TestWJ_IntfFunction_2SequenceArg;
+begin
+  TestWebIDL([
+  'interface Attr {',
+  '  boolean vibrate(sequence<long> pattern);',
+  '  boolean beep(sequence<long> pattern);',
+  '};',
+  ''],
+  [
+   'Type',
+   '',
+   '  // Forward class definitions',
+   '  IJSAttr = interface;',
+   '  TJSAttr = class;',
+   '',
+   '  { --------------------------------------------------------------------',
+   '    TJSAttr',
+   '    --------------------------------------------------------------------}',
+   '',
+   '  TIntegerDynArray = IJSArray; // array of Integer',
+   '',
+   '  IJSAttr = interface(IJSObject)',
+   '    [''{AA94F48A-8A01-3EFF-A44E-4EDCA4B2AF2A}'']',
+   '    function vibrate(const aPattern: TIntegerDynArray): Boolean;',
+   '    function beep(const aPattern: TIntegerDynArray): Boolean;',
+   '  end;',
+   '',
+   '  TJSAttr = class(TJSObject,IJSAttr)',
+   '  Private',
+   '  Public',
+   '     function vibrate(const aPattern: TIntegerDynArray): Boolean;',
+   '     function beep(const aPattern: TIntegerDynArray): Boolean;',
+   '     class function Cast(const Intf: IJSObject): IJSAttr;',
+   '  end;',
+   '',
+   'implementation',
+   '',
+   'function TJSAttr.vibrate(const aPattern: TIntegerDynArray): Boolean;',
+   'begin',
+   '  Result:=InvokeJSBooleanResult(''vibrate'',[aPattern]);',
+   'end;',
+   '',
+   'function TJSAttr.beep(const aPattern: TIntegerDynArray): Boolean;',
+   'begin',
+   '  Result:=InvokeJSBooleanResult(''beep'',[aPattern]);',
+   'end;',
+   '',
+   'class function TJSAttr.Cast(const Intf: IJSObject): IJSAttr;',
+   'begin',
+   '  Result:=TJSAttr.JOBCast(Intf);',
+   'end;',
+   '',
+   'end.'
+    ]);
 end;
 
 procedure TTestWebIDL2WasmJob.TestWJ_IntfFunction_Constructor;