paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-13 11:59:19 +02:00
Code Issues Packages Projects Releases Wiki Activity

webidl: test interface function setEventHandler

Browse Source
This commit is contained in:
mattias 2022-08-25 12:11:39 +02:00
parent ad64eb7af8
commit 0acab89b0b
2 changed files with 121 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -244,7 +244,7 @@ function TWebIDLToPasWasmJob.GetTypeName(const aTypeName: String;
begin begin
Case aTypeName of Case aTypeName of
'union', 'union',
'any': Result:=JOB_JSValueTypeNames[jjvkUndefined]; 'any': Result:='Variant';
'void','undefined': Result:=aTypeName; 'void','undefined': Result:=aTypeName;
else else
//writeln('TWebIDLToPasWasmJob.GetTypeName ',aTypeName,' ',Def<>nil); //writeln('TWebIDLToPasWasmJob.GetTypeName ',aTypeName,' ',Def<>nil);

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

@ -39,6 +39,11 @@ type
// attributes // attributes
procedure TestWJ_IntfAttribute_Boolean; procedure TestWJ_IntfAttribute_Boolean;
// todo procedure TestWJ_IntfAttribute_Any;
// functions
procedure TestWJ_IntfFunction_Void;
procedure TestWJ_IntfFunction_SetEventHandler;
end; end;
function LinesToStr(Args: array of const): string; function LinesToStr(Args: array of const): string;
@ -325,14 +330,14 @@ begin
InputMS.Position:=0; InputMS.Position:=0;
{$IFDEF VerboseWebidl2WasmJob} {$IFDEF VerboseWebidl2WasmJob}
writeln('TCustomTestWebIDL2WasmJob.TestWebIDL ExpectedPascal:--------------'); writeln('TCustomTestWebIDL2WasmJob.TestWebIDL ExpectedPascal: BEGIN--------');
{$ENDIF} {$ENDIF}
ExpectedSrc:=HeaderSrc; ExpectedSrc:=HeaderSrc;
for i:=0 to high(ExpectedPascalSrc) do for i:=0 to high(ExpectedPascalSrc) do
ExpectedSrc:=ExpectedSrc+ExpectedPascalSrc[i]+sLineBreak; ExpectedSrc:=ExpectedSrc+ExpectedPascalSrc[i]+sLineBreak;
{$IFDEF VerboseWebidl2WasmJob} {$IFDEF VerboseWebidl2WasmJob}
writeln(ExpectedSrc); writeln(ExpectedSrc);
writeln('TCustomTestWebIDL2WasmJob.TestWebIDL -----------------------------'); writeln('TCustomTestWebIDL2WasmJob.TestWebIDL ExpectedPascal END-----------');
{$ENDIF} {$ENDIF}
WebIDLToPas.Execute; WebIDLToPas.Execute;
@ -342,6 +347,11 @@ begin
Move(InputMS.Memory^,InputSrc[1],length(InputSrc)); Move(InputMS.Memory^,InputSrc[1],length(InputSrc));
OutputSrc:=WebIDLToPas.Source.Text; OutputSrc:=WebIDLToPas.Source.Text;
{$IFDEF VerboseWebidl2WasmJob}
writeln('TCustomTestWebIDL2WasmJob.TestWebIDL ActualPascal: BEGIN----------');
writeln(OutputSrc);
writeln('TCustomTestWebIDL2WasmJob.TestWebIDL ActualPascal: END------------');
{$ENDIF}
CheckDiff('TCustomTestWebIDL2WasmJob.TestWebIDL',ExpectedSrc,OutputSrc); CheckDiff('TCustomTestWebIDL2WasmJob.TestWebIDL',ExpectedSrc,OutputSrc);
end; end;
@ -448,6 +458,114 @@ begin
'']); '']);
end; end;
procedure TTestWebIDL2WasmJob.TestWJ_IntfFunction_Void;
begin
TestWebIDL([
'interface Attr {',
' void append(Attr node);',
'};',
''],
['Type',
' // Forward class definitions',
' IJSAttr = interface;',
' TJSAttr = class;',
' { --------------------------------------------------------------------',
' TJSAttr',
' --------------------------------------------------------------------}',
'',
' IJSAttr = interface(IJSObject)',
' [''{AA94F48A-84D7-3FAA-A2A6-208CA4B2AF2A}'']',
' procedure append(aNode: IJSAttr);',
' end;',
'',
' TJSAttr = class(TJSObject,IJSAttr)',
' Private',
' Public',
' procedure append(aNode: IJSAttr);',
' class function Cast(Intf: IJSObject): IJSAttr;',
' end;',
'',
'implementation',
'',
'procedure TJSAttr.append(aNode: IJSAttr);',
'begin',
' InvokeJSNoResult(''append'',[aNode]);',
'end;',
'',
'class function TJSAttr.Cast(Intf: IJSObject): IJSAttr;',
'begin',
' Result:=TJSAttr.JOBCast(Intf);',
'end;',
'',
'end.',
'']);
end;
procedure TTestWebIDL2WasmJob.TestWJ_IntfFunction_SetEventHandler;
begin
TestWebIDL([
'[LegacyTreatNonObjectAsNull]',
'callback EventHandlerNonNull = any (long event);',
'typedef EventHandlerNonNull? EventHandler;',
'',
'interface Attr {',
' void setEventHandler([TreatNonCallableAsNull] EventHandler handler);',
'};',
''],
['Type',
' // Forward class definitions',
' IJSAttr = interface;',
' TJSAttr = class;',
' TEventHandlerNonNull = function (event: Integer): Variant of object;',
' TEventHandler = TEventHandlerNonNull;',
'',
' { --------------------------------------------------------------------',
' TJSAttr',
' --------------------------------------------------------------------}',
'',
' IJSAttr = interface(IJSObject)',
' [''{AA94F48A-121D-33BC-96FE-420246F2AF2A}'']',
' procedure setEventHandler(const aHandler: TEventHandler);',
' end;',
'',
' TJSAttr = class(TJSObject,IJSAttr)',
' Private',
' Public',
' procedure setEventHandler(const aHandler: TEventHandler);',
' class function Cast(Intf: IJSObject): IJSAttr;',
' end;',
'',
'implementation',
'',
'function JOBCallTEventHandlerNonNull(const aMethod: TMethod; var H: TJOBCallbackHelper): PByte;',
'var',
' event: Integer;',
'begin',
' event:=H.GetLongInt;',
' Result:=H.AllocVariant(TEventHandlerNonNull(aMethod)(event));',
'end;',
'',
'procedure TJSAttr.setEventHandler(const aHandler: TEventHandler);',
'var',
' m: TJOB_Method;',
'begin',
' m:=TJOB_Method.Create(TMethod(aHandler),@JOBCallTEventHandlerNonNull);',
' try',
' InvokeJSNoResult(''setEventHandler'',[m]);',
' finally',
' m.free;',
' end;',
'end;',
'',
'class function TJSAttr.Cast(Intf: IJSObject): IJSAttr;',
'begin',
' Result:=TJSAttr.JOBCast(Intf);',
'end;',
'',
'end.',
'']);
end;
initialization initialization
RegisterTests([TTestWebIDL2Wasmjob]); RegisterTests([TTestWebIDL2Wasmjob]);