paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-06-20 03:18:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Add dictionary-typed result support

Browse Source
This commit is contained in:
Michaël Van Canneyt 2024-04-11 12:12:25 +02:00
parent 70b2f29b92
commit c720e30fac
2 changed files with 62 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
packages/webidl/src/webidltowasmjob.pp
View File

@ -579,6 +579,8 @@ begin
Result:=ClassPrefix+'Promise'+ClassSuffix Result:=ClassPrefix+'Promise'+ClassSuffix
else if aResultDef is TIDLInterfaceDefinition then else if aResultDef is TIDLInterfaceDefinition then
Result:=GetName(aResultDef) Result:=GetName(aResultDef)
else if aResultDef is TIDLDictionaryDefinition then
Result:=GetName(aResultDef)
else if aName=PasInterfacePrefix+'Object'+PasInterfaceSuffix then else if aName=PasInterfacePrefix+'Object'+PasInterfaceSuffix then
begin begin
Result:=ClassPrefix+'Object'+ClassSuffix; Result:=ClassPrefix+'Object'+ClassSuffix;

61
packages/webidl/tests/tcwebidl2wasmjob.pas
View File

@ -5,7 +5,7 @@ unit tcwebidl2wasmjob;
interface interface
uses uses
Classes, SysUtils, fpcunit, testregistry, webidlscanner, webidltowasmjob, pascodegen; Classes, SysUtils, fpcunit, testregistry, webidlscanner, webidltopas, webidltowasmjob, pascodegen;
type type
@ -62,6 +62,7 @@ type
procedure TestWJ_IntfFunction_GlobalSequenceResult; procedure TestWJ_IntfFunction_GlobalSequenceResult;
procedure TestWJ_IntfFunction_ChromeOnly; procedure TestWJ_IntfFunction_ChromeOnly;
procedure TestWJ_IntfFunction_ChromeOnlyNewObject; procedure TestWJ_IntfFunction_ChromeOnlyNewObject;
procedure TestWJ_IntfFunction_DictionaryResult;
// Namespace attribute // Namespace attribute
procedure TestWJ_NamespaceAttribute_Boolean; procedure TestWJ_NamespaceAttribute_Boolean;
// maplike // maplike
@ -1347,6 +1348,64 @@ begin
]); ]);
end; end;
procedure TTestWebIDL2WasmJob.TestWJ_IntfFunction_DictionaryResult;
begin
WebIDLToPas.BaseOptions:=WebIDLToPas.BaseOptions+[coDictionaryAsClass];
TestWebIDL([
'dictionary MyDict { long a = 0; };',
'interface Attr {',
' MyDict get();',
'};',
''],
[
'Type',
'',
' // Forward class definitions',
' IJSAttr = interface;',
' TJSAttr = class;',
// '',
' TJSMyDict = TJOB_Dictionary;',
'',
' { --------------------------------------------------------------------',
' TJSMyDict',
' --------------------------------------------------------------------}',
'',
' TJSMyDictRec = record',
' a: Integer;',
' end;',
' { --------------------------------------------------------------------',
' TJSAttr',
' --------------------------------------------------------------------}',
'',
'',
' IJSAttr = interface(IJSObject)',
' [''{AA94F48A-B218-381A-A2A6-208CA4B2AF2A}'']',
' function get: TJSMyDict;',
' end;',
'',
' TJSAttr = class(TJSObject,IJSAttr)',
' Private',
' Public',
' function get: TJSMyDict;',
' class function Cast(const Intf: IJSObject): IJSAttr;',
' end;',
'',
'implementation',
'',
'function TJSAttr.get: TJSMyDict;',
'begin',
' Result:=InvokeJSObjectResult(''get'',[],TJSMyDict) as TJSMyDict;',
'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