mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-08 13:02:46 +02:00
* Add sequence support
This commit is contained in:
Michaël Van Canneyt
parent
b40c20b53b
commit
a08b15831b
@ -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
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user