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

* Fix code generation for dictionary with parent

Browse Source
This commit is contained in:
Michaël Van Canneyt 2024-04-28 12:32:08 +02:00
parent 1b0a1254ad
commit f89a2b8432
4 changed files with 134 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
packages/webidl/src/webidltopas.pp
View File

@ -177,6 +177,7 @@ type
procedure AddGlobalJSIdentifier(D: TIDLDefinition); virtual;
procedure ResolveParentInterfaces(aList: TIDLDefinitionList); virtual;
procedure ResolveParentInterface(Intf: TIDLInterfaceDefinition); virtual;
procedure ResolveParentInterface(Intf: TIDLDictionaryDefinition); virtual;
procedure ResolveTypeDefs(aList: TIDLDefinitionList); virtual;
procedure ResolveTypeDef(D: TIDLDefinition); virtual;
procedure RemoveInterfaceForwards(aList: TIDLDefinitionList); virtual;
@ -2689,7 +2690,9 @@ var
begin
For D in aList do
if D is TIDLInterfaceDefinition then
ResolveParentInterface(TIDLInterfaceDefinition(D));
ResolveParentInterface(TIDLInterfaceDefinition(D))
else if D is TIDLDictionaryDefinition then
ResolveParentInterface(TIDLDictionaryDefinition(D));
end;
procedure TBaseWebIDLToPas.ResolveParentInterface(Intf: TIDLInterfaceDefinition
@ -2704,6 +2707,18 @@ begin
Intf.ParentInterface:=TIDLInterfaceDefinition(aDef);
end;
procedure TBaseWebIDLToPas.ResolveParentInterface(Intf: TIDLDictionaryDefinition
);
var
aDef: TIDLDefinition;
begin
if Intf.ParentDictionary<>nil then exit;
if Intf.ParentName='' then exit;
aDef:=FindGlobalDef(Intf.ParentName);
if aDef is TIDLDictionaryDefinition then
Intf.ParentDictionary:=TIDLDictionaryDefinition(aDef);
end;
procedure TBaseWebIDLToPas.ResolveTypeDefs(aList: TIDLDefinitionList);
var
D: TIDLDefinition;

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

@ -493,7 +493,7 @@ begin
else
ParentName:=GetPascalTypeName(Intf.ParentName);
sdDictionary:
if Assigned(dDict.ParentDictionary) then
if Assigned(dDict.ParentDictionary) then
ParentName:=GetPasIntfName(dDict.ParentDictionary as TIDLDictionaryDefinition)
else
ParentName:=GetPascalTypeName(dDict.ParentName);

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

@ -51,6 +51,7 @@ type
procedure TestWJ_Typedef_Sequence;
procedure TestWJ_Typedef_Aliased;
procedure TestWJ_Typedef_Dictionary;
procedure TestWJ_Typedef_DictionaryWithParent;
// attributes
procedure TestWJ_IntfAttribute_Boolean;
@ -552,6 +553,120 @@ begin
'']);
end;
procedure TTestWebIDL2WasmJob.TestWJ_Typedef_DictionaryWithParent;
begin
TestWebIDL([
'dictionary Attr {',
' boolean aBoolean;',
'};',
'dictionary Attr2 : Attr {',
' long aLong;',
'};',
''],
['Type',
' // Forward class definitions',
' IJSAttr = interface;',
' TJSAttr = class;',
' IJSAttr2 = interface;',
' TJSAttr2 = class;',
' { --------------------------------------------------------------------',
' TJSAttr',
' --------------------------------------------------------------------}',
'',
' TJSAttrRec = record',
' aBoolean: Boolean;',
' end;',
'',
' IJSAttr = interface(IJSObject)',
' ['''+FixedGUID+''']',
' function _GetaBoolean: Boolean;',
' procedure _SetaBoolean(const aValue: Boolean);',
' property aBoolean: Boolean read _GetaBoolean write _SetaBoolean;',
' end;',
'',
' TJSAttr = class(TJSObject,IJSAttr)',
' Private',
' function _GetaBoolean: Boolean;',
' procedure _SetaBoolean(const aValue: Boolean);',
' Public',
' class function JSClassName: UnicodeString; override;',
' class function Cast(const Intf: IJSObject): IJSAttr;',
' property aBoolean: Boolean read _GetaBoolean write _SetaBoolean;',
' end;',
'',
' { --------------------------------------------------------------------',
' TJSAttr2',
' --------------------------------------------------------------------}',
'',
' TJSAttr2Rec = record',
' aLong: LongInt;',
' aBoolean: Boolean;',
' end;',
'',
' IJSAttr2 = interface(IJSAttr)',
' ['''+FixedGUID+''']',
' function _GetaLong: LongInt;',
' procedure _SetaLong(const aValue: LongInt);',
' property aLong: LongInt read _GetaLong write _SetaLong;',
' end;',
'',
' TJSAttr2 = class(TJSAttr,IJSAttr2)',
' Private',
' function _GetaLong: LongInt;',
' procedure _SetaLong(const aValue: LongInt);',
' Public',
' class function JSClassName: UnicodeString; override;',
' class function Cast(const Intf: IJSObject): IJSAttr2;',
' property aLong: LongInt read _GetaLong write _SetaLong;',
' end;',
'',
'implementation',
'',
'function TJSAttr._GetaBoolean: Boolean;',
'begin',
' Result:=ReadJSPropertyBoolean(''aBoolean'');',
'end;',
'',
'procedure TJSAttr._SetaBoolean(const aValue: Boolean);',
'begin',
' WriteJSPropertyBoolean(''aBoolean'',aValue);',
'end;',
'',
'class function TJSAttr.JSClassName: UnicodeString;',
'begin',
' Result:=''Object'';',
'end;',
'',
'class function TJSAttr.Cast(const Intf: IJSObject): IJSAttr;',
'begin',
' Result:=TJSAttr.JOBCast(Intf);',
'end;',
'',
'function TJSAttr2._GetaLong: LongInt;',
'begin',
' Result:=ReadJSPropertyLongInt(''aLong'');',
'end;',
'',
'procedure TJSAttr2._SetaLong(const aValue: LongInt);',
'begin',
' WriteJSPropertyLongInt(''aLong'',aValue);',
'end;',
'',
'class function TJSAttr2.JSClassName: UnicodeString;',
'begin',
' Result:=''Object'';',
'end;',
'',
'class function TJSAttr2.Cast(const Intf: IJSObject): IJSAttr2;',
'begin',
' Result:=TJSAttr2.JOBCast(Intf);',
'end;',
'',
'end.',
'']);
end;
procedure TTestWebIDL2WasmJob.TestWJ_IntfAttribute_Boolean;
begin
TestWebIDL([

4
packages/webidl/tests/testidl.lpi
View File

@ -22,13 +22,13 @@
</PublishOptions>
<RunParams>
<local>
<CommandLineParams Value="--suite=TTestWebIDL2WasmJob.TestWJ_Typedef_Dictionary"/>
<CommandLineParams Value="--suite=TTestWebIDL2WasmJob.TestWJ_Typedef_DictionaryWithParent"/>
</local>
<FormatVersion Value="2"/>
<Modes Count="1">
<Mode0 Name="default">
<local>
<CommandLineParams Value="--suite=TTestWebIDL2WasmJob.TestWJ_Typedef_Dictionary"/>
<CommandLineParams Value="--suite=TTestWebIDL2WasmJob.TestWJ_Typedef_DictionaryWithParent"/>
</local>
</Mode0>
</Modes>