mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-25 20:37:23 +01:00
2202 lines
58 KiB
ObjectPascal
2202 lines
58 KiB
ObjectPascal
unit tcwebidl2wasmjob;
|
|
|
|
{$mode ObjFPC}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, fpcunit, testregistry, webidldefs, webidlscanner, webidltopas, webidltowasmjob, pascodegen;
|
|
|
|
const
|
|
FixedGUID = '{1B6D2766-7DA6-40FA-9B4E-93FFB805B83A}';
|
|
|
|
type
|
|
|
|
{ TTestWebIDLToPasWasmJob }
|
|
|
|
TTestWebIDLToPasWasmJob = class(TWebIDLToPasWasmJob)
|
|
private
|
|
FRealGUID: Boolean;
|
|
Public
|
|
function ComputeGUID(const Prefix: TIDLString; aList: TIDLDefinitionList): TIDLString; override;
|
|
Property RealGUID : Boolean Read FRealGUID Write FRealGUID;
|
|
end;
|
|
|
|
{ TCustomTestWebIDL2WasmJob }
|
|
|
|
TCustomTestWebIDL2WasmJob = Class(TTestCase)
|
|
private
|
|
FHeaderSrc: TIDLString;
|
|
FWebIDLToPas: TWebIDLToPasWasmJob;
|
|
procedure OnLog(Sender: TObject; LogType: TCodegenLogType; const Msg: String
|
|
);
|
|
protected
|
|
procedure Setup; override;
|
|
procedure TearDown; override;
|
|
public
|
|
procedure TestWebIDL(const WebIDLSrc, ExpectedPascalSrc: array of string); virtual;
|
|
procedure CheckDiff(Msg, Expected, Actual: string); virtual;
|
|
property WebIDLToPas: TWebIDLToPasWasmJob read FWebIDLToPas;
|
|
property HeaderSrc: TIDLString read FHeaderSrc write FHeaderSrc;
|
|
end;
|
|
|
|
{ TTestWebIDL2WasmJob }
|
|
|
|
TTestWebIDL2WasmJob = Class(TCustomTestWebIDL2WasmJob)
|
|
published
|
|
procedure TestWJ_Empty;
|
|
|
|
// typedefs
|
|
procedure TestWJ_Typedef_Boolean;
|
|
procedure TestWJ_Typedef_Sequence;
|
|
procedure TestWJ_Typedef_Aliased;
|
|
procedure TestWJ_Typedef_Dictionary;
|
|
procedure TestWJ_Typedef_DictionaryWithParent;
|
|
|
|
// attributes
|
|
procedure TestWJ_IntfAttribute_Boolean;
|
|
procedure TestWJ_IntfStringifier;
|
|
procedure TestWJ_IntfAttribute_ArrayBuffer;
|
|
procedure TestWJ_IntfAttribute_ArrayBufferView;
|
|
procedure TestWJ_IntfAttribute_ChromeOnly;
|
|
|
|
procedure TestWJ_CallBackObjectArg;
|
|
procedure TestWJ_CallBackEnumArg;
|
|
procedure TestWJ_CallBackSequenceArg;
|
|
|
|
|
|
// todo procedure TestWJ_IntfAttribute_Any;
|
|
|
|
// functions
|
|
procedure TestWJ_IntfFunction_Void;
|
|
procedure TestWJ_IntfFunction_SetEventHandler;
|
|
procedure TestWJ_IntfFunction_Promise;
|
|
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;
|
|
procedure TestWJ_IntfFunction_SequenceResult;
|
|
procedure TestWJ_IntfFunction_GlobalSequenceResult;
|
|
procedure TestWJ_IntfFunction_ChromeOnly;
|
|
procedure TestWJ_IntfFunction_ChromeOnlyNewObject;
|
|
procedure TestWJ_IntfFunction_DictionaryResult;
|
|
procedure TestWJ_IntfFunction_AliasResult;
|
|
procedure TestWJ_IntfFunction_NestedUnionSequence;
|
|
procedure TestWJ_intfFunction_UnionOptional;
|
|
// Namespace attribute
|
|
procedure TestWJ_NamespaceAttribute_Boolean;
|
|
// maplike
|
|
procedure TestWJ_MaplikeInterface;
|
|
end;
|
|
|
|
function LinesToStr(Args: array of const): TIDLString;
|
|
function CheckSrcDiff(Expected, Actual: string; out Msg: string): boolean;
|
|
|
|
implementation
|
|
|
|
|
|
function LinesToStr(Args: array of const): TIDLString;
|
|
var
|
|
s,a: TIDLString;
|
|
U : UnicodeString;
|
|
i: Integer;
|
|
begin
|
|
s:='';
|
|
for i:=Low(Args) to High(Args) do
|
|
begin
|
|
case Args[i].VType of
|
|
vtChar: A:=Args[i].VChar;
|
|
vtString: A:=Args[i].VString^;
|
|
vtPChar: A:=Args[i].VPChar;
|
|
vtWideChar: begin
|
|
U:=Args[i].VWideChar;
|
|
A:=UTF8Encode(U);
|
|
end;
|
|
vtPWideChar: begin
|
|
U:=Args[i].VPWideChar;
|
|
A:=UTF8Encode(U);
|
|
end;
|
|
vtAnsiString: begin
|
|
A:=AnsiString(Args[i].VAnsiString);
|
|
end;
|
|
vtWidestring: begin
|
|
U:=WideString(Args[i].VWideString);
|
|
A:=UTF8Encode(U);
|
|
end;
|
|
vtUnicodeString: begin
|
|
U:=UnicodeString(Args[i].VUnicodeString);
|
|
A:=UTF8Encode(U);
|
|
end;
|
|
end;
|
|
S:=S+A+LineEnding;
|
|
end;
|
|
// Writeln('LinesToStr : ',S);
|
|
Result:=s;
|
|
end;
|
|
|
|
function CheckSrcDiff(Expected, Actual: string; out Msg: string): boolean;
|
|
// search diff, ignore changes in spaces
|
|
const
|
|
SpaceChars = [#9,#10,#13,' '];
|
|
var
|
|
ExpectedP, ActualP: PChar;
|
|
|
|
function FindLineEnd(p: PChar): PChar;
|
|
begin
|
|
Result:=p;
|
|
while not (Result^ in [#0,#10,#13]) do inc(Result);
|
|
end;
|
|
|
|
function FindLineStart(p, MinP: PChar): PChar;
|
|
begin
|
|
while (p>MinP) and not (p[-1] in [#10,#13]) do dec(p);
|
|
Result:=p;
|
|
end;
|
|
|
|
procedure SkipLineEnd(var p: PChar);
|
|
begin
|
|
if p^ in [#10,#13] then
|
|
begin
|
|
if (p[1] in [#10,#13]) and (p^<>p[1]) then
|
|
inc(p,2)
|
|
else
|
|
inc(p);
|
|
end;
|
|
end;
|
|
|
|
function HasSpecialChar(s: string): boolean;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
for i:=1 to length(s) do
|
|
if s[i] in [#0..#31,#127..#255] then
|
|
exit(true);
|
|
Result:=false;
|
|
end;
|
|
|
|
function HashSpecialChars(s: string): string;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result:='';
|
|
for i:=1 to length(s) do
|
|
if s[i] in [#0..#31,#127..#255] then
|
|
Result:=Result+'#'+hexstr(ord(s[i]),2)
|
|
else
|
|
Result:=Result+s[i];
|
|
end;
|
|
|
|
procedure DiffFound;
|
|
var
|
|
ActLineStartP, ActLineEndP, p, StartPos: PChar;
|
|
ExpLine, ActLine: String;
|
|
i, LineNo, DiffLineNo: Integer;
|
|
begin
|
|
writeln('Diff found "',Msg,'". Lines:');
|
|
// write correct lines
|
|
p:=PChar(Expected);
|
|
LineNo:=0;
|
|
DiffLineNo:=0;
|
|
repeat
|
|
StartPos:=p;
|
|
while not (p^ in [#0,#10,#13]) do inc(p);
|
|
ExpLine:=copy(Expected,StartPos-PChar(Expected)+1,p-StartPos);
|
|
SkipLineEnd(p);
|
|
inc(LineNo);
|
|
if (p<=ExpectedP) and (p^<>#0) then
|
|
begin
|
|
writeln('= ',ExpLine);
|
|
end else begin
|
|
// diff line
|
|
if DiffLineNo=0 then DiffLineNo:=LineNo;
|
|
// write actual line
|
|
ActLineStartP:=FindLineStart(ActualP,PChar(Actual));
|
|
ActLineEndP:=FindLineEnd(ActualP);
|
|
ActLine:=copy(Actual,ActLineStartP-PChar(Actual)+1,ActLineEndP-ActLineStartP);
|
|
writeln('- ',ActLine);
|
|
if HasSpecialChar(ActLine) then
|
|
writeln('- ',HashSpecialChars(ActLine));
|
|
// write expected line
|
|
writeln('+ ',ExpLine);
|
|
if HasSpecialChar(ExpLine) then
|
|
writeln('- ',HashSpecialChars(ExpLine));
|
|
// write empty line with pointer ^
|
|
for i:=1 to 2+ExpectedP-StartPos do write(' ');
|
|
writeln('^');
|
|
Msg:='expected "'+ExpLine+'", but got "'+ActLine+'".';
|
|
CheckSrcDiff:=false;
|
|
// write up to ten following actual lines to get some context
|
|
for i:=1 to 10 do begin
|
|
ActLineStartP:=ActLineEndP;
|
|
SkipLineEnd(ActLineStartP);
|
|
if ActLineStartP^=#0 then break;
|
|
ActLineEndP:=FindLineEnd(ActLineStartP);
|
|
ActLine:=copy(Actual,ActLineStartP-PChar(Actual)+1,ActLineEndP-ActLineStartP);
|
|
writeln('~ ',ActLine);
|
|
end;
|
|
exit;
|
|
end;
|
|
until p^=#0;
|
|
|
|
// internal error:
|
|
writeln('DiffFound Actual:-----------------------');
|
|
writeln(Actual);
|
|
writeln('DiffFound Expected:---------------------');
|
|
writeln(Expected);
|
|
writeln('DiffFound ------------------------------');
|
|
Msg:='diff found, but lines are the same, internal error';
|
|
CheckSrcDiff:=false;
|
|
end;
|
|
|
|
var
|
|
IsSpaceNeeded: Boolean;
|
|
LastChar, Quote: Char;
|
|
begin
|
|
Result:=true;
|
|
Msg:='';
|
|
Writeln('Actual :',ACtual);
|
|
if Expected='' then Expected:=' ';
|
|
if Actual='' then Actual:=' ';
|
|
ExpectedP:=PChar(Expected);
|
|
ActualP:=PChar(Actual);
|
|
repeat
|
|
//writeln('TTestModule.CheckDiff Exp="',ExpectedP^,'" Act="',ActualP^,'"');
|
|
case ExpectedP^ of
|
|
#0:
|
|
begin
|
|
// check that rest of Actual has only spaces
|
|
while ActualP^ in SpaceChars do inc(ActualP);
|
|
if ActualP^<>#0 then
|
|
begin
|
|
DiffFound;
|
|
exit;
|
|
end;
|
|
exit(true);
|
|
end;
|
|
' ',#9,#10,#13:
|
|
begin
|
|
// skip space in Expected
|
|
IsSpaceNeeded:=false;
|
|
if ExpectedP>PChar(Expected) then
|
|
LastChar:=ExpectedP[-1]
|
|
else
|
|
LastChar:=#0;
|
|
while ExpectedP^ in SpaceChars do inc(ExpectedP);
|
|
if (LastChar in ['a'..'z','A'..'Z','0'..'9','_','$'])
|
|
and (ExpectedP^ in ['a'..'z','A'..'Z','0'..'9','_','$']) then
|
|
IsSpaceNeeded:=true;
|
|
if IsSpaceNeeded and (not (ActualP^ in SpaceChars)) then
|
|
begin
|
|
DiffFound;
|
|
exit;
|
|
end;
|
|
while ActualP^ in SpaceChars do inc(ActualP);
|
|
end;
|
|
'''','"':
|
|
begin
|
|
while ActualP^ in SpaceChars do inc(ActualP);
|
|
if ExpectedP^<>ActualP^ then
|
|
begin
|
|
DiffFound;
|
|
exit;
|
|
end;
|
|
Quote:=ExpectedP^;
|
|
repeat
|
|
inc(ExpectedP);
|
|
inc(ActualP);
|
|
if ExpectedP^<>ActualP^ then
|
|
begin
|
|
DiffFound;
|
|
exit;
|
|
end;
|
|
if (ExpectedP^ in [#0,#10,#13]) then
|
|
break
|
|
else if (ExpectedP^=Quote) then
|
|
begin
|
|
inc(ExpectedP);
|
|
inc(ActualP);
|
|
break;
|
|
end;
|
|
until false;
|
|
end;
|
|
else
|
|
while ActualP^ in SpaceChars do inc(ActualP);
|
|
if ExpectedP^<>ActualP^ then
|
|
begin
|
|
DiffFound;
|
|
exit;
|
|
end;
|
|
inc(ExpectedP);
|
|
inc(ActualP);
|
|
end;
|
|
until false;
|
|
end;
|
|
|
|
{ TTestWebIDLToPasWasmJob }
|
|
|
|
function TTestWebIDLToPasWasmJob.ComputeGUID(const Prefix: TIDLString; aList: TIDLDefinitionList): TIDLString;
|
|
begin
|
|
if RealGUID then
|
|
Result:=inherited ComputeGUID(Prefix, aList)
|
|
else
|
|
Result:=FixedGUID;
|
|
end;
|
|
|
|
{ TCustomTestWebIDL2WasmJob }
|
|
|
|
procedure TCustomTestWebIDL2WasmJob.OnLog(Sender: TObject;
|
|
LogType: TCodegenLogType; const Msg: String);
|
|
begin
|
|
if LogType=cltInfo then ;
|
|
if Sender=nil then ;
|
|
Status('TCustomTestWebIDL2WasmJob.OnLog '+Msg);
|
|
end;
|
|
|
|
procedure TCustomTestWebIDL2WasmJob.Setup;
|
|
begin
|
|
inherited Setup;
|
|
FWebIDLToPas:=TTestWebIDLToPasWasmJob.Create(nil);
|
|
WebIDLToPas.OnLog:=@OnLog;
|
|
WebIDLToPas.InputFileName:='test1.webidl';
|
|
WebIDLToPas.OutputFileName:='test1.pas';
|
|
WebIDLToPas.OutputStream:=TMemoryStream.Create;
|
|
HeaderSrc:=LinesToStr([
|
|
'Unit test1;',
|
|
'',
|
|
'{$MODE ObjFPC}',
|
|
'{$H+}',
|
|
'interface',
|
|
'',
|
|
'uses SysUtils, Job.JS;',
|
|
'']);
|
|
end;
|
|
|
|
procedure TCustomTestWebIDL2WasmJob.TearDown;
|
|
begin
|
|
WebIDLToPas.InputStream.Free;
|
|
WebIDLToPas.InputStream:=nil;
|
|
WebIDLToPas.OutputStream.Free;
|
|
WebIDLToPas.OutputStream:=nil;
|
|
FreeAndNil(FWebIDLToPas);
|
|
inherited TearDown;
|
|
end;
|
|
|
|
procedure TCustomTestWebIDL2WasmJob.TestWebIDL(const WebIDLSrc,
|
|
ExpectedPascalSrc: array of string);
|
|
var
|
|
i: Integer;
|
|
Line, ExpectedSrc, InputSrc, OutputSrc: String;
|
|
|
|
begin
|
|
{$IFDEF VerboseWebidl2WasmJob}
|
|
writeln('TCustomTestWebIDL2WasmJob.TestWebIDL WebIDL:----------------------');
|
|
{$ENDIF}
|
|
InputSrc:='';
|
|
for i:=0 to high(WebIDLSrc) do
|
|
begin
|
|
Line:=WebIDLSrc[i]+sLineBreak;
|
|
InputSrc:=InputSrc+Line;
|
|
{$IFDEF VerboseWebidl2WasmJob}
|
|
write(Line);
|
|
{$ENDIF}
|
|
end;
|
|
WebIDLToPas.InputStream:=TStringStream.Create(InputSrc);
|
|
{$IFDEF VerboseWebidl2WasmJob}
|
|
writeln('TCustomTestWebIDL2WasmJob.TestWebIDL ExpectedPascal: BEGIN--------');
|
|
{$ENDIF}
|
|
ExpectedSrc:=HeaderSrc;
|
|
for i:=0 to high(ExpectedPascalSrc) do
|
|
ExpectedSrc:=ExpectedSrc+ExpectedPascalSrc[i]+sLineBreak;
|
|
{$IFDEF VerboseWebidl2WasmJob}
|
|
writeln(ExpectedSrc);
|
|
writeln('TCustomTestWebIDL2WasmJob.TestWebIDL ExpectedPascal END-----------');
|
|
{$ENDIF}
|
|
|
|
WebIDLToPas.Execute;
|
|
OutputSrc:=WebIDLToPas.Source.Text;
|
|
{$IFDEF VerboseWebidl2WasmJob}
|
|
writeln('TCustomTestWebIDL2WasmJob.TestWebIDL ActualPascal: BEGIN----------');
|
|
writeln(OutputSrc);
|
|
writeln('TCustomTestWebIDL2WasmJob.TestWebIDL ActualPascal: END------------');
|
|
{$ENDIF}
|
|
|
|
CheckDiff('Source Differs',ExpectedSrc,OutputSrc);
|
|
end;
|
|
|
|
procedure TCustomTestWebIDL2WasmJob.CheckDiff(Msg, Expected, Actual: string);
|
|
// search diff, ignore changes in spaces
|
|
var
|
|
s: string;
|
|
begin
|
|
if CheckSrcDiff(Expected,Actual,s) then exit;
|
|
Fail(Msg+': '+s);
|
|
end;
|
|
|
|
{ TTestWebIDL2WasmJob }
|
|
|
|
procedure TTestWebIDL2WasmJob.TestWJ_Empty;
|
|
begin
|
|
TestWebIDL([
|
|
''],
|
|
['Type',
|
|
' // Forward class definitions',
|
|
'implementation',
|
|
'end.',
|
|
'']);
|
|
end;
|
|
|
|
procedure TTestWebIDL2WasmJob.TestWJ_Typedef_Boolean;
|
|
begin
|
|
TestWebIDL([
|
|
'typedef boolean PerformanceEntry;',
|
|
''],
|
|
['Type',
|
|
' // Forward class definitions',
|
|
' TPerformanceEntry = Boolean;',
|
|
'implementation',
|
|
'end.',
|
|
'']);
|
|
end;
|
|
|
|
procedure TTestWebIDL2WasmJob.TestWJ_Typedef_Sequence;
|
|
begin
|
|
TestWebIDL([
|
|
'typedef boolean PerformanceEntry;',
|
|
'typedef sequence <PerformanceEntry> PerformanceEntryList;',
|
|
''],
|
|
['Type',
|
|
' // Forward class definitions',
|
|
' TPerformanceEntry = Boolean;',
|
|
' TPerformanceEntryListDynArray = IJSArray; // array of PerformanceEntry',
|
|
'implementation',
|
|
'end.',
|
|
'']);
|
|
end;
|
|
|
|
procedure TTestWebIDL2WasmJob.TestWJ_Typedef_Aliased;
|
|
begin
|
|
WebIDLToPas.TypeAliases.Add('Float32List=IJSFloat32Array');
|
|
TestWebIDL([
|
|
' typedef ([AllowShared] Float32Array or sequence<GLfloat>) Float32List;',
|
|
''],
|
|
['',
|
|
'Type',
|
|
' // Forward class definitions',
|
|
'implementation',
|
|
'',
|
|
'end.',
|
|
''
|
|
]);
|
|
end;
|
|
|
|
procedure TTestWebIDL2WasmJob.TestWJ_Typedef_Dictionary;
|
|
begin
|
|
TestWebIDL([
|
|
'dictionary Attr {',
|
|
' boolean aBoolean;',
|
|
'};',
|
|
''],
|
|
['Type',
|
|
' // Forward class definitions',
|
|
' IJSAttr = interface;',
|
|
' TJSAttr = 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;',
|
|
'',
|
|
'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;',
|
|
'',
|
|
'end.',
|
|
'']);
|
|
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([
|
|
'interface Attr {',
|
|
' attribute boolean aBoolean;',
|
|
'};',
|
|
''],
|
|
['Type',
|
|
' // Forward class definitions',
|
|
' IJSAttr = interface;',
|
|
' TJSAttr = class;',
|
|
' { --------------------------------------------------------------------',
|
|
' TJSAttr',
|
|
' --------------------------------------------------------------------}',
|
|
'',
|
|
' 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;',
|
|
'',
|
|
'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:=''Attr'';',
|
|
'end;',
|
|
'',
|
|
'class function TJSAttr.Cast(const Intf: IJSObject): IJSAttr;',
|
|
'begin',
|
|
' Result:=TJSAttr.JOBCast(Intf);',
|
|
'end;',
|
|
'',
|
|
'end.',
|
|
'']);
|
|
end;
|
|
|
|
procedure TTestWebIDL2WasmJob.TestWJ_IntfStringifier;
|
|
begin
|
|
TestWebIDL([
|
|
'interface Attr {',
|
|
' stringifier;',
|
|
'};',
|
|
''],
|
|
['Type',
|
|
' // Forward class definitions',
|
|
' IJSAttr = interface;',
|
|
' TJSAttr = class;',
|
|
' { --------------------------------------------------------------------',
|
|
' TJSAttr',
|
|
' --------------------------------------------------------------------}',
|
|
'',
|
|
' IJSAttr = interface(IJSObject)',
|
|
' ['''+FixedGUID+''']',
|
|
' end;',
|
|
'',
|
|
' TJSAttr = class(TJSObject,IJSAttr)',
|
|
' Private',
|
|
' Public',
|
|
' class function JSClassName: UnicodeString; override;',
|
|
' class function Cast(const Intf: IJSObject): IJSAttr;',
|
|
' end;',
|
|
'',
|
|
'implementation',
|
|
'',
|
|
'class function TJSAttr.JSClassName: UnicodeString;',
|
|
'begin',
|
|
' Result:=''Attr'';',
|
|
'end;',
|
|
'',
|
|
'class function TJSAttr.Cast(const Intf: IJSObject): IJSAttr;',
|
|
'begin',
|
|
' Result:=TJSAttr.JOBCast(Intf);',
|
|
'end;',
|
|
'',
|
|
'end.',
|
|
'']);
|
|
|
|
end;
|
|
|
|
procedure TTestWebIDL2WasmJob.TestWJ_IntfAttribute_ArrayBuffer;
|
|
begin
|
|
TestWebIDL([
|
|
'interface Attr {',
|
|
' [SameObject, Throws] readonly attribute ArrayBuffer signature;',
|
|
'};',
|
|
''],
|
|
[
|
|
'Type',
|
|
' // Forward class definitions',
|
|
' IJSAttr = interface;',
|
|
' TJSAttr = class;',
|
|
' { --------------------------------------------------------------------',
|
|
' TJSAttr',
|
|
' --------------------------------------------------------------------}',
|
|
'',
|
|
' IJSAttr = interface(IJSObject)',
|
|
' ['''+FixedGUID+''']',
|
|
' function _Getsignature: IJSArrayBuffer;',
|
|
' property signature: IJSArrayBuffer read _Getsignature;',
|
|
' end;',
|
|
'',
|
|
' TJSAttr = class(TJSObject,IJSAttr)',
|
|
' Private',
|
|
' function _Getsignature: IJSArrayBuffer;',
|
|
' Public',
|
|
' class function JSClassName: UnicodeString; override;',
|
|
' class function Cast(const Intf: IJSObject): IJSAttr;',
|
|
' property signature: IJSArrayBuffer read _Getsignature;',
|
|
' end;',
|
|
'',
|
|
'implementation',
|
|
'',
|
|
'function TJSAttr._Getsignature: IJSArrayBuffer;',
|
|
'begin',
|
|
' Result:=ReadJSPropertyObject(''signature'',TJSArrayBuffer) as IJSArrayBuffer;',
|
|
'end;',
|
|
'',
|
|
'class function TJSAttr.JSClassName: UnicodeString;',
|
|
'begin',
|
|
' Result:=''Attr'';',
|
|
'end;',
|
|
'',
|
|
'class function TJSAttr.Cast(const Intf: IJSObject): IJSAttr;',
|
|
'begin',
|
|
' Result:=TJSAttr.JOBCast(Intf);',
|
|
'end;',
|
|
'',
|
|
'end.',
|
|
''
|
|
]);
|
|
|
|
|
|
end;
|
|
|
|
procedure TTestWebIDL2WasmJob.TestWJ_IntfAttribute_ArrayBufferView;
|
|
begin
|
|
TestWebIDL([
|
|
'interface Attr {',
|
|
' [SameObject, Throws] readonly attribute ArrayBufferView signature;',
|
|
'};',
|
|
''],
|
|
[
|
|
'Type',
|
|
' // Forward class definitions',
|
|
' IJSAttr = interface;',
|
|
' TJSAttr = class;',
|
|
' { --------------------------------------------------------------------',
|
|
' TJSAttr',
|
|
' --------------------------------------------------------------------}',
|
|
'',
|
|
' IJSAttr = interface(IJSObject)',
|
|
' ['''+FixedGUID+''']',
|
|
' function _Getsignature: IJSArrayBufferView;',
|
|
' property signature: IJSArrayBufferView read _Getsignature;',
|
|
' end;',
|
|
'',
|
|
' TJSAttr = class(TJSObject,IJSAttr)',
|
|
' Private',
|
|
' function _Getsignature: IJSArrayBufferView;',
|
|
' Public',
|
|
' class function JSClassName: UnicodeString; override;',
|
|
' class function Cast(const Intf: IJSObject): IJSAttr;',
|
|
' property signature: IJSArrayBufferView read _Getsignature;',
|
|
' end;',
|
|
'',
|
|
'implementation',
|
|
'',
|
|
'function TJSAttr._Getsignature: IJSArrayBufferView;',
|
|
'begin',
|
|
' Result:=ReadJSPropertyObject(''signature'',TJSArrayBufferView) as IJSArrayBufferView;',
|
|
'end;',
|
|
'',
|
|
'class function TJSAttr.JSClassName: UnicodeString;',
|
|
'begin',
|
|
' Result:=''Attr'';',
|
|
'end;',
|
|
'',
|
|
'class function TJSAttr.Cast(const Intf: IJSObject): IJSAttr;',
|
|
'begin',
|
|
' Result:=TJSAttr.JOBCast(Intf);',
|
|
'end;',
|
|
'',
|
|
'end.',
|
|
''
|
|
]);
|
|
end;
|
|
|
|
procedure TTestWebIDL2WasmJob.TestWJ_IntfAttribute_ChromeOnly;
|
|
|
|
begin
|
|
TestWebIDL([
|
|
'interface Attr {',
|
|
' [ChromeOnly, Throws] readonly attribute long soso;',
|
|
'};',
|
|
''],
|
|
[
|
|
'Type',
|
|
' // Forward class definitions',
|
|
' IJSAttr = interface;',
|
|
' TJSAttr = class;',
|
|
' { --------------------------------------------------------------------',
|
|
' TJSAttr',
|
|
' --------------------------------------------------------------------}',
|
|
'',
|
|
' IJSAttr = interface(IJSObject)',
|
|
' ['''+FixedGUID+''']',
|
|
' end;',
|
|
'',
|
|
' TJSAttr = class(TJSObject,IJSAttr)',
|
|
' Private',
|
|
' Public',
|
|
' class function JSClassName: UnicodeString; override;',
|
|
' class function Cast(const Intf: IJSObject): IJSAttr;',
|
|
' end;',
|
|
'',
|
|
'implementation',
|
|
'',
|
|
'class function TJSAttr.JSClassName: UnicodeString;',
|
|
'begin',
|
|
' Result:=''Attr'';',
|
|
'end;',
|
|
'',
|
|
'class function TJSAttr.Cast(const Intf: IJSObject): IJSAttr;',
|
|
'begin',
|
|
' Result:=TJSAttr.JOBCast(Intf);',
|
|
'end;',
|
|
'',
|
|
'end.',
|
|
''
|
|
]);
|
|
end;
|
|
|
|
procedure TTestWebIDL2WasmJob.TestWJ_CallBackObjectArg;
|
|
|
|
begin
|
|
WebIDLToPas.TypeAliases.Add('AudioWorkletProcessor=IJSObject');
|
|
TestWebIDL([
|
|
' callback constructor AudioWorkletProcessorConstructor = AudioWorkletProcessor (object options);'
|
|
],
|
|
[
|
|
'Type',
|
|
' // Forward class definitions',
|
|
' TAudioWorkletProcessorConstructor = function (options: IJSObject): IJSObject of object;',
|
|
'',
|
|
'implementation',
|
|
'',
|
|
'function JOBCallAudioWorkletProcessorConstructor(const aMethod: TMethod; var H: TJOBCallbackHelper): PByte;',
|
|
' var',
|
|
' options: IJSObject;',
|
|
'begin',
|
|
' options:=H.GetObject(TJSObject) as IJSObject;',
|
|
' Result:=H.AllocIntf(TAudioWorkletProcessorConstructor(aMethod)(options));',
|
|
'end;',
|
|
'',
|
|
'end.'
|
|
]);
|
|
|
|
end;
|
|
|
|
procedure TTestWebIDL2WasmJob.TestWJ_CallBackEnumArg;
|
|
begin
|
|
TestWebIDL([
|
|
'enum E { ',
|
|
' "allowed", ',
|
|
' "disallowed" ',
|
|
'}; ',
|
|
'callback getit = long (E a);'
|
|
],[
|
|
'Type',
|
|
'// Forward class definitions',
|
|
' TE = UnicodeString;',
|
|
' Tgetit = function (a: TE): LongInt of object;',
|
|
'',
|
|
'implementation',
|
|
'',
|
|
'function JOBCallgetit(const aMethod: TMethod; var H: TJOBCallbackHelper): PByte; ',
|
|
'var',
|
|
' a: TE;',
|
|
'begin',
|
|
' a:=H.GetString;',
|
|
' Result:=H.AllocLongInt(Tgetit(aMethod)(a));',
|
|
'end;',
|
|
'',
|
|
'end.'
|
|
]);
|
|
|
|
end;
|
|
|
|
procedure TTestWebIDL2WasmJob.TestWJ_CallBackSequenceArg;
|
|
begin
|
|
TestWebIDL([
|
|
'typedef sequence<long> E;',
|
|
'callback getit = long (E a);'
|
|
],[
|
|
'Type',
|
|
'// Forward class definitions',
|
|
' TEDynArray = IJSArray; // array of long',
|
|
' Tgetit = function (const a: TEDynArray): LongInt of object;',
|
|
'',
|
|
'implementation',
|
|
'',
|
|
'function JOBCallgetit(const aMethod: TMethod; var H: TJOBCallbackHelper): PByte; ',
|
|
'var',
|
|
' a: TEDynArray;',
|
|
'begin',
|
|
' a:=H.GetObject(TJSArray) as IJSArray;',
|
|
' Result:=H.AllocLongInt(Tgetit(aMethod)(a));',
|
|
'end;',
|
|
'',
|
|
'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)',
|
|
' ['''+FixedGUID+''']',
|
|
' procedure append(aNode: IJSAttr);',
|
|
' end;',
|
|
'',
|
|
' TJSAttr = class(TJSObject,IJSAttr)',
|
|
' Private',
|
|
' Public',
|
|
' procedure append(aNode: IJSAttr); overload;',
|
|
' class function JSClassName: UnicodeString; override;',
|
|
' class function Cast(const Intf: IJSObject): IJSAttr;',
|
|
' end;',
|
|
'',
|
|
'implementation',
|
|
'',
|
|
'procedure TJSAttr.append(aNode: IJSAttr);',
|
|
'begin',
|
|
' InvokeJSNoResult(''append'',[aNode]);',
|
|
'end;',
|
|
'',
|
|
'class function TJSAttr.JSClassName: UnicodeString;',
|
|
'begin',
|
|
' Result:=''Attr'';',
|
|
'end;',
|
|
'',
|
|
'class function TJSAttr.Cast(const 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: LongInt): Variant of object;',
|
|
' TEventHandler = TEventHandlerNonNull;',
|
|
'',
|
|
' { --------------------------------------------------------------------',
|
|
' TJSAttr',
|
|
' --------------------------------------------------------------------}',
|
|
'',
|
|
' IJSAttr = interface(IJSObject)',
|
|
' ['''+FixedGUID+''']',
|
|
' procedure setEventHandler(const aHandler: TEventHandler);',
|
|
' end;',
|
|
'',
|
|
' TJSAttr = class(TJSObject,IJSAttr)',
|
|
' Private',
|
|
' Public',
|
|
' procedure setEventHandler(const aHandler: TEventHandler); overload;',
|
|
' class function JSClassName: UnicodeString; override;',
|
|
' class function Cast(const Intf: IJSObject): IJSAttr;',
|
|
' end;',
|
|
'',
|
|
'implementation',
|
|
'',
|
|
'function JOBCallEventHandlerNonNull(const aMethod: TMethod; var H: TJOBCallbackHelper): PByte;',
|
|
'var',
|
|
' event: LongInt;',
|
|
'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),@JOBCallEventHandlerNonNull);',
|
|
' try',
|
|
' InvokeJSNoResult(''setEventHandler'',[m]);',
|
|
' finally',
|
|
' m.free;',
|
|
' end;',
|
|
'end;',
|
|
'',
|
|
'class function TJSAttr.JSClassName: UnicodeString;',
|
|
'begin',
|
|
' Result:=''Attr'';',
|
|
'end;',
|
|
'',
|
|
'class function TJSAttr.Cast(const Intf: IJSObject): IJSAttr;',
|
|
'begin',
|
|
' Result:=TJSAttr.JOBCast(Intf);',
|
|
'end;',
|
|
'',
|
|
'end.',
|
|
'']);
|
|
end;
|
|
|
|
procedure TTestWebIDL2WasmJob.TestWJ_IntfFunction_Promise;
|
|
begin
|
|
// Promise<void> exitFullscreen();
|
|
TestWebIDL([
|
|
'interface Attr {',
|
|
' Promise<void> exitFullscreen();',
|
|
' Promise<any> addCertException(boolean isTemporary);',
|
|
' Promise<Attr> fly();',
|
|
'};',
|
|
''],
|
|
['Type',
|
|
' // Forward class definitions',
|
|
' IJSAttr = interface;',
|
|
' TJSAttr = class;',
|
|
' { --------------------------------------------------------------------',
|
|
' TJSAttr',
|
|
' --------------------------------------------------------------------}',
|
|
'',
|
|
' IJSAttr = interface(IJSObject)',
|
|
' ['''+FixedGUID+''']',
|
|
' function exitFullscreen: IJSPromise; // Promise<void>',
|
|
' function addCertException(aIsTemporary: Boolean): IJSPromise; // Promise<any>',
|
|
' function fly: IJSPromise; // Promise<Attr>',
|
|
' end;',
|
|
'',
|
|
' TJSAttr = class(TJSObject,IJSAttr)',
|
|
' Private',
|
|
' Public',
|
|
' function exitFullscreen: IJSPromise; overload; // Promise<void>',
|
|
' function addCertException(aIsTemporary: Boolean): IJSPromise; overload; // Promise<any>',
|
|
' function fly: IJSPromise; overload; // Promise<Attr>',
|
|
' class function JSClassName: UnicodeString; override;',
|
|
' class function Cast(const Intf: IJSObject): IJSAttr;',
|
|
' end;',
|
|
'',
|
|
'implementation',
|
|
'',
|
|
'function TJSAttr.exitFullscreen: IJSPromise; // Promise<void>',
|
|
'begin',
|
|
' Result:=InvokeJSObjectResult(''exitFullscreen'',[],TJSPromise) as IJSPromise;',
|
|
'end;',
|
|
'',
|
|
'function TJSAttr.addCertException(aIsTemporary: Boolean): IJSPromise; // Promise<any>',
|
|
'begin',
|
|
' Result:=InvokeJSObjectResult(''addCertException'',[aIsTemporary],TJSPromise) as IJSPromise;',
|
|
'end;',
|
|
'',
|
|
'function TJSAttr.fly: IJSPromise; // Promise<Attr>',
|
|
'begin',
|
|
' Result:=InvokeJSObjectResult(''fly'',[],TJSPromise) as IJSPromise;',
|
|
'end;',
|
|
'',
|
|
'class function TJSAttr.JSClassName: UnicodeString;',
|
|
'begin',
|
|
' Result:=''Attr'';',
|
|
'end;',
|
|
'',
|
|
'class function TJSAttr.Cast(const Intf: IJSObject): IJSAttr;',
|
|
'begin',
|
|
' Result:=TJSAttr.JOBCast(Intf);',
|
|
'end;',
|
|
'',
|
|
'end.',
|
|
'']);
|
|
end;
|
|
|
|
procedure TTestWebIDL2WasmJob.TestWJ_IntfFunction_ArgAny;
|
|
begin
|
|
TestWebIDL([
|
|
'interface Attr {',
|
|
' void append(any node);',
|
|
'};',
|
|
''],
|
|
['Type',
|
|
' // Forward class definitions',
|
|
' IJSAttr = interface;',
|
|
' TJSAttr = class;',
|
|
' { --------------------------------------------------------------------',
|
|
' TJSAttr',
|
|
' --------------------------------------------------------------------}',
|
|
'',
|
|
' IJSAttr = interface(IJSObject)',
|
|
' ['''+FixedGUID+''']',
|
|
' procedure append(const aNode: Variant);',
|
|
' end;',
|
|
'',
|
|
' TJSAttr = class(TJSObject,IJSAttr)',
|
|
' Private',
|
|
' Public',
|
|
' procedure append(const aNode: Variant); overload;',
|
|
' class function JSClassName: UnicodeString; override;',
|
|
' class function Cast(const Intf: IJSObject): IJSAttr;',
|
|
' end;',
|
|
'',
|
|
'implementation',
|
|
'',
|
|
'procedure TJSAttr.append(const aNode: Variant);',
|
|
'begin',
|
|
' InvokeJSNoResult(''append'',[aNode]);',
|
|
'end;',
|
|
'',
|
|
'class function TJSAttr.JSClassName: UnicodeString;',
|
|
'begin',
|
|
' Result:=''Attr'';',
|
|
'end;',
|
|
'',
|
|
'class function TJSAttr.Cast(const Intf: IJSObject): IJSAttr;',
|
|
'begin',
|
|
' Result:=TJSAttr.JOBCast(Intf);',
|
|
'end;',
|
|
'',
|
|
'end.',
|
|
'']);
|
|
end;
|
|
|
|
procedure TTestWebIDL2WasmJob.TestWJ_IntfFunction_EnumResult;
|
|
begin
|
|
TestWebIDL([
|
|
'enum E { ',
|
|
' "allowed", ',
|
|
' "disallowed" ',
|
|
'}; ',
|
|
'interface IE { ',
|
|
' E get(long a); ',
|
|
'};'
|
|
],[
|
|
'Type',
|
|
' // Forward class definitions',
|
|
' IJSIE = interface;',
|
|
' TJSIE = class;',
|
|
' TE = UnicodeString;',
|
|
' { --------------------------------------------------------------------',
|
|
' TJSIE',
|
|
' --------------------------------------------------------------------}',
|
|
' IJSIE = interface(IJSObject)',
|
|
' ['''+FixedGUID+''']',
|
|
' function get(aA: LongInt) : TE;',
|
|
' end;',
|
|
'',
|
|
' TJSIE = class(TJSObject,IJSIE)',
|
|
' Private',
|
|
' Public',
|
|
' function get(aA: LongInt) : TE; overload;',
|
|
' class function JSClassName: UnicodeString; override;',
|
|
' class function Cast(const Intf: IJSObject): IJSIE;',
|
|
' end;',
|
|
'',
|
|
'implementation',
|
|
'',
|
|
'function TJSIE.get(aA: LongInt) : TE;',
|
|
'begin',
|
|
' Result:=InvokeJSUnicodeStringResult(''get'',[aA]);',
|
|
'end;',
|
|
'',
|
|
'class function TJSIE.JSClassName: UnicodeString;',
|
|
'begin',
|
|
' Result:=''IE'';',
|
|
'end;',
|
|
'',
|
|
'class function TJSIE.Cast(const Intf: IJSObject): IJSIE;',
|
|
'begin',
|
|
' Result:=TJSIE.JOBCast(Intf);',
|
|
'end;',
|
|
'',
|
|
'end.'
|
|
]);
|
|
end;
|
|
|
|
procedure TTestWebIDL2WasmJob.TestWJ_IntfFunction_SequenceArg;
|
|
begin
|
|
TestWebIDL([
|
|
'interface Attr {',
|
|
' boolean vibrate(sequence<long> pattern);',
|
|
'};',
|
|
''],
|
|
[
|
|
'Type',
|
|
'',
|
|
' // Forward class definitions',
|
|
' IJSAttr = interface;',
|
|
' TJSAttr = class;',
|
|
'',
|
|
' { --------------------------------------------------------------------',
|
|
' TJSAttr',
|
|
' --------------------------------------------------------------------}',
|
|
'',
|
|
' TLongIntDynArray = IJSArray; // array of long',
|
|
'',
|
|
' IJSAttr = interface(IJSObject)',
|
|
' ['''+FixedGUID+''']',
|
|
' function vibrate(const aPattern: TLongIntDynArray): Boolean;',
|
|
' end;',
|
|
'',
|
|
' TJSAttr = class(TJSObject,IJSAttr)',
|
|
' Private',
|
|
' Public',
|
|
' function vibrate(const aPattern: TLongIntDynArray): Boolean; overload;',
|
|
' class function JSClassName: UnicodeString; override;',
|
|
' class function Cast(const Intf: IJSObject): IJSAttr;',
|
|
' end;',
|
|
'',
|
|
'implementation',
|
|
'',
|
|
'function TJSAttr.vibrate(const aPattern: TLongIntDynArray): Boolean;',
|
|
'begin',
|
|
' Result:=InvokeJSBooleanResult(''vibrate'',[aPattern]);',
|
|
'end;',
|
|
'',
|
|
'class function TJSAttr.JSClassName: UnicodeString;',
|
|
'begin',
|
|
' Result:=''Attr'';',
|
|
'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',
|
|
' --------------------------------------------------------------------}',
|
|
'',
|
|
' TLongIntDynArray = IJSArray; // array of long',
|
|
'',
|
|
' IJSAttr = interface(IJSObject)',
|
|
' ['''+FixedGUID+''']',
|
|
' function vibrate(const aPattern: TLongIntDynArray): Boolean;',
|
|
' function beep(const aPattern: TLongIntDynArray): Boolean;',
|
|
' end;',
|
|
'',
|
|
' TJSAttr = class(TJSObject,IJSAttr)',
|
|
' Private',
|
|
' Public',
|
|
' function vibrate(const aPattern: TLongIntDynArray): Boolean; overload;',
|
|
' function beep(const aPattern: TLongIntDynArray): Boolean; overload;',
|
|
' class function JSClassName: UnicodeString; override;',
|
|
' class function Cast(const Intf: IJSObject): IJSAttr;',
|
|
' end;',
|
|
'',
|
|
'implementation',
|
|
'',
|
|
'function TJSAttr.vibrate(const aPattern: TLongIntDynArray): Boolean;',
|
|
'begin',
|
|
' Result:=InvokeJSBooleanResult(''vibrate'',[aPattern]);',
|
|
'end;',
|
|
'',
|
|
'function TJSAttr.beep(const aPattern: TLongIntDynArray): Boolean;',
|
|
'begin',
|
|
' Result:=InvokeJSBooleanResult(''beep'',[aPattern]);',
|
|
'end;',
|
|
'',
|
|
'class function TJSAttr.JSClassName: UnicodeString;',
|
|
'begin',
|
|
' Result:=''Attr'';',
|
|
'end;',
|
|
'',
|
|
'class function TJSAttr.Cast(const Intf: IJSObject): IJSAttr;',
|
|
'begin',
|
|
' Result:=TJSAttr.JOBCast(Intf);',
|
|
'end;',
|
|
'',
|
|
'end.'
|
|
]);
|
|
end;
|
|
|
|
procedure TTestWebIDL2WasmJob.TestWJ_IntfFunction_Constructor;
|
|
begin
|
|
TestWebIDL([
|
|
'interface Attr {',
|
|
' constructor(long options); ',
|
|
'};'
|
|
],
|
|
['Type',
|
|
' // Forward class definitions',
|
|
' IJSAttr = interface;',
|
|
' TJSAttr = class;',
|
|
' { --------------------------------------------------------------------',
|
|
' TJSAttr',
|
|
' --------------------------------------------------------------------}',
|
|
'',
|
|
' IJSAttr = interface(IJSObject)',
|
|
' ['''+FixedGUID+''']',
|
|
' end;',
|
|
'',
|
|
' TJSAttr = class(TJSObject,IJSAttr)',
|
|
' Private',
|
|
' Public',
|
|
' constructor Create(aOptions: LongInt); overload;',
|
|
' class function JSClassName: UnicodeString; override;',
|
|
' class function Cast(const Intf: IJSObject): IJSAttr;',
|
|
' end;',
|
|
'',
|
|
'implementation',
|
|
'',
|
|
'constructor TJSAttr.Create(aOptions: LongInt);',
|
|
'begin',
|
|
' JOBCreate([aOptions]);',
|
|
'end;',
|
|
'',
|
|
'class function TJSAttr.JSClassName: UnicodeString;',
|
|
'begin',
|
|
' Result:=''Attr'';',
|
|
'end;',
|
|
'',
|
|
'class function TJSAttr.Cast(const Intf: IJSObject): IJSAttr;',
|
|
'begin',
|
|
' Result:=TJSAttr.JOBCast(Intf);',
|
|
'end;',
|
|
'',
|
|
'end.',
|
|
'']);
|
|
end;
|
|
|
|
procedure TTestWebIDL2WasmJob.TestWJ_IntfFunction_ArrayBufferArg;
|
|
begin
|
|
TestWebIDL([
|
|
'interface Attr {',
|
|
' undefined appendBuffer(ArrayBuffer data);',
|
|
'};'
|
|
],[
|
|
'Type',
|
|
' // Forward class definitions',
|
|
' IJSAttr = interface;',
|
|
' TJSAttr = class;',
|
|
' { --------------------------------------------------------------------',
|
|
' TJSAttr',
|
|
' --------------------------------------------------------------------}',
|
|
'',
|
|
' IJSAttr = interface(IJSObject)',
|
|
' ['''+FixedGUID+''']',
|
|
' procedure appendBuffer(aData: IJSArrayBuffer);',
|
|
' end;',
|
|
'',
|
|
' TJSAttr = class(TJSObject,IJSAttr)',
|
|
' Private',
|
|
' Public',
|
|
' procedure appendBuffer(aData: IJSArrayBuffer); overload;',
|
|
' class function JSClassName: UnicodeString; override;',
|
|
' class function Cast(const Intf: IJSObject): IJSAttr;',
|
|
' end;',
|
|
'',
|
|
'implementation',
|
|
'',
|
|
'procedure TJSAttr.appendBuffer(aData: IJSArrayBuffer);',
|
|
'begin',
|
|
' InvokeJSNoResult(''appendBuffer'',[aData]);',
|
|
'end;',
|
|
'',
|
|
'class function TJSAttr.JSClassName: UnicodeString;',
|
|
'begin',
|
|
' Result:=''Attr'';',
|
|
'end;',
|
|
'',
|
|
'class function TJSAttr.Cast(const Intf: IJSObject): IJSAttr;',
|
|
'begin',
|
|
' Result:=TJSAttr.JOBCast(Intf);',
|
|
'end;',
|
|
'',
|
|
'end.',
|
|
'' ]);
|
|
|
|
end;
|
|
|
|
procedure TTestWebIDL2WasmJob.TestWJ_IntfFunction_ArrayBufferViewArg;
|
|
begin
|
|
TestWebIDL([
|
|
'interface Attr {',
|
|
' undefined appendBuffer(ArrayBufferView data);',
|
|
'};'
|
|
],[
|
|
'Type',
|
|
' // Forward class definitions',
|
|
' IJSAttr = interface;',
|
|
' TJSAttr = class;',
|
|
' { --------------------------------------------------------------------',
|
|
' TJSAttr',
|
|
' --------------------------------------------------------------------}',
|
|
'',
|
|
' IJSAttr = interface(IJSObject)',
|
|
' ['''+FixedGUID+''']',
|
|
' procedure appendBuffer(aData: IJSArrayBufferView);',
|
|
' end;',
|
|
'',
|
|
' TJSAttr = class(TJSObject,IJSAttr)',
|
|
' Private',
|
|
' Public',
|
|
' procedure appendBuffer(aData: IJSArrayBufferView); overload;',
|
|
' class function JSClassName: UnicodeString; override;',
|
|
' class function Cast(const Intf: IJSObject): IJSAttr;',
|
|
' end;',
|
|
'',
|
|
'implementation',
|
|
'',
|
|
'procedure TJSAttr.appendBuffer(aData: IJSArrayBufferView);',
|
|
'begin',
|
|
' InvokeJSNoResult(''appendBuffer'',[aData]);',
|
|
'end;',
|
|
'',
|
|
'class function TJSAttr.JSClassName: UnicodeString;',
|
|
'begin',
|
|
' Result:=''Attr'';',
|
|
'end;',
|
|
'',
|
|
'class function TJSAttr.Cast(const Intf: IJSObject): IJSAttr;',
|
|
'begin',
|
|
' Result:=TJSAttr.JOBCast(Intf);',
|
|
'end;',
|
|
'',
|
|
'end.',
|
|
'' ]);
|
|
end;
|
|
|
|
procedure TTestWebIDL2WasmJob.TestWJ_IntfFunction_SequenceResult;
|
|
begin
|
|
TestWebIDL([
|
|
'interface Attr {',
|
|
' sequence<long> vibrate();',
|
|
'};',
|
|
''],
|
|
[
|
|
'Type',
|
|
'',
|
|
' // Forward class definitions',
|
|
' IJSAttr = interface;',
|
|
' TJSAttr = class;',
|
|
'',
|
|
' { --------------------------------------------------------------------',
|
|
' TJSAttr',
|
|
' --------------------------------------------------------------------}',
|
|
'',
|
|
' TLongIntDynArray = IJSArray; // array of long',
|
|
'',
|
|
' IJSAttr = interface(IJSObject)',
|
|
' ['''+FixedGUID+''']',
|
|
' function vibrate: TLongIntDynArray;',
|
|
' end;',
|
|
'',
|
|
' TJSAttr = class(TJSObject,IJSAttr)',
|
|
' Private',
|
|
' Public',
|
|
' function vibrate: TLongIntDynArray; overload;',
|
|
' class function JSClassName: UnicodeString; override;',
|
|
' class function Cast(const Intf: IJSObject): IJSAttr;',
|
|
' end;',
|
|
'',
|
|
'implementation',
|
|
'',
|
|
'function TJSAttr.vibrate: TLongIntDynArray;',
|
|
'begin',
|
|
' Result:=InvokeJSObjectResult(''vibrate'',[],TJSArray) as TLongIntDynArray;',
|
|
'end;',
|
|
'',
|
|
'class function TJSAttr.JSClassName: UnicodeString;',
|
|
'begin',
|
|
' Result:=''Attr'';',
|
|
'end;',
|
|
'',
|
|
'class function TJSAttr.Cast(const Intf: IJSObject): IJSAttr;',
|
|
'begin',
|
|
' Result:=TJSAttr.JOBCast(Intf);',
|
|
'end;',
|
|
'',
|
|
'end.'
|
|
]);
|
|
end;
|
|
|
|
procedure TTestWebIDL2WasmJob.TestWJ_IntfFunction_GlobalSequenceResult;
|
|
begin
|
|
TestWebIDL([
|
|
'typedef sequence <long> LongSeq;',
|
|
'interface Attr {',
|
|
' LongSeq vibrate();',
|
|
'};',
|
|
''],
|
|
[
|
|
'Type',
|
|
'',
|
|
' // Forward class definitions',
|
|
' IJSAttr = interface;',
|
|
' TJSAttr = class;',
|
|
' TLongSeqDynArray = IJSArray; // array of long',
|
|
'',
|
|
' { --------------------------------------------------------------------',
|
|
' TJSAttr',
|
|
' --------------------------------------------------------------------}',
|
|
'',
|
|
' IJSAttr = interface(IJSObject)',
|
|
' ['''+FixedGUID+''']',
|
|
' function vibrate: TLongSeqDynArray;',
|
|
' end;',
|
|
'',
|
|
' TJSAttr = class(TJSObject,IJSAttr)',
|
|
' Private',
|
|
' Public',
|
|
' function vibrate: TLongSeqDynArray; overload;',
|
|
' class function JSClassName: UnicodeString; override;',
|
|
' class function Cast(const Intf: IJSObject): IJSAttr;',
|
|
' end;',
|
|
'',
|
|
'implementation',
|
|
'',
|
|
'function TJSAttr.vibrate: TLongSeqDynArray;',
|
|
'begin',
|
|
' Result:=InvokeJSObjectResult(''vibrate'',[],TJSArray) as TLongSeqDynArray;',
|
|
'end;',
|
|
'',
|
|
'class function TJSAttr.JSClassName: UnicodeString;',
|
|
'begin',
|
|
' Result:=''Attr'';',
|
|
'end;',
|
|
'',
|
|
'class function TJSAttr.Cast(const Intf: IJSObject): IJSAttr;',
|
|
'begin',
|
|
' Result:=TJSAttr.JOBCast(Intf);',
|
|
'end;',
|
|
'',
|
|
'end.'
|
|
]);
|
|
|
|
end;
|
|
|
|
procedure TTestWebIDL2WasmJob.TestWJ_IntfFunction_ChromeOnly;
|
|
begin
|
|
TestWebIDL([
|
|
'interface Attr {',
|
|
' [ChromeOnly, Throws] long soso();',
|
|
'};',
|
|
''],
|
|
[
|
|
'Type',
|
|
' // Forward class definitions',
|
|
' IJSAttr = interface;',
|
|
' TJSAttr = class;',
|
|
' { --------------------------------------------------------------------',
|
|
' TJSAttr',
|
|
' --------------------------------------------------------------------}',
|
|
'',
|
|
' IJSAttr = interface(IJSObject)',
|
|
' ['''+FixedGUID+''']',
|
|
' end;',
|
|
'',
|
|
' TJSAttr = class(TJSObject,IJSAttr)',
|
|
' Private',
|
|
' Public',
|
|
' class function JSClassName: UnicodeString; override;',
|
|
' class function Cast(const Intf: IJSObject): IJSAttr;',
|
|
' end;',
|
|
'',
|
|
'implementation',
|
|
'',
|
|
'class function TJSAttr.JSClassName: UnicodeString;',
|
|
'begin',
|
|
' Result:=''Attr'';',
|
|
'end;',
|
|
'',
|
|
'class function TJSAttr.Cast(const Intf: IJSObject): IJSAttr;',
|
|
'begin',
|
|
' Result:=TJSAttr.JOBCast(Intf);',
|
|
'end;',
|
|
'',
|
|
'end.',
|
|
''
|
|
]);
|
|
end;
|
|
|
|
procedure TTestWebIDL2WasmJob.TestWJ_IntfFunction_ChromeOnlyNewObject;
|
|
begin
|
|
|
|
TestWebIDL([
|
|
'interface Attr {',
|
|
' [ChromeOnly, NewObject] ',
|
|
' ConsoleInstance createInstance(optional ConsoleInstanceOptions options = {});',
|
|
'};'
|
|
],
|
|
[
|
|
'Type',
|
|
' // Forward class definitions',
|
|
' IJSAttr = interface;',
|
|
' TJSAttr = class;',
|
|
' { --------------------------------------------------------------------',
|
|
' TJSAttr',
|
|
' --------------------------------------------------------------------}',
|
|
'',
|
|
' IJSAttr = interface(IJSObject)',
|
|
' ['''+FixedGUID+''']',
|
|
' end;',
|
|
'',
|
|
' TJSAttr = class(TJSObject,IJSAttr)',
|
|
' Private',
|
|
' Public',
|
|
' class function JSClassName: UnicodeString; override;',
|
|
' class function Cast(const Intf: IJSObject): IJSAttr;',
|
|
' end;',
|
|
'',
|
|
'implementation',
|
|
'',
|
|
'class function TJSAttr.JSClassName: UnicodeString;',
|
|
'begin',
|
|
' Result:=''Attr'';',
|
|
'end;',
|
|
'',
|
|
'class function TJSAttr.Cast(const Intf: IJSObject): IJSAttr;',
|
|
'begin',
|
|
' Result:=TJSAttr.JOBCast(Intf);',
|
|
'end;',
|
|
'',
|
|
'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;',
|
|
' IJSMyDict = interface;',
|
|
' TJSMyDict = class;',
|
|
'',
|
|
' { --------------------------------------------------------------------',
|
|
' TJSMyDict',
|
|
' --------------------------------------------------------------------}',
|
|
'',
|
|
' TJSMyDictRec = record',
|
|
' a: LongInt;',
|
|
' end;',
|
|
'',
|
|
' IJSMyDict = interface(IJSObject)',
|
|
' ['''+FixedGUID+''']',
|
|
' function _Geta: LongInt;',
|
|
' procedure _Seta(const aValue: LongInt);',
|
|
' property a: LongInt read _Geta write _Seta;',
|
|
' end;',
|
|
'',
|
|
' TJSMyDict = class(TJSObject,IJSMyDict)',
|
|
' Private',
|
|
' function _Geta: LongInt;',
|
|
' procedure _Seta(const aValue: LongInt);',
|
|
' Public',
|
|
' class function JSClassName: UnicodeString; override;',
|
|
' class function Cast(const Intf: IJSObject): IJSMyDict;',
|
|
' property a: LongInt read _Geta write _Seta;',
|
|
' end;',
|
|
'',
|
|
' { --------------------------------------------------------------------',
|
|
' TJSAttr',
|
|
' --------------------------------------------------------------------}',
|
|
'',
|
|
'',
|
|
' IJSAttr = interface(IJSObject)',
|
|
' ['''+FixedGUID+''']',
|
|
' function get: TJSMyDict;',
|
|
' end;',
|
|
'',
|
|
' TJSAttr = class(TJSObject,IJSAttr)',
|
|
' Private',
|
|
' Public',
|
|
' function get: TJSMyDict; overload;',
|
|
' class function JSClassName: UnicodeString; override;',
|
|
' class function Cast(const Intf: IJSObject): IJSAttr;',
|
|
' end;',
|
|
'',
|
|
'implementation',
|
|
'',
|
|
'function TJSMyDict._Geta: LongInt;',
|
|
'begin',
|
|
' Result:=ReadJSPropertyLongInt(''a'');',
|
|
'end;',
|
|
'',
|
|
'procedure TJSMyDict._Seta(const aValue: LongInt);',
|
|
'begin',
|
|
' WriteJSPropertyLongInt(''a'',aValue);',
|
|
'end;',
|
|
'',
|
|
'class function TJSMyDict.JSClassName: UnicodeString;',
|
|
'begin',
|
|
' Result:=''Object'';',
|
|
'end;',
|
|
'',
|
|
'class function TJSMyDict.Cast(const Intf: IJSObject): IJSMyDict;',
|
|
'begin',
|
|
' Result:=TJSMyDict.JOBCast(Intf);',
|
|
'end;',
|
|
'',
|
|
'function TJSAttr.get: TJSMyDict;',
|
|
'begin',
|
|
' Result:=InvokeJSObjectResult(''get'',[],TJSMyDict) as TJSMyDict;',
|
|
'end;',
|
|
'',
|
|
'class function TJSAttr.JSClassName: UnicodeString;',
|
|
'begin',
|
|
' Result:=''Attr'';',
|
|
'end;',
|
|
'',
|
|
'class function TJSAttr.Cast(const Intf: IJSObject): IJSAttr;',
|
|
'begin',
|
|
' Result:=TJSAttr.JOBCast(Intf);',
|
|
'end;',
|
|
'',
|
|
'end.'
|
|
]);
|
|
end;
|
|
|
|
procedure TTestWebIDL2WasmJob.TestWJ_IntfFunction_AliasResult;
|
|
|
|
begin
|
|
WebIDLToPas.TypeAliases.Add('Float32Array=IJSFloat32Array');
|
|
TestWebIDL([
|
|
'interface Attr {',
|
|
' Float32Array vibrate();',
|
|
'};',
|
|
''],
|
|
[
|
|
'Type',
|
|
'',
|
|
' // Forward class definitions',
|
|
' IJSAttr = interface;',
|
|
' TJSAttr = class;',
|
|
'',
|
|
' { --------------------------------------------------------------------',
|
|
' TJSAttr',
|
|
' --------------------------------------------------------------------}',
|
|
'',
|
|
' IJSAttr = interface(IJSObject)',
|
|
' ['''+FixedGUID+''']',
|
|
' function vibrate: IJSFloat32Array;',
|
|
' end;',
|
|
'',
|
|
' TJSAttr = class(TJSObject,IJSAttr)',
|
|
' Private',
|
|
' Public',
|
|
' function vibrate: IJSFloat32Array; overload;',
|
|
' class function JSClassName: UnicodeString; override;',
|
|
' class function Cast(const Intf: IJSObject): IJSAttr;',
|
|
' end;',
|
|
'',
|
|
'implementation',
|
|
'',
|
|
'function TJSAttr.vibrate: IJSFloat32Array;',
|
|
'begin',
|
|
' Result:=InvokeJSObjectResult(''vibrate'',[],TJSArray) as IJSFloat32Array;',
|
|
'end;',
|
|
'',
|
|
'class function TJSAttr.JSClassName: UnicodeString;',
|
|
'begin',
|
|
' Result:=''Attr'';',
|
|
'end;',
|
|
'',
|
|
'class function TJSAttr.Cast(const Intf: IJSObject): IJSAttr;',
|
|
'begin',
|
|
' Result:=TJSAttr.JOBCast(Intf);',
|
|
'end;',
|
|
'',
|
|
'end.'
|
|
]);
|
|
end;
|
|
|
|
procedure TTestWebIDL2WasmJob.TestWJ_IntfFunction_NestedUnionSequence;
|
|
begin
|
|
TestWebIDL([
|
|
'interface Attr {',
|
|
' long roundRect((double or sequence<(double or long)>) radii);',
|
|
'};',
|
|
''],
|
|
[
|
|
'Type',
|
|
'',
|
|
' // Forward class definitions',
|
|
' IJSAttr = interface;',
|
|
' TJSAttr = class;',
|
|
'',
|
|
' { --------------------------------------------------------------------',
|
|
' TJSAttr',
|
|
' --------------------------------------------------------------------}',
|
|
'',
|
|
' // Union of double, sequence',
|
|
' TAttr_roundRect_radii_Type = Variant;',
|
|
' TunionDynArray = IJSArray; // array of union',
|
|
' IJSAttr = interface(IJSObject)',
|
|
' ['''+FixedGUID+''']',
|
|
' function roundRect(aRadii: Double): LongInt;',
|
|
' function roundRect(const aRadii: TunionDynArray): LongInt;',
|
|
' end;',
|
|
'',
|
|
' TJSAttr = class(TJSObject,IJSAttr)',
|
|
' Private',
|
|
' Public',
|
|
' function roundRect(aRadii: Double): LongInt; overload;',
|
|
' function roundRect(const aRadii: TunionDynArray): LongInt; overload;',
|
|
' class function JSClassName: UnicodeString; override;',
|
|
' class function Cast(const Intf: IJSObject): IJSAttr;',
|
|
' end;',
|
|
'',
|
|
'implementation',
|
|
'',
|
|
'function TJSAttr.roundRect(aRadii: Double): LongInt;',
|
|
'begin',
|
|
' Result:=InvokeJSLongIntResult(''roundRect'',[aRadii]);',
|
|
'end;',
|
|
'',
|
|
'function TJSAttr.roundRect(const aRadii: TunionDynArray): LongInt;',
|
|
'begin',
|
|
' Result:=InvokeJSLongIntResult(''roundRect'',[aRadii]);',
|
|
'end;',
|
|
'',
|
|
'class function TJSAttr.JSClassName: UnicodeString;',
|
|
'begin',
|
|
' Result:=''Attr'';',
|
|
'end;',
|
|
'',
|
|
'class function TJSAttr.Cast(const Intf: IJSObject): IJSAttr;',
|
|
'begin',
|
|
' Result:=TJSAttr.JOBCast(Intf);',
|
|
'end;',
|
|
'',
|
|
'end.'
|
|
]);
|
|
end;
|
|
|
|
procedure TTestWebIDL2WasmJob.TestWJ_intfFunction_UnionOptional;
|
|
begin
|
|
TestwebIDL(
|
|
['interface Attr {',
|
|
' void roundRect((DOMString or sequence<DOMString>) a, optional long b);',
|
|
'};'
|
|
],[
|
|
'Type',
|
|
'',
|
|
' // Forward class definitions',
|
|
' IJSAttr = interface;',
|
|
' TJSAttr = class;',
|
|
'',
|
|
' { --------------------------------------------------------------------',
|
|
' TJSAttr',
|
|
' --------------------------------------------------------------------}',
|
|
' // Union of DOMString, sequence',
|
|
' TAttr_roundRect_a_Type = Variant;',
|
|
' TUnicodeStringDynArray = IJSArray; // array of DOMString',
|
|
' IJSAttr = interface(IJSObject)',
|
|
' ['''+FixedGUID+''']',
|
|
' procedure roundRect(const aA: UnicodeString; aB: LongInt);',
|
|
' procedure roundRect(const aA: TUnicodeStringDynArray; aB: LongInt);',
|
|
' procedure roundRect(const aA: TUnicodeStringDynArray);',
|
|
' procedure roundRect(const aA: UnicodeString);',
|
|
' end;',
|
|
'',
|
|
' TJSAttr = class(TJSObject,IJSAttr)',
|
|
' Private',
|
|
' Public',
|
|
' procedure roundRect(const aA: UnicodeString; aB: LongInt); overload;',
|
|
' procedure roundRect(const aA: TUnicodeStringDynArray; aB: LongInt); overload;',
|
|
' procedure roundRect(const aA: TUnicodeStringDynArray); overload;',
|
|
' procedure roundRect(const aA: UnicodeString); overload;',
|
|
' class function JSClassName: UnicodeString; override;',
|
|
' class function Cast(const Intf: IJSObject): IJSAttr;',
|
|
' end;',
|
|
'',
|
|
'implementation',
|
|
'',
|
|
'procedure TJSAttr.roundRect(const aA: UnicodeString; aB: LongInt);',
|
|
'begin',
|
|
' InvokeJSNoResult(''roundRect'',[aA,aB]);',
|
|
'end;',
|
|
'',
|
|
'procedure TJSAttr.roundRect(const aA: TUnicodeStringDynArray; aB: LongInt);',
|
|
'begin',
|
|
' InvokeJSNoResult(''roundRect'',[aA,aB]);',
|
|
'end;',
|
|
'',
|
|
'procedure TJSAttr.roundRect(const aA: TUnicodeStringDynArray);',
|
|
'begin',
|
|
' InvokeJSNoResult(''roundRect'',[aA]);',
|
|
'end;',
|
|
'',
|
|
'procedure TJSAttr.roundRect(const aA: UnicodeString);',
|
|
'begin',
|
|
' InvokeJSNoResult(''roundRect'',[aA]);',
|
|
'end;',
|
|
'',
|
|
'class function TJSAttr.JSClassName: UnicodeString;',
|
|
'begin',
|
|
' Result:=''Attr'';',
|
|
'end;',
|
|
'',
|
|
'class function TJSAttr.Cast(const Intf: IJSObject): IJSAttr;',
|
|
'begin',
|
|
' Result:=TJSAttr.JOBCast(Intf);',
|
|
'end;',
|
|
'',
|
|
'end.'
|
|
]);
|
|
end;
|
|
|
|
|
|
procedure TTestWebIDL2WasmJob.TestWJ_NamespaceAttribute_Boolean;
|
|
begin
|
|
TestWebIDL([
|
|
'namespace Attr {',
|
|
' readonly attribute boolean aBoolean;',
|
|
'};',
|
|
''],
|
|
['Type',
|
|
' // Forward class definitions',
|
|
' IJSAttr = interface;',
|
|
' TJSAttr = class;',
|
|
' { --------------------------------------------------------------------',
|
|
' TJSAttr',
|
|
' --------------------------------------------------------------------}',
|
|
'',
|
|
' IJSAttr = interface(IJSObject)',
|
|
' ['''+FixedGUID+''']',
|
|
' function _GetaBoolean: Boolean;',
|
|
' property aBoolean: Boolean read _GetaBoolean;',
|
|
' end;',
|
|
'',
|
|
' TJSAttr = class(TJSObject,IJSAttr)',
|
|
' Private',
|
|
' function _GetaBoolean: Boolean;',
|
|
' Public',
|
|
' class function JSClassName: UnicodeString; override;',
|
|
' class function Cast(const Intf: IJSObject): IJSAttr;',
|
|
' property aBoolean: Boolean read _GetaBoolean;',
|
|
' end;',
|
|
'',
|
|
'var ',
|
|
' Attr : IJSAttr;',
|
|
'',
|
|
'implementation',
|
|
'',
|
|
'function TJSAttr._GetaBoolean: Boolean;',
|
|
'begin',
|
|
' Result:=ReadJSPropertyBoolean(''aBoolean'');',
|
|
'end;',
|
|
'',
|
|
'class function TJSAttr.JSClassName: UnicodeString;',
|
|
'begin',
|
|
' Result:=''Attr'';',
|
|
'end;',
|
|
'',
|
|
'class function TJSAttr.Cast(const Intf: IJSObject): IJSAttr;',
|
|
'begin',
|
|
' Result:=TJSAttr.JOBCast(Intf);',
|
|
'end;',
|
|
'',
|
|
'initialization',
|
|
' Attr:=TJSAttr.JOBCreateGlobal(''Attr'');',
|
|
'',
|
|
'finalization',
|
|
' Attr:=Nil;',
|
|
'',
|
|
'end.',
|
|
'']);
|
|
|
|
end;
|
|
|
|
procedure TTestWebIDL2WasmJob.TestWJ_MaplikeInterface;
|
|
begin
|
|
TestWebIDL([
|
|
' interface PM {',
|
|
' readonly maplike<DOMString, boolean>;',
|
|
' };'
|
|
],[
|
|
'Type',
|
|
' // Forward class definitions',
|
|
' IJSPM = interface;',
|
|
' TJSPM = class;',
|
|
' { --------------------------------------------------------------------',
|
|
' TJSPM',
|
|
' --------------------------------------------------------------------}',
|
|
'',
|
|
' IJSPM = interface(IJSObject)',
|
|
' ['''+FixedGUID+''']',
|
|
' function _Getsize: LongInt;',
|
|
' function get(key: UnicodeString) : Boolean;',
|
|
' function has(key: UnicodeString) : Boolean;',
|
|
' function entries : IJSIterator;',
|
|
' function keys : IJSIterator;',
|
|
' function values : IJSIterator;',
|
|
' property size : LongInt read _Getsize;',
|
|
' end;',
|
|
'',
|
|
' TJSPM = class(TJSObject,IJSPM)',
|
|
' Private',
|
|
' function _Getsize: LongInt;',
|
|
' Public',
|
|
' function get(key: UnicodeString) : Boolean;',
|
|
' function has(key: UnicodeString) : Boolean;',
|
|
' function entries : IJSIterator;',
|
|
' function keys : IJSIterator;',
|
|
' function values : IJSIterator;',
|
|
' class function JSClassName: UnicodeString; override;',
|
|
' class function Cast(const Intf: IJSObject): IJSPM;',
|
|
' property size : LongInt read _Getsize;',
|
|
' end;',
|
|
'',
|
|
'implementation',
|
|
'',
|
|
'function TJSPM._Getsize: LongInt;',
|
|
'begin',
|
|
' Result:=ReadJSPropertyLongInt(''size'');',
|
|
'end;',
|
|
'',
|
|
'function TJSPM.get(key: UnicodeString) : Boolean;',
|
|
'begin',
|
|
' Result:=InvokeJSBooleanResult(''get'',[key]);',
|
|
'end;',
|
|
'',
|
|
'function TJSPM.has(key: UnicodeString) : Boolean;',
|
|
'begin',
|
|
' Result:=InvokeJSBooleanResult(''has'',[key]);',
|
|
'end;',
|
|
'',
|
|
'function TJSPM.entries : IJSIterator;',
|
|
'begin',
|
|
' Result:=InvokeJSObjectResult(''entries'',[],TJSIterator) as IJSIterator;',
|
|
'end;',
|
|
'',
|
|
'function TJSPM.keys : IJSIterator;',
|
|
'begin',
|
|
' Result:=InvokeJSObjectResult(''keys'',[],TJSIterator) as IJSIterator;',
|
|
'end;',
|
|
'',
|
|
'function TJSPM.values : IJSIterator;',
|
|
'begin',
|
|
' Result:=InvokeJSObjectResult(''values'',[],TJSIterator) as IJSIterator;',
|
|
'end;',
|
|
'',
|
|
'class function TJSPM.JSClassName: UnicodeString;',
|
|
'begin',
|
|
' Result:=''PM'';',
|
|
'end;',
|
|
'',
|
|
'class function TJSPM.Cast(const Intf: IJSObject): IJSPM;',
|
|
'begin',
|
|
' Result:=TJSPM.JOBCast(Intf);',
|
|
'end;',
|
|
'',
|
|
'end.',
|
|
''
|
|
]);
|
|
end;
|
|
|
|
initialization
|
|
RegisterTests([TTestWebIDL2Wasmjob]);
|
|
|
|
end.
|
|
|