mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-08 07:08:12 +02:00
* webidl added
git-svn-id: trunk@39292 -
This commit is contained in:
michael
parent
426c610f13
commit
e655b9137b
14
.gitattributes
vendored
14
.gitattributes
vendored
@ -8130,6 +8130,20 @@ packages/uuid/examples/testuid.pp svneol=native#text/plain
|
||||
packages/uuid/fpmake.pp svneol=native#text/plain
|
||||
packages/uuid/src/libuuid.pp svneol=native#text/plain
|
||||
packages/uuid/src/macuuid.pp svneol=native#text/plain
|
||||
packages/webidl/Makefile svneol=native#text/plain
|
||||
packages/webidl/Makefile.fpc svneol=native#text/plain
|
||||
packages/webidl/examples/parsewebidl.lpi svneol=native#text/plain
|
||||
packages/webidl/examples/parsewebidl.pas svneol=native#text/plain
|
||||
packages/webidl/fpmake.pp svneol=native#text/plain
|
||||
packages/webidl/src/webidldefs.pp svneol=native#text/plain
|
||||
packages/webidl/src/webidlparser.pp svneol=native#text/plain
|
||||
packages/webidl/src/webidlscanner.pp svneol=native#text/plain
|
||||
packages/webidl/src/webidltopas.pp svneol=native#text/plain
|
||||
packages/webidl/tests/tcidlparser.pp svneol=native#text/plain
|
||||
packages/webidl/tests/tcidlscanner.pp svneol=native#text/plain
|
||||
packages/webidl/tests/tcwebidldefs.pp svneol=native#text/plain
|
||||
packages/webidl/tests/testidl.lpi svneol=native#text/plain
|
||||
packages/webidl/tests/testidl.pas svneol=native#text/plain
|
||||
packages/winceunits/Makefile svneol=native#text/plain
|
||||
packages/winceunits/Makefile.fpc svneol=native#text/plain
|
||||
packages/winceunits/Makefile.fpc.fpcmake svneol=native#text/plain
|
||||
|
||||
@ -138,5 +138,6 @@
|
||||
add_libgc(ADirectory+IncludeTrailingPathDelimiter('libgc'));
|
||||
add_libfontconfig(ADirectory+IncludeTrailingPathDelimiter('libfontconfig'));
|
||||
add_fcl_report(ADirectory+IncludeTrailingPathDelimiter('fcl-report'));
|
||||
add_webidl(ADirectory+IncludeTrailingPathDelimiter('webidl'));
|
||||
add_ide(ADirectory+IncludeTrailingPathDelimiter('ide'));
|
||||
|
||||
|
||||
@ -789,4 +789,11 @@ begin
|
||||
{$include fcl-report/fpmake.pp}
|
||||
end;
|
||||
|
||||
procedure add_webidl(const ADirectory: string);
|
||||
begin
|
||||
with Installer do
|
||||
{$include webidl/fpmake.pp}
|
||||
end;
|
||||
|
||||
|
||||
{$include ide/fpmake.pp}
|
||||
|
||||
2742
packages/webidl/Makefile
Normal file
2742
packages/webidl/Makefile
Normal file
File diff suppressed because it is too large
Load Diff
102
packages/webidl/Makefile.fpc
Normal file
102
packages/webidl/Makefile.fpc
Normal file
@ -0,0 +1,102 @@
|
||||
#
|
||||
# Makefile.fpc for running fpmake
|
||||
#
|
||||
|
||||
[package]
|
||||
name=webidl
|
||||
version=3.1.1
|
||||
|
||||
[require]
|
||||
packages=rtl rtl-objpas fpmkunit fcl-base
|
||||
|
||||
[install]
|
||||
fpcpackage=y
|
||||
|
||||
[default]
|
||||
fpcdir=../..
|
||||
|
||||
[prerules]
|
||||
FPMAKE_BIN_CLEAN=$(wildcard ./fpmake$(SRCEXEEXT))
|
||||
ifdef OS_TARGET
|
||||
FPC_TARGETOPT+=--os=$(OS_TARGET)
|
||||
endif
|
||||
ifdef CPU_TARGET
|
||||
FPC_TARGETOPT+=--cpu=$(CPU_TARGET)
|
||||
endif
|
||||
LOCALFPMAKE=./fpmake$(SRCEXEEXT)
|
||||
|
||||
[rules]
|
||||
# Do not pass the Makefile's unit and binary target locations. Fpmake uses it's own.
|
||||
override FPCOPT:=$(filter-out -FU%,$(FPCOPT))
|
||||
override FPCOPT:=$(filter-out -FE%,$(FPCOPT))
|
||||
# Do not pass the package-unitdirectories. Fpmake adds those and this way they don't apear in the .fpm
|
||||
override FPCOPT:=$(filter-out $(addprefix -Fu,$(COMPILER_UNITDIR)),$(FPCOPT))# Compose general fpmake-parameters
|
||||
# Compose general fpmake-parameters
|
||||
ifdef FPMAKEOPT
|
||||
FPMAKE_OPT+=$(FPMAKEOPT)
|
||||
endif
|
||||
FPMAKE_OPT+=--localunitdir=../..
|
||||
FPMAKE_OPT+=--globalunitdir=..
|
||||
FPMAKE_OPT+=$(FPC_TARGETOPT)
|
||||
FPMAKE_OPT+=$(addprefix -o ,$(FPCOPT))
|
||||
FPMAKE_OPT+=--compiler=$(FPC)
|
||||
FPMAKE_OPT+=-bu
|
||||
.NOTPARALLEL:
|
||||
|
||||
fpmake$(SRCEXEEXT): fpmake.pp
|
||||
$(FPCFPMAKE) fpmake.pp $(FPMAKE_SKIP_CONFIG) $(addprefix -Fu,$(COMPILER_FPMAKE_UNITDIR)) $(FPCMAKEOPT) $(OPT)
|
||||
all: fpmake$(SRCEXEEXT)
|
||||
$(LOCALFPMAKE) compile $(FPMAKE_OPT)
|
||||
smart: fpmake$(SRCEXEEXT)
|
||||
$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -XX -o -CX
|
||||
release: fpmake$(SRCEXEEXT)
|
||||
$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -dRELEASE
|
||||
debug: fpmake$(SRCEXEEXT)
|
||||
$(LOCALFPMAKE) compile $(FPMAKE_OPT) -o -dDEBUG
|
||||
# If no fpmake exists and (dist)clean is called, do not try to build fpmake, it will
|
||||
# most often fail because the dependencies are cleared.
|
||||
# In case of a clean, simply do nothing
|
||||
ifeq ($(FPMAKE_BIN_CLEAN),)
|
||||
clean:
|
||||
else
|
||||
clean:
|
||||
$(FPMAKE_BIN_CLEAN) clean $(FPMAKE_OPT)
|
||||
endif
|
||||
# In case of a distclean, perform an 'old'-style distclean. This to avoid problems
|
||||
# when the package is compiled using fpcmake prior to running this clean using fpmake
|
||||
ifeq ($(FPMAKE_BIN_CLEAN),)
|
||||
distclean: $(addsuffix _distclean,$(TARGET_DIRS)) fpc_cleanall
|
||||
else
|
||||
distclean:
|
||||
ifdef inUnix
|
||||
{ $(FPMAKE_BIN_CLEAN) distclean $(FPMAKE_OPT); if [ $$? != "0" ]; then { echo Something wrong with fpmake exectable. Remove the executable and call make recursively to recover.; $(DEL) $(FPMAKE_BIN_CLEAN); $(MAKE) fpc_cleanall; }; fi; }
|
||||
else
|
||||
$(FPMAKE_BIN_CLEAN) distclean $(FPMAKE_OPT)
|
||||
endif
|
||||
-$(DEL) $(LOCALFPMAKE)
|
||||
endif
|
||||
cleanall: distclean
|
||||
install: fpmake$(SRCEXEEXT)
|
||||
ifdef UNIXHier
|
||||
$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_PREFIX) --baseinstalldir=$(INSTALL_LIBDIR)/fpc/$(FPC_VERSION) --unitinstalldir=$(INSTALL_UNITDIR)
|
||||
else
|
||||
$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_BASEDIR) --baseinstalldir=$(INSTALL_BASEDIR) --unitinstalldir=$(INSTALL_UNITDIR)
|
||||
endif
|
||||
# distinstall also installs the example-sources and omits the location of the source-
|
||||
# files from the fpunits.cfg files.
|
||||
distinstall: fpmake$(SRCEXEEXT)
|
||||
ifdef UNIXHier
|
||||
$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_PREFIX) --baseinstalldir=$(INSTALL_LIBDIR)/fpc/$(FPC_VERSION) --unitinstalldir=$(INSTALL_UNITDIR) -ie -fsp 0
|
||||
else
|
||||
$(LOCALFPMAKE) install $(FPMAKE_OPT) --prefix=$(INSTALL_BASEDIR) --baseinstalldir=$(INSTALL_BASEDIR) --unitinstalldir=$(INSTALL_UNITDIR) -ie -fsp 0
|
||||
endif
|
||||
zipinstall: fpmake$(SRCEXEEXT)
|
||||
$(LOCALFPMAKE) zipinstall $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX)
|
||||
zipdistinstall: fpmake$(SRCEXEEXT)
|
||||
$(LOCALFPMAKE) zipinstall $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) -ie -fsp 0
|
||||
zipsourceinstall: fpmake$(SRCEXEEXT)
|
||||
ifdef UNIXHier
|
||||
$(LOCALFPMAKE) archive $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) --prefix=share/src/fpc-\$$\(PACKAGEVERSION\)/$(INSTALL_FPCSUBDIR)/\$$\(PACKAGEDIRECTORY\)
|
||||
else
|
||||
$(LOCALFPMAKE) archive $(FPMAKE_OPT) --zipprefix=$(DIST_DESTDIR)/$(ZIPPREFIX) --prefix=source\\$(INSTALL_FPCSUBDIR)\\\$$\(PACKAGEDIRECTORY\)
|
||||
endif
|
||||
68
packages/webidl/examples/parsewebidl.lpi
Normal file
68
packages/webidl/examples/parsewebidl.lpi
Normal file
@ -0,0 +1,68 @@
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="11"/>
|
||||
<General>
|
||||
<Flags>
|
||||
<MainUnitHasCreateFormStatements Value="False"/>
|
||||
<MainUnitHasScaledStatement Value="False"/>
|
||||
</Flags>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="Parse WEB IDL Application"/>
|
||||
<UseAppBundle Value="False"/>
|
||||
<ResourceType Value="res"/>
|
||||
</General>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<FormatVersion Value="2"/>
|
||||
<Modes Count="0"/>
|
||||
</RunParams>
|
||||
<Units Count="4">
|
||||
<Unit0>
|
||||
<Filename Value="parsewebidl.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="webidldefs.pp"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
<Filename Value="webidlparser.pp"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit2>
|
||||
<Unit3>
|
||||
<Filename Value="webidlscanner.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit3>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target>
|
||||
<Filename Value="parsewebidl"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
119
packages/webidl/examples/parsewebidl.pas
Normal file
119
packages/webidl/examples/parsewebidl.pas
Normal file
@ -0,0 +1,119 @@
|
||||
program parsewebidl;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
uses
|
||||
Classes, SysUtils, CustApp, webidlparser, webidlscanner,webidldefs;
|
||||
|
||||
ResourceString
|
||||
SErrNeedInputFiles = 'Need one or more input files';
|
||||
|
||||
type
|
||||
|
||||
{ TParseWebIDLApplication }
|
||||
|
||||
TParseWebIDLApplication = class(TCustomApplication)
|
||||
private
|
||||
FContext : TWebIDLContext;
|
||||
procedure ParseWebIDL(const AFileName: String);
|
||||
protected
|
||||
procedure DoRun; override;
|
||||
public
|
||||
constructor Create(TheOwner: TComponent); override;
|
||||
destructor Destroy; override;
|
||||
procedure WriteHelp(Const Msg : String); virtual;
|
||||
end;
|
||||
|
||||
|
||||
{ TParseWebIDLApplication }
|
||||
|
||||
procedure TParseWebIDLApplication.ParseWebIDL(Const AFileName : String);
|
||||
|
||||
Var
|
||||
F : TFileStream;
|
||||
P : TWebIDLParser;
|
||||
S : TWebIDLScanner;
|
||||
I : Integer;
|
||||
|
||||
begin
|
||||
FreeAndNil(FContext);
|
||||
FContext:=TWebIDLContext.Create;
|
||||
P:=Nil;
|
||||
S:=Nil;
|
||||
F:=TFileStream.Create(aFileName,fmOpenRead or fmShareDenyWrite);
|
||||
try
|
||||
S:=TWebIDLScanner.Create(F);
|
||||
P:=TWebIDLParser.Create(FContext,S);
|
||||
P.Parse;
|
||||
Writeln('// Contents of '+AFileName);
|
||||
For I:=0 to FConText.Definitions.Count-1 do
|
||||
begin
|
||||
Writeln('// Definition ',I+1:3,': ',FConText.Definitions[i].ClassName);
|
||||
Writeln(FConText.Definitions[i].AsString(True)+';');
|
||||
end;
|
||||
finally
|
||||
F.Free;
|
||||
P.Free;
|
||||
S.Free;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure TParseWebIDLApplication.DoRun;
|
||||
|
||||
var
|
||||
FN,ErrorMsg: UTF8String;
|
||||
NoF : TStringArray;
|
||||
|
||||
begin
|
||||
Terminate;
|
||||
ErrorMsg:=CheckOptions('hi:', ['help','input']);
|
||||
if (ErrorMsg<>'') or HasOption('h','help') then
|
||||
begin
|
||||
WriteHelp(ErrorMsg);
|
||||
Exit;
|
||||
end;
|
||||
FN:=GetOptionValue('i','input');
|
||||
if FN='' then
|
||||
NoF:=GetNonOptions('hi:', ['help','input'])
|
||||
else
|
||||
begin
|
||||
SetLength(NOF,1);
|
||||
NOF[0]:=FN;
|
||||
end;
|
||||
if Length(Nof)=0 then
|
||||
WriteHelp(SErrNeedInputFiles);
|
||||
For FN in NoF do
|
||||
ParseWebIDL(FN);
|
||||
end;
|
||||
|
||||
constructor TParseWebIDLApplication.Create(TheOwner: TComponent);
|
||||
begin
|
||||
inherited Create(TheOwner);
|
||||
StopOnException:=True;
|
||||
FContext:=TWebIDLContext.Create;
|
||||
end;
|
||||
|
||||
destructor TParseWebIDLApplication.Destroy;
|
||||
begin
|
||||
FreeAndNil(FContext);
|
||||
inherited Destroy;
|
||||
end;
|
||||
|
||||
procedure TParseWebIDLApplication.WriteHelp(Const Msg : String);
|
||||
begin
|
||||
if Msg<>'' then
|
||||
Writeln('Error : ',Msg);
|
||||
writeln('Usage: ', ExeName, ' -h');
|
||||
ExitCode:=Ord(Msg<>'');
|
||||
end;
|
||||
|
||||
var
|
||||
Application: TParseWebIDLApplication;
|
||||
begin
|
||||
Application:=TParseWebIDLApplication.Create(nil);
|
||||
Application.Title:='Parse WEB IDL Application';
|
||||
Application.Run;
|
||||
Application.Free;
|
||||
end.
|
||||
|
||||
53
packages/webidl/fpmake.pp
Normal file
53
packages/webidl/fpmake.pp
Normal file
@ -0,0 +1,53 @@
|
||||
{$ifndef ALLPACKAGES}
|
||||
{$mode objfpc}{$H+}
|
||||
program fpmake;
|
||||
|
||||
uses fpmkunit;
|
||||
|
||||
Var
|
||||
T : TTarget;
|
||||
P : TPackage;
|
||||
begin
|
||||
With Installer do
|
||||
begin
|
||||
{$endif ALLPACKAGES}
|
||||
|
||||
P:=AddPackage('webidl');
|
||||
P.ShortName:='webidl';
|
||||
{$ifdef ALLPACKAGES}
|
||||
P.Directory:=ADirectory;
|
||||
{$endif ALLPACKAGES}
|
||||
P.Version:='3.1.1';
|
||||
P.Dependencies.Add('fcl-base');
|
||||
P.Author := 'Michael Van Canneyt';
|
||||
P.License := 'LGPL with modification, ';
|
||||
P.HomepageURL := 'www.freepascal.org';
|
||||
P.Email := '';
|
||||
P.Description := 'WEB IDL parser and converter to Object Pascal classes';
|
||||
P.NeedLibC:= false;
|
||||
P.OSes:=AllOSes-[embedded,msdos,win16,macos,palmos];
|
||||
|
||||
P.SourcePath.Add('src');
|
||||
|
||||
T:=P.Targets.AddUnit('webidldefs.pp');
|
||||
T.ResourceStrings := True;
|
||||
T:=P.Targets.AddUnit('webidlscanner.pp');
|
||||
T.ResourceStrings := True;
|
||||
T:=P.Targets.AddUnit('webidlparser.pp');
|
||||
with T.Dependencies do
|
||||
begin
|
||||
AddUnit('webidldefs');
|
||||
AddUnit('webidlscanner');
|
||||
end;
|
||||
T:=P.Targets.AddUnit('webidltopas.pp');
|
||||
with T.Dependencies do
|
||||
begin
|
||||
AddUnit('webidldefs');
|
||||
AddUnit('webidlscanner');
|
||||
AddUnit('webidlparser');
|
||||
end;
|
||||
{$ifndef ALLPACKAGES}
|
||||
Run;
|
||||
end;
|
||||
end.
|
||||
{$endif ALLPACKAGES}
|
||||
1267
packages/webidl/src/webidldefs.pp
Normal file
1267
packages/webidl/src/webidldefs.pp
Normal file
File diff suppressed because it is too large
Load Diff
1431
packages/webidl/src/webidlparser.pp
Normal file
1431
packages/webidl/src/webidlparser.pp
Normal file
File diff suppressed because it is too large
Load Diff
700
packages/webidl/src/webidlscanner.pp
Normal file
700
packages/webidl/src/webidlscanner.pp
Normal file
@ -0,0 +1,700 @@
|
||||
{
|
||||
This file is part of the Free Component Library
|
||||
|
||||
WEBIDL source lexical scanner
|
||||
Copyright (c) 2018 by Michael Van Canneyt michael@freepascal.org
|
||||
|
||||
See the file COPYING.FPC, included in this distribution,
|
||||
for details about the copyright.
|
||||
|
||||
This program is distributed in the hope that it will be useful,
|
||||
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
||||
|
||||
**********************************************************************}
|
||||
{$mode objfpc}
|
||||
{$h+}
|
||||
|
||||
unit webidlscanner;
|
||||
|
||||
interface
|
||||
|
||||
uses SysUtils, Classes;
|
||||
|
||||
|
||||
type
|
||||
TWebIDLVersion = (v1,v2);
|
||||
|
||||
TIDLToken = (
|
||||
tkEOF,
|
||||
tkUnknown ,
|
||||
tkComment,
|
||||
tkWhitespace,
|
||||
tkString,
|
||||
tkNumberInteger,
|
||||
tkNumberFloat,
|
||||
// Simple (one-character) tokens
|
||||
tkDot, // '.',
|
||||
tkSemiColon, // ';'
|
||||
tkComma, // ','
|
||||
tkColon, // ':'
|
||||
tkBracketOpen, // '('
|
||||
tkBracketClose, // ')'
|
||||
tkCurlyBraceOpen, // '{'
|
||||
tkCurlyBraceClose, // '}'
|
||||
tkSquaredBraceOpen, // '['
|
||||
tkSquaredBraceClose, // ']'
|
||||
tkLess, // '<'
|
||||
tkEqual, // '='
|
||||
tkLarger, // '>'
|
||||
tkQuestionmark, // '?'
|
||||
tkminus, // '-'
|
||||
tkIdentifier, // Any identifier
|
||||
tkTrue,
|
||||
tkFalse,
|
||||
tkNull,
|
||||
tkAny,
|
||||
tkAttribute,
|
||||
tkCallback,
|
||||
tkConst,
|
||||
tkDeleter,
|
||||
tkDictionary,
|
||||
tkEllipsis,
|
||||
tkEnum,
|
||||
tkGetter,
|
||||
tkImplements,
|
||||
tkInfinity,
|
||||
tkInherit,
|
||||
tkInterface,
|
||||
tkIterable,
|
||||
tkLegacyCaller,
|
||||
tkNan,
|
||||
tkNegInfinity,
|
||||
tkOptional,
|
||||
tkOr,
|
||||
tkPartial,
|
||||
tkReadOnly,
|
||||
tkRequired,
|
||||
tkSetter,
|
||||
tkStatic,
|
||||
tkStringifier,
|
||||
tkSerializer,
|
||||
tkTypedef,
|
||||
tkUnrestricted,
|
||||
tkPromise,
|
||||
tkByteString,
|
||||
tkDOMString,
|
||||
tkUSVString,
|
||||
tkboolean,
|
||||
tkbyte,
|
||||
tkdouble,
|
||||
tkfloat,
|
||||
tklong,
|
||||
tkobject,
|
||||
tkoctet,
|
||||
tkunsigned,
|
||||
tkvoid,
|
||||
tkShort,
|
||||
tkSequence,
|
||||
tkStringToken,
|
||||
tkMixin,
|
||||
tkIncludes,
|
||||
tkMapLike,
|
||||
tkRecord,
|
||||
tkSetLike,
|
||||
tkOther
|
||||
);
|
||||
TIDLTokens = Set of TIDLToken;
|
||||
EWebIDLScanner = class(EParserError);
|
||||
|
||||
Const
|
||||
V2Tokens = [tkMixin,tkIncludes,tkMapLike,tkRecord,tkSetLike];
|
||||
V1Tokens = [tkImplements];
|
||||
VersionNonTokens : Array[TWebIDLVersion] of TIDLTokens = (V2Tokens,V1Tokens);
|
||||
|
||||
Type
|
||||
|
||||
{ TWebIDLScanner }
|
||||
|
||||
TWebIDLScanner = class
|
||||
private
|
||||
FSource : TStringList;
|
||||
FCurRow: Integer;
|
||||
FCurToken: TIDLToken;
|
||||
FCurTokenString: UTF8string;
|
||||
FCurLine: UTF8string;
|
||||
FVersion: TWebIDLVersion;
|
||||
TokenStr: PChar;
|
||||
function DetermineToken: TIDLToken;
|
||||
function DetermineToken2: TIDLToken;
|
||||
function FetchLine: Boolean;
|
||||
function GetCurColumn: Integer;
|
||||
function ReadComment: UTF8String;
|
||||
function ReadIdent: UTF8String;
|
||||
function ReadNumber(var S: UTF8String): TIDLToken;
|
||||
protected
|
||||
Function GetErrorPos : String;
|
||||
procedure Error(const Msg: string);overload;
|
||||
procedure Error(const Msg: string; Const Args: array of Const);overload;
|
||||
function ReadString: UTF8String; virtual;
|
||||
function DoFetchToken: TIDLToken;
|
||||
public
|
||||
constructor Create(Source: TStream); overload;
|
||||
constructor Create(const Source: UTF8String); overload;
|
||||
constructor CreateFile(const aFileName: UTF8String);
|
||||
destructor Destroy; override;
|
||||
function FetchToken: TIDLToken;
|
||||
|
||||
property CurLine: UTF8String read FCurLine;
|
||||
property CurRow: Integer read FCurRow;
|
||||
property CurColumn: Integer read GetCurColumn;
|
||||
|
||||
property CurToken: TIDLToken read FCurToken;
|
||||
property CurTokenString: UTF8String read FCurTokenString;
|
||||
Property Version : TWebIDLVersion Read FVersion Write FVersion;
|
||||
end;
|
||||
|
||||
const
|
||||
TokenInfos: array[TIDLToken] of string = (
|
||||
'',
|
||||
'',
|
||||
'',
|
||||
'',
|
||||
'',
|
||||
'',
|
||||
'',
|
||||
// Simple (one-character) tokens
|
||||
'.',
|
||||
';',
|
||||
',', // ','
|
||||
':', // ':'
|
||||
'(', // '('
|
||||
')', // ')'
|
||||
'{', // '{'
|
||||
'}', // '}'
|
||||
'[', // '['
|
||||
']', // ']'
|
||||
'<',
|
||||
'=',
|
||||
'>',
|
||||
'?',
|
||||
'-',
|
||||
'', // Any identifier
|
||||
'true',
|
||||
'false',
|
||||
'null',
|
||||
'any',
|
||||
'attribute',
|
||||
'callback',
|
||||
'const',
|
||||
'deleter',
|
||||
'dictionary',
|
||||
'ellipsis',
|
||||
'enum',
|
||||
'getter',
|
||||
'implements',
|
||||
'Infinity',
|
||||
'inherit',
|
||||
'interface',
|
||||
'iterable',
|
||||
'legacycaller',
|
||||
'NaN',
|
||||
'-Infinity',
|
||||
'optional',
|
||||
'or',
|
||||
'partial',
|
||||
'readonly',
|
||||
'required',
|
||||
'setter',
|
||||
'static',
|
||||
'stringifier',
|
||||
'serializer',
|
||||
'typedef',
|
||||
'unrestricted',
|
||||
'Promise',
|
||||
'ByteString',
|
||||
'DOMString',
|
||||
'USVString',
|
||||
'boolean',
|
||||
'byte',
|
||||
'double',
|
||||
'float',
|
||||
'long',
|
||||
'object',
|
||||
'octet',
|
||||
'unsigned',
|
||||
'void',
|
||||
'short',
|
||||
'sequence',
|
||||
'string',
|
||||
'mixin',
|
||||
'includes',
|
||||
'maplike',
|
||||
'record',
|
||||
'setlike',
|
||||
'other'
|
||||
);
|
||||
|
||||
Function GetTokenName(aToken : TIDLToken) : String;
|
||||
Function GetTokenNames(aTokenList : TIDLTokens) : String;
|
||||
|
||||
implementation
|
||||
|
||||
uses typinfo;
|
||||
|
||||
Resourcestring
|
||||
SErrUnknownTerminator = 'Unknown terminator: "%s"';
|
||||
SErrInvalidCharacter = 'Invalid character at line %d, pos %d: ''%s''';
|
||||
SUnterminatedComment = 'Unterminated comment at line %d, pos %d: ''%s''';
|
||||
SErrOpenString = 'string exceeds end of line';
|
||||
SErrInvalidEllipsis = 'Invalid ellipsis token';
|
||||
SErrUnknownToken = 'Unknown token, expected number or minus : "%s"';
|
||||
// SerrExpectedTokenButWasIdentifier = 'Invalid terminator: "%s"';
|
||||
|
||||
Function GetTokenName(aToken : TIDLToken) : String;
|
||||
|
||||
begin
|
||||
Result:=TokenInfos[aToken];
|
||||
if Result='' then
|
||||
begin
|
||||
Result:=GetEnumName(TypeInfo(TIDLToken),Ord(aToken));
|
||||
Delete(Result,1,2);
|
||||
end;
|
||||
end;
|
||||
|
||||
Function GetTokenNames(aTokenList : TIDLTokens) : String;
|
||||
|
||||
Var
|
||||
T : TIDLToken;
|
||||
|
||||
begin
|
||||
Result:='';
|
||||
For T in aTokenList do
|
||||
begin
|
||||
if (Result<>'') then
|
||||
Result:=Result+',';
|
||||
Result:=Result+GetTokenName(T);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
constructor TWebIDLScanner.Create(Source: TStream);
|
||||
begin
|
||||
FSource:=TStringList.Create;
|
||||
FSource.LoadFromStream(Source);
|
||||
end;
|
||||
|
||||
constructor TWebIDLScanner.Create(const Source: UTF8String);
|
||||
begin
|
||||
FSource:=TStringList.Create;
|
||||
FSource.Text:=Source;
|
||||
end;
|
||||
|
||||
constructor TWebIDLScanner.CreateFile(const aFileName: UTF8String);
|
||||
begin
|
||||
FSource:=TStringList.Create;
|
||||
FSource.LoadFromFile(aFileName);
|
||||
end;
|
||||
|
||||
destructor TWebIDLScanner.Destroy;
|
||||
begin
|
||||
FreeAndNil(FSource);
|
||||
Inherited;
|
||||
end;
|
||||
|
||||
|
||||
function TWebIDLScanner.FetchToken: TIDLToken;
|
||||
|
||||
begin
|
||||
Result:=DoFetchToken;
|
||||
end;
|
||||
|
||||
procedure TWebIDLScanner.Error(const Msg: string);
|
||||
begin
|
||||
raise EWebIDLScanner.Create(GetErrorPos+Msg);
|
||||
end;
|
||||
|
||||
procedure TWebIDLScanner.Error(const Msg: string; const Args: array of const);
|
||||
begin
|
||||
raise EWebIDLScanner.Create(GetErrorPos+Format(Msg, Args));
|
||||
end;
|
||||
|
||||
function TWebIDLScanner.ReadString : UTF8String;
|
||||
|
||||
Var
|
||||
C : Char;
|
||||
I, OldLength, SectionLength: Integer;
|
||||
S : UTF8String;
|
||||
TokenStart: PChar;
|
||||
begin
|
||||
C:=TokenStr[0];
|
||||
Inc(TokenStr);
|
||||
TokenStart := TokenStr;
|
||||
OldLength := 0;
|
||||
Result := '';
|
||||
while not (TokenStr[0] in [#0,C]) do
|
||||
begin
|
||||
if (TokenStr[0]='\') then
|
||||
begin
|
||||
// Save length
|
||||
SectionLength := TokenStr - TokenStart;
|
||||
Inc(TokenStr);
|
||||
// Read escaped token
|
||||
Case TokenStr[0] of
|
||||
'"' : S:='"';
|
||||
'''' : S:='''';
|
||||
't' : S:=#9;
|
||||
'b' : S:=#8;
|
||||
'n' : S:=#10;
|
||||
'r' : S:=#13;
|
||||
'f' : S:=#12;
|
||||
'\' : S:='\';
|
||||
'/' : S:='/';
|
||||
'u' : begin
|
||||
S:='0000';
|
||||
For I:=1 to 4 do
|
||||
begin
|
||||
Inc(TokenStr);
|
||||
Case TokenStr[0] of
|
||||
'0'..'9','A'..'F','a'..'f' :
|
||||
S[i]:=Upcase(TokenStr[0]);
|
||||
else
|
||||
Error(SErrInvalidCharacter, [CurRow,CurColumn,TokenStr[0]]);
|
||||
end;
|
||||
end;
|
||||
// WideChar takes care of conversion...
|
||||
S:=Utf8Encode(WideString(WideChar(StrToInt('$'+S))))
|
||||
end;
|
||||
#0 : Error(SErrOpenString);
|
||||
else
|
||||
Error(SErrInvalidCharacter, [CurRow,CurColumn,TokenStr[0]]);
|
||||
end;
|
||||
SetLength(Result, OldLength + SectionLength+1+Length(S));
|
||||
if SectionLength > 0 then
|
||||
Move(TokenStart^, Result[OldLength + 1], SectionLength);
|
||||
Move(S[1],Result[OldLength + SectionLength+1],Length(S));
|
||||
Inc(OldLength, SectionLength+Length(S));
|
||||
// Next char
|
||||
// Inc(TokenStr);
|
||||
TokenStart := TokenStr+1;
|
||||
end;
|
||||
if TokenStr[0] = #0 then
|
||||
Error(SErrOpenString);
|
||||
Inc(TokenStr);
|
||||
end;
|
||||
if TokenStr[0] = #0 then
|
||||
Error(SErrOpenString);
|
||||
SectionLength := TokenStr - TokenStart;
|
||||
SetLength(Result, OldLength + SectionLength);
|
||||
if SectionLength > 0 then
|
||||
Move(TokenStart^, Result[OldLength + 1], SectionLength);
|
||||
Inc(TokenStr);
|
||||
end;
|
||||
|
||||
function TWebIDLScanner.ReadIdent: UTF8String;
|
||||
|
||||
Var
|
||||
TokenStart : PChar;
|
||||
SectionLength : Integer;
|
||||
|
||||
begin
|
||||
Result:='';
|
||||
if TokenStr[0]='_' then
|
||||
Inc(TokenStr);
|
||||
if TokenStr[0]=#0 then
|
||||
Exit;
|
||||
TokenStart := TokenStr;
|
||||
repeat
|
||||
Inc(TokenStr);
|
||||
until not (TokenStr[0] in ['A'..'Z', 'a'..'z', '0'..'9', '_']);
|
||||
SectionLength := TokenStr - TokenStart;
|
||||
SetString(Result, TokenStart, SectionLength);
|
||||
end;
|
||||
|
||||
function TWebIDLScanner.FetchLine: Boolean;
|
||||
|
||||
begin
|
||||
Result:=FCurRow<FSource.Count;
|
||||
if Result then
|
||||
begin
|
||||
FCurLine:=FSource[FCurRow];
|
||||
TokenStr:=PChar(FCurLine);
|
||||
Inc(FCurRow);
|
||||
end
|
||||
else
|
||||
begin
|
||||
FCurLine:='';
|
||||
TokenStr:=nil;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TWebIDLScanner.ReadNumber(var S : UTF8String) : TIDLToken;
|
||||
|
||||
Var
|
||||
TokenStart : PChar;
|
||||
SectionLength : Integer;
|
||||
isHex : Boolean;
|
||||
|
||||
begin
|
||||
isHex:=False;
|
||||
TokenStart := TokenStr;
|
||||
Result:=tkNumberInteger;
|
||||
while true do
|
||||
begin
|
||||
Inc(TokenStr);
|
||||
SectionLength := TokenStr - TokenStart;
|
||||
case TokenStr[0] of
|
||||
'x':
|
||||
begin
|
||||
isHex:=True;
|
||||
end;
|
||||
'I':
|
||||
begin
|
||||
repeat
|
||||
Inc(TokenStr);
|
||||
until not (TokenStr[0] in ['i','n','f','t','y']);
|
||||
Result:=tkNegInfinity; // We'll check at the end if the string is actually correct
|
||||
break;
|
||||
end;
|
||||
'.':
|
||||
begin
|
||||
Result:=tkNumberFloat;
|
||||
if TokenStr[1] in ['0'..'9', 'e', 'E'] then
|
||||
begin
|
||||
Inc(TokenStr);
|
||||
repeat
|
||||
Inc(TokenStr);
|
||||
until not (TokenStr[0] in ['0'..'9', 'e', 'E','-','+']);
|
||||
end;
|
||||
break;
|
||||
end;
|
||||
'0'..'9':
|
||||
begin
|
||||
end;
|
||||
'a'..'d','f',
|
||||
'A'..'D','F':
|
||||
begin
|
||||
if Not isHex then
|
||||
Error(SErrUnknownToken,[S]);
|
||||
end;
|
||||
'e', 'E':
|
||||
begin
|
||||
if not IsHex then
|
||||
begin
|
||||
Inc(TokenStr);
|
||||
if TokenStr[0] in ['-','+'] then
|
||||
Inc(TokenStr);
|
||||
while TokenStr[0] in ['0'..'9'] do
|
||||
Inc(TokenStr);
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
else
|
||||
if (SectionLength=1) and (TokenStart[0]='-') then
|
||||
result:=tkMinus;
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
SectionLength := TokenStr - TokenStart;
|
||||
S:='';
|
||||
SetString(S, TokenStart, SectionLength);
|
||||
if (Result=tkNegInfinity) and (S<>'-Infinity') then
|
||||
Error(SErrUnknownToken,[S]);
|
||||
if (Result=tkMinus) and (S<>'-') then
|
||||
Error(SErrUnknownTerminator,[s]);
|
||||
end;
|
||||
|
||||
function TWebIDLScanner.GetErrorPos: String;
|
||||
begin
|
||||
Result:=Format('Scanner error at line %d, pos %d: ',[CurRow,CurColumn]);
|
||||
end;
|
||||
|
||||
function TWebIDLScanner.ReadComment : UTF8String;
|
||||
|
||||
Var
|
||||
TokenStart : PChar;
|
||||
SectionLength : Integer;
|
||||
EOC,IsStar : Boolean;
|
||||
S : String;
|
||||
|
||||
begin
|
||||
Result:='';
|
||||
TokenStart:=TokenStr;
|
||||
Inc(TokenStr);
|
||||
Case Tokenstr[0] of
|
||||
'/' : begin
|
||||
SectionLength := Length(FCurLine)- (TokenStr - PChar(FCurLine));
|
||||
Inc(TokenStr);
|
||||
SetString(Result, TokenStr, SectionLength);
|
||||
Fetchline;
|
||||
end;
|
||||
'*' :
|
||||
begin
|
||||
IsStar:=False;
|
||||
Inc(TokenStr);
|
||||
TokenStart:=TokenStr;
|
||||
Repeat
|
||||
if (TokenStr[0]=#0) then
|
||||
begin
|
||||
SectionLength := (TokenStr - TokenStart);
|
||||
S:='';
|
||||
SetString(S, TokenStart, SectionLength);
|
||||
Result:=Result+S;
|
||||
if not fetchLine then
|
||||
Error(SUnterminatedComment, [CurRow,CurCOlumn,TokenStr[0]]);
|
||||
TokenStart:=TokenStr;
|
||||
end;
|
||||
IsStar:=TokenStr[0]='*';
|
||||
Inc(TokenStr);
|
||||
EOC:=(isStar and (TokenStr[0]='/'));
|
||||
Until EOC;
|
||||
if EOC then
|
||||
begin
|
||||
SectionLength := (TokenStr - TokenStart-1);
|
||||
S:='';
|
||||
SetString(S, TokenStart, SectionLength);
|
||||
Result:=Result+S;
|
||||
Inc(TokenStr);
|
||||
end;
|
||||
end;
|
||||
else
|
||||
Error(SErrInvalidCharacter, [CurRow,CurCOlumn,TokenStr[0]]);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TWebIDLScanner.DetermineToken : TIDLToken;
|
||||
|
||||
begin
|
||||
Result:=High(TIDLToken);
|
||||
While (Result<>tkIdentifier) and (TokenInfos[result]<>FCurTokenString) do
|
||||
Result:=Pred(Result);
|
||||
if Result in VersionNonTokens[Version] then
|
||||
Result:=tkIdentifier;
|
||||
// if Result=tkIdentifier then
|
||||
// Error(SErrExpectedTokenButWasIdentifier,[FCurTokenString]);
|
||||
end;
|
||||
|
||||
function TWebIDLScanner.DetermineToken2 : TIDLToken;
|
||||
|
||||
Const
|
||||
InfTokens = [tkNan,tkInfinity,tkNegInfinity,tkByteString,tkUSVString,tkDOMString,tkPromise];
|
||||
|
||||
begin
|
||||
For Result in InfTokens do
|
||||
if (TokenInfos[result]=FCurTokenString) then exit;
|
||||
Result:=tkIdentifier;
|
||||
end;
|
||||
|
||||
function TWebIDLScanner.DoFetchToken: TIDLToken;
|
||||
|
||||
Procedure SetSingleToken(tk : TIDLToken);
|
||||
|
||||
begin
|
||||
FCurTokenString:=TokenStr[0];
|
||||
Inc(TokenStr);
|
||||
Result :=tk;
|
||||
end;
|
||||
|
||||
begin
|
||||
if TokenStr = nil then
|
||||
if not FetchLine then
|
||||
begin
|
||||
Result := tkEOF;
|
||||
FCurToken := Result;
|
||||
exit;
|
||||
end;
|
||||
FCurTokenString := '';
|
||||
case TokenStr[0] of
|
||||
#0: // Empty line
|
||||
begin
|
||||
if not FetchLine then
|
||||
Result:=tkEOF
|
||||
else
|
||||
Result := tkWhitespace;
|
||||
end;
|
||||
#9, ' ':
|
||||
begin
|
||||
Result := tkWhitespace;
|
||||
repeat
|
||||
Inc(TokenStr);
|
||||
if TokenStr[0] = #0 then
|
||||
if not FetchLine then
|
||||
begin
|
||||
FCurToken := Result;
|
||||
exit;
|
||||
end;
|
||||
until not (TokenStr[0] in [#9, ' ']);
|
||||
end;
|
||||
'"':
|
||||
begin
|
||||
FCurTokenString:=ReadString;
|
||||
Result := tkString;
|
||||
end;
|
||||
',':
|
||||
begin
|
||||
Inc(TokenStr);
|
||||
Result := tkComma;
|
||||
end;
|
||||
'0'..'9','-':
|
||||
begin
|
||||
Result := ReadNumber(FCurTokenString);
|
||||
end;
|
||||
':': SetSingleToken(tkColon);
|
||||
'(': SetSingleToken(tkBracketOpen);
|
||||
')': SetSingleToken(tkBracketClose);
|
||||
'{': SetSingleToken(tkCurlyBraceOpen);
|
||||
'}': SetSingleToken(tkCurlyBraceClose);
|
||||
'[': SetSingleToken(tkSquaredBraceOpen);
|
||||
']': SetSingleToken(tkSquaredBraceClose);
|
||||
'<': SetSingleToken(tkLess);
|
||||
'=': SetSingleToken(tkEqual);
|
||||
'>': SetSingleToken(tkLarger);
|
||||
'?' : SetSingleToken(tkQuestionmark);
|
||||
';' : SetSingleToken(tkSemicolon);
|
||||
'.' :
|
||||
begin
|
||||
inc(TokenStr);
|
||||
if TokenStr[0]<>'.' then
|
||||
begin
|
||||
Dec(Tokenstr);// Setsingletoken advances
|
||||
SetSingleToken(tkDot);
|
||||
end
|
||||
else
|
||||
begin
|
||||
inc(TokenStr);
|
||||
if TokenStr[0]<>'.' then
|
||||
Error(SErrInvalidEllipsis);
|
||||
FCurTokenString:='...';
|
||||
Result:=tkEllipsis;
|
||||
end;
|
||||
end;
|
||||
'/' :
|
||||
begin
|
||||
FCurTokenString:=ReadComment;
|
||||
Result:=tkComment;
|
||||
end;
|
||||
'a'..'z':
|
||||
begin
|
||||
FCurTokenString:=ReadIdent;
|
||||
Result:=DetermineToken;
|
||||
end;
|
||||
'A'..'Z','_':
|
||||
begin
|
||||
FCurTokenString:=ReadIdent;
|
||||
Result:=tkIdentifier;
|
||||
Result:=DetermineToken2;
|
||||
end;
|
||||
else
|
||||
Error(SErrInvalidCharacter, [CurRow,CurCOlumn,TokenStr[0]]);
|
||||
end;
|
||||
|
||||
FCurToken := Result;
|
||||
end;
|
||||
|
||||
function TWebIDLScanner.GetCurColumn: Integer;
|
||||
begin
|
||||
Result := TokenStr - PChar(CurLine);
|
||||
end;
|
||||
|
||||
|
||||
end.
|
||||
1326
packages/webidl/src/webidltopas.pp
Normal file
1326
packages/webidl/src/webidltopas.pp
Normal file
File diff suppressed because it is too large
Load Diff
1594
packages/webidl/tests/tcidlparser.pp
Normal file
1594
packages/webidl/tests/tcidlparser.pp
Normal file
File diff suppressed because it is too large
Load Diff
577
packages/webidl/tests/tcidlscanner.pp
Normal file
577
packages/webidl/tests/tcidlscanner.pp
Normal file
@ -0,0 +1,577 @@
|
||||
unit tcidlscanner;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, fpcunit, testutils, testregistry, webidlscanner;
|
||||
|
||||
type
|
||||
|
||||
{ TTestScanner }
|
||||
|
||||
TTestScanner= class(TTestCase)
|
||||
private
|
||||
FScanner: TWebIDLScanner;
|
||||
FVersion: TWEbIDLversion;
|
||||
procedure SetVersion(AValue: TWEbIDLversion);
|
||||
protected
|
||||
procedure Init(Const aSource : string);
|
||||
Class Procedure AssertEquals(Msg : String; AExpected,AActual : TIDLToken); overload;
|
||||
Procedure TestSingle(Const aSource : String; AToken : TIDLToken);
|
||||
Procedure TestMulti(Const aSource : String; AToken : Array of TIDLToken);
|
||||
Procedure TestSingle(Const aSource : String; AToken : TIDLToken; AValue : String);
|
||||
Procedure TestMulti(Const aSource : String; AToken : Array of TIDLToken; AValues : Array of String);
|
||||
procedure SetUp; override;
|
||||
procedure TearDown; override;
|
||||
Property Scanner : TWebIDLScanner Read FScanner;
|
||||
Property Version : TWEbIDLversion Read FVersion Write SetVersion;
|
||||
published
|
||||
procedure TestHookUp;
|
||||
Procedure TestComment;
|
||||
Procedure TestWhitespace;
|
||||
Procedure TestString;
|
||||
Procedure TestNumberInteger;
|
||||
Procedure TestNumberFloat;
|
||||
Procedure TestNumberHex;
|
||||
Procedure TestNumberHex2;
|
||||
// Simple (one-character) tokens
|
||||
Procedure TestComma; // ','
|
||||
Procedure TestColon; // ':'
|
||||
Procedure TestBracketOpen; // '('
|
||||
Procedure TestBracketClose; // ')'
|
||||
Procedure TestCurlyBraceOpen; // '{'
|
||||
Procedure TestCurlyBraceClose; // '}'
|
||||
Procedure TestSquaredBraceOpen; // '['
|
||||
Procedure TestSquaredBraceClose; // ']'
|
||||
Procedure TestIdentifier; // Any identifier
|
||||
Procedure TestDot; // '.',
|
||||
Procedure TestSemicolon;// ';',
|
||||
Procedure TestLess;// '<',
|
||||
Procedure TestEqual;// '=',
|
||||
Procedure TestLarger;// '=',
|
||||
Procedure TestQuestionMark;// '?',
|
||||
Procedure TestMinus;// '-',
|
||||
Procedure TestOther;// 'other',
|
||||
Procedure Testshort;// 'other',
|
||||
|
||||
Procedure TestTrue;
|
||||
Procedure TestFalse;
|
||||
Procedure TestNull;
|
||||
Procedure TestAny;
|
||||
Procedure TestAttribute;
|
||||
Procedure TestCallback;
|
||||
Procedure TestConst;
|
||||
Procedure TestDeleter;
|
||||
Procedure TestDictionary;
|
||||
Procedure TestEllipsis;
|
||||
Procedure TestEnum;
|
||||
Procedure TestGetter;
|
||||
Procedure TestImplements;
|
||||
Procedure TestMapLike;
|
||||
Procedure TestSetLike;
|
||||
Procedure TestRecord;
|
||||
Procedure TestInfinity;
|
||||
Procedure TestInherit;
|
||||
Procedure TestInterface;
|
||||
Procedure TestIterable;
|
||||
Procedure TestLegacyCaller;
|
||||
Procedure TestNan;
|
||||
Procedure TestNegInfinity;
|
||||
Procedure TestOptional;
|
||||
Procedure TestOr;
|
||||
Procedure TestPartial;
|
||||
Procedure TestReadOnly;
|
||||
Procedure TestRequired;
|
||||
Procedure TestSetter;
|
||||
Procedure TestStatic;
|
||||
Procedure TestStringifier;
|
||||
Procedure TestTypedef;
|
||||
Procedure TestUnrestricted;
|
||||
Procedure TestPromise;
|
||||
Procedure TestByteString;
|
||||
Procedure TestDOMString;
|
||||
Procedure TestUSVString;
|
||||
Procedure Testboolean;
|
||||
Procedure Testbyte;
|
||||
Procedure Testdouble;
|
||||
Procedure Testfloat;
|
||||
Procedure Testlong;
|
||||
Procedure Testobject;
|
||||
Procedure Testoctet;
|
||||
Procedure Testunsigned;
|
||||
Procedure Testvoid;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses typinfo;
|
||||
|
||||
procedure TTestScanner.TestHookUp;
|
||||
begin
|
||||
Init('');
|
||||
AssertNotNull('Have scanner',Scanner);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestComment;
|
||||
begin
|
||||
TestSingle('// me',tkComment);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestWhitespace;
|
||||
begin
|
||||
TestSingle('',tkWhitespace);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestString;
|
||||
begin
|
||||
TestSingle('"abcd"',webidlscanner.tkString,'abcd');
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestNumberInteger;
|
||||
begin
|
||||
TestSingle('123',tkNumberInteger,'123');
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestNumberFloat;
|
||||
begin
|
||||
TestSingle('1.23',tkNumberFloat,'1.23');
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestNumberHex;
|
||||
begin
|
||||
TestSingle('0xABCDEF',tkNumberInteger,'0xABCDEF');
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestNumberHex2;
|
||||
begin
|
||||
// E is special
|
||||
TestSingle('0xABCDE',tkNumberInteger,'0xABCDE');
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestComma;
|
||||
begin
|
||||
TestSingle(',',tkComma);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestColon;
|
||||
begin
|
||||
TestSingle(':',tkColon);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestBracketOpen;
|
||||
begin
|
||||
TestSingle('(',tkBracketOpen);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestBracketClose;
|
||||
begin
|
||||
TestSingle(')',tkBracketClose);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestCurlyBraceOpen;
|
||||
begin
|
||||
TestSingle('{',tkCurlyBraceOpen);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestCurlyBraceClose;
|
||||
begin
|
||||
TestSingle('}',tkCurlyBraceClose);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestSquaredBraceOpen;
|
||||
begin
|
||||
TestSingle('[',tkSquaredBraceOpen);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestSquaredBraceClose;
|
||||
begin
|
||||
TestSingle(']',tkSquaredBraceClose);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestIdentifier;
|
||||
begin
|
||||
TestSingle('A',tkIdentifier,'A');
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestDot;
|
||||
begin
|
||||
TestSingle('.',tkDot);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestSemicolon;
|
||||
begin
|
||||
TestSingle(';',tkSemiColon);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestLess;
|
||||
begin
|
||||
TestSingle('<',tkLess);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestEqual;
|
||||
begin
|
||||
TestSingle('=',tkEqual);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestLarger;
|
||||
begin
|
||||
TestSingle('>',tkLarger);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestQuestionMark;
|
||||
begin
|
||||
TestSingle('?',tkQuestionMark);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestMinus;
|
||||
begin
|
||||
TestSingle('-',tkMinus);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestOther;
|
||||
begin
|
||||
TestSingle('other',tkOther);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.Testshort;
|
||||
begin
|
||||
TestSingle('short',tkShort);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestTrue;
|
||||
begin
|
||||
TestSingle('true',tkTrue);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestFalse;
|
||||
begin
|
||||
TestSingle('false',tkFalse);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestNull;
|
||||
begin
|
||||
TestSingle('null',tkNull);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestAny;
|
||||
begin
|
||||
TestSingle('any',webidlscanner.tkAny);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestAttribute;
|
||||
begin
|
||||
TestSingle('attribute',tkAttribute);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestCallback;
|
||||
begin
|
||||
TestSingle('callback',tkCallBack);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestConst;
|
||||
begin
|
||||
TestSingle('const',tkConst);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestDeleter;
|
||||
begin
|
||||
TestSingle('deleter',tkDeleter);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestDictionary;
|
||||
begin
|
||||
TestSingle('dictionary',tkDictionary);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestEllipsis;
|
||||
begin
|
||||
TestSingle('ellipsis',tkellipsis);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestEnum;
|
||||
begin
|
||||
TestSingle('enum',tkenum);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestGetter;
|
||||
begin
|
||||
TestSingle('getter',tkgetter);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestImplements;
|
||||
begin
|
||||
TestSingle('implements',tkimplements);
|
||||
Version:=v2;
|
||||
TestSingle('implements',tkIdentifier);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestMapLike;
|
||||
begin
|
||||
Version:=v2;
|
||||
TestSingle('maplike',tkmaplike);
|
||||
Version:=v1;
|
||||
TestSingle('maplike',tkIdentifier);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestSetLike;
|
||||
begin
|
||||
Version:=v2;
|
||||
TestSingle('setlike',tkSetlike);
|
||||
Version:=v1;
|
||||
TestSingle('setlike',tkIdentifier);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestRecord;
|
||||
begin
|
||||
Version:=v2;
|
||||
TestSingle('record',webidlscanner.tkRecord);
|
||||
Version:=v1;
|
||||
TestSingle('record',tkIdentifier);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestInfinity;
|
||||
begin
|
||||
TestSingle('Infinity',tkinfinity);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestInherit;
|
||||
begin
|
||||
TestSingle('inherit',tkinherit);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestInterface;
|
||||
begin
|
||||
TestSingle('interface',webidlscanner.tkinterface);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestIterable;
|
||||
begin
|
||||
TestSingle('iterable',tkiterable);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestLegacyCaller;
|
||||
begin
|
||||
TestSingle('legacycaller',tklegacycaller);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestNan;
|
||||
begin
|
||||
TestSingle('NaN',tkNan);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestNegInfinity;
|
||||
begin
|
||||
TestSingle('-Infinity',tkneginfinity);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestOptional;
|
||||
begin
|
||||
TestSingle('optional',tkoptional);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestOr;
|
||||
begin
|
||||
TestSingle('or',tkOR);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestPartial;
|
||||
begin
|
||||
TestSingle('partial',tkPartial);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestReadOnly;
|
||||
begin
|
||||
TestSingle('readonly',tkreadonly);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestRequired;
|
||||
begin
|
||||
TestSingle('required',tkrequired);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestSetter;
|
||||
begin
|
||||
TestSingle('setter',tksetter);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestStatic;
|
||||
begin
|
||||
TestSingle('static',tkstatic);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestStringifier;
|
||||
begin
|
||||
TestSingle('stringifier',tkstringifier);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestTypedef;
|
||||
begin
|
||||
TestSingle('typedef',tktypeDef);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestUnrestricted;
|
||||
begin
|
||||
TestSingle('unrestricted',tkunrestricted);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestPromise;
|
||||
begin
|
||||
TestSingle('Promise',tkpromise);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestByteString;
|
||||
begin
|
||||
TestSingle('ByteString',tkBytestring);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestDOMString;
|
||||
begin
|
||||
TestSingle('DOMString',tkDOMstring);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestUSVString;
|
||||
begin
|
||||
TestSingle('USVString',tkUSVString);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.Testboolean;
|
||||
begin
|
||||
TestSingle('boolean',tkBoolean);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.Testbyte;
|
||||
begin
|
||||
TestSingle('byte',tkByte);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.Testdouble;
|
||||
begin
|
||||
TestSingle('double',webidlscanner.tkDouble);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.Testfloat;
|
||||
begin
|
||||
TestSingle('float',webidlscanner.tkfloat);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.Testlong;
|
||||
begin
|
||||
TestSingle('long',tklong);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.Testobject;
|
||||
begin
|
||||
TestSingle('object',webidlscanner.tkObject);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.Testoctet;
|
||||
begin
|
||||
TestSingle('octet',tkOctet);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.Testunsigned;
|
||||
begin
|
||||
TestSingle('unsigned',tkUnsigned);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.Testvoid;
|
||||
begin
|
||||
TestSingle('void',tkVoid);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.SetVersion(AValue: TWEbIDLversion);
|
||||
begin
|
||||
if FVersion=AValue then Exit;
|
||||
FVersion:=AValue;
|
||||
if Assigned(FScanner) then
|
||||
FScanner.Version:=FVersion;
|
||||
end;
|
||||
|
||||
procedure TTestScanner.Init(const aSource: string);
|
||||
begin
|
||||
FreeAndNil(FScanner);
|
||||
FScanner:=TWebIDLScanner.Create(aSource);
|
||||
FScanner.Version:=FVersion;
|
||||
end;
|
||||
|
||||
class procedure TTestScanner.AssertEquals(Msg: String; AExpected,AActual: TIDLToken);
|
||||
begin
|
||||
AssertEQuals(Msg,GetEnumName(TypeInfo(TIDLToken),Ord(AExpected)),GetEnumName(TypeInfo(TIDLToken),Ord(AActual)));
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestSingle(const aSource: String; AToken: TIDLToken);
|
||||
begin
|
||||
TestMulti(aSource,[aToken]);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestMulti(const aSource: String;
|
||||
AToken: array of TIDLToken);
|
||||
|
||||
Var
|
||||
I : Integer;
|
||||
t : TIDLToken;
|
||||
|
||||
begin
|
||||
Init(ASource);
|
||||
I:=0;
|
||||
Repeat
|
||||
t:=Scanner.FetchToken;
|
||||
If T<>tkEOF then
|
||||
begin
|
||||
If I>High(AToken) then
|
||||
Fail(Format('"%s": Too many tokens in source (got: %d, expected: %d)',[aSource,I+1,High(aToken)+1]));
|
||||
AssertEquals('"'+ASource+'": token '+IntToStr(I),AToken[I],T);
|
||||
Inc(I);
|
||||
end
|
||||
Until (t=tkEOF);
|
||||
If I<High(AToken) then
|
||||
Fail('"'+ASource+'": Too little tokens in source');
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestSingle(const aSource: String; AToken: TIDLToken;
|
||||
AValue: String);
|
||||
begin
|
||||
TestMulti(aSource,[aToken],[aValue]);
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TestMulti(const aSource: String;
|
||||
AToken: array of TIDLToken; AValues: array of String);
|
||||
Var
|
||||
I : Integer;
|
||||
t : TIDLToken;
|
||||
|
||||
begin
|
||||
Init(ASource);
|
||||
I:=0;
|
||||
Repeat
|
||||
t:=Scanner.FetchToken;
|
||||
If T<>tkEOF then
|
||||
begin
|
||||
If I>High(AToken) then
|
||||
Fail(Format('"%s": Too many tokens in source (got: %d, expected: %d)',[aSource,I+1,High(aToken)+1]));
|
||||
AssertEquals('"'+ASource+'": token '+IntToStr(I),AToken[I],T);
|
||||
AssertEquals('"'+ASource+'": String '+IntToStr(I),AValues[I],FScanner.CurTokenString);
|
||||
Inc(I);
|
||||
end
|
||||
Until (t=tkEOF);
|
||||
If I<High(AToken) then
|
||||
Fail('"'+ASource+'": Too little tokens in source');
|
||||
end;
|
||||
|
||||
procedure TTestScanner.SetUp;
|
||||
begin
|
||||
Version:=v1;
|
||||
end;
|
||||
|
||||
procedure TTestScanner.TearDown;
|
||||
begin
|
||||
FreeAndNil(FScanner);
|
||||
end;
|
||||
|
||||
initialization
|
||||
|
||||
RegisterTest(TTestScanner);
|
||||
end.
|
||||
|
||||
549
packages/webidl/tests/tcwebidldefs.pp
Normal file
549
packages/webidl/tests/tcwebidldefs.pp
Normal file
@ -0,0 +1,549 @@
|
||||
unit tcwebidldefs;
|
||||
|
||||
{$mode objfpc}{$H+}
|
||||
|
||||
interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils, fpcunit, testregistry, webidldefs;
|
||||
|
||||
Type
|
||||
|
||||
{ TTestParser }
|
||||
|
||||
{ TTestDefinition }
|
||||
|
||||
TTestDefinition = Class(TTestCase)
|
||||
private
|
||||
FDef: TIDLDefinition;
|
||||
function CreateUnionTypeDef(Types : Array of UTF8String; withAttrs: Boolean=False): TIDLUnionTypeDefDefinition;
|
||||
function CreateArgument(isOptional : Boolean; DefaultValue : string = ''; withAttrs: Boolean=False): TIDLArgumentDefinition;
|
||||
function CreateFunction(Options: TFunctionOptions; Args: Array of UTF8String; withAttrs: Boolean=False): TIDLFunctionDefinition;
|
||||
function CreateAttribute(Options: TAttributeOptions; withAttrs: Boolean=False): TIDLAttributeDefinition;
|
||||
function CreateConst(withAttrs: Boolean=False): TIDLConstDefinition;
|
||||
function CreateImplements(Const ATypeName : String; withAttrs: Boolean=False): TIDLImplementsDefinition;
|
||||
function CreateIncludes(Const ATypeName : String; withAttrs: Boolean=False): TIDLIncludesDefinition;
|
||||
function CreateTypeDef(Const ATypeName : String; withAttrs: Boolean=False): TIDLTypeDefDefinition;
|
||||
function CreateInterface(Const AParentName : String; aMembers : Array of TIDLDefinition; withAttrs: Boolean=False): TIDLInterfaceDefinition;
|
||||
function CreateDictionaryMember(Const AName,aTypeName,aDefault : String; aRequired : Boolean; withAttrs: Boolean=False): TIDLDictionaryMemberDefinition;
|
||||
function CreateDictionary(Const AParentName : String; aMembers : Array of TIDLDictionaryMemberDefinition; withAttrs: Boolean=False): TIDLDictionaryDefinition;
|
||||
function CreateSequence(Const AElementName : String; withAttrs: Boolean=False): TIDLSequenceTypeDefDefinition;
|
||||
function CreatePromise(Const AReturnTypeName: String; withAttrs: Boolean=False): TIDLPromiseTypeDefDefinition;
|
||||
function CreateSetLike(Const AElementName: String; withAttrs: Boolean=False): TIDLSetLikeDefinition;
|
||||
function CreateMapLike(Const AKeyTypeName,AValueTypeName: String; withAttrs: Boolean=False): TIDLMapLikeDefinition;
|
||||
function CreateRecord(Const AKeyTypeName,AValueTypeName: String; withAttrs: Boolean=False): TIDLRecordDefinition;
|
||||
Public
|
||||
Procedure TearDown; override;
|
||||
function CreateDef(aClass: TIDLDefinitionClass; WithAttrs: Boolean=False): TIDLDefinition;
|
||||
Procedure TestDef(Const aDef : String; AFull : Boolean);
|
||||
Property Def : TIDLDefinition Read FDef Write FDef;
|
||||
published
|
||||
Procedure TestConst;
|
||||
procedure TestAttribute;
|
||||
procedure TestStringifierAttribute;
|
||||
procedure TestStringifierFunction;
|
||||
procedure TestFunction;
|
||||
procedure TestCallBackFunction;
|
||||
procedure TestArgument;
|
||||
procedure TestImplements;
|
||||
procedure TestIncludes;
|
||||
procedure TestTypeDef;
|
||||
procedure TestUnionTypeDef;
|
||||
procedure TestInterface;
|
||||
procedure TestDictionaryMember;
|
||||
procedure TestDictionary;
|
||||
procedure TestCallbackInterface;
|
||||
procedure TestSequence;
|
||||
procedure TestPromise;
|
||||
procedure TestMapLike;
|
||||
procedure TestSetLike;
|
||||
procedure TestRecord;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
{ TTestDefinition }
|
||||
|
||||
procedure TTestDefinition.TearDown;
|
||||
begin
|
||||
FreeAndNil(FDef);
|
||||
inherited TearDown;
|
||||
end;
|
||||
|
||||
function TTestDefinition.CreateDef(aClass: TIDLDefinitionClass; WithAttrs : Boolean = False): TIDLDefinition;
|
||||
begin
|
||||
FreeAndNil(FDef);
|
||||
FDef:=aClass.Create(Nil,'A');
|
||||
if WithAttrs then
|
||||
FDef.Attributes.Add('Me');
|
||||
Result:=FDef;
|
||||
end;
|
||||
|
||||
procedure TTestDefinition.TestDef(const aDef: String; AFull: Boolean);
|
||||
|
||||
begin
|
||||
AssertEquals('Def '+FDef.ClassName +'.AsString('+BoolToStr(aFull,'True','False')+')',ADef,FDef.AsString(afull));
|
||||
end;
|
||||
|
||||
function TTestDefinition.CreateConst(withAttrs: Boolean): TIDLConstDefinition;
|
||||
|
||||
begin
|
||||
Result:=CreateDef(TIDLConstDefinition,WithAttrs) as TIDLConstDefinition;
|
||||
Result.TypeName:='short';
|
||||
Result.Value:='0x8080';
|
||||
end;
|
||||
|
||||
function TTestDefinition.CreateImplements(const ATypeName: String;
|
||||
withAttrs: Boolean): TIDLImplementsDefinition;
|
||||
begin
|
||||
Result:=CreateDef(TIDLImplementsDefinition,WithAttrs) as TIDLImplementsDefinition;
|
||||
Result.ImplementedInterface:=ATypeName;
|
||||
end;
|
||||
|
||||
function TTestDefinition.CreateIncludes(const ATypeName: String;
|
||||
withAttrs: Boolean): TIDLIncludesDefinition;
|
||||
begin
|
||||
Result:=CreateDef(TIDLIncludesDefinition,WithAttrs) as TIDLIncludesDefinition;
|
||||
Result.IncludedInterface:=ATypeName;
|
||||
end;
|
||||
|
||||
function TTestDefinition.CreateTypeDef(const ATypeName: String;
|
||||
withAttrs: Boolean): TIDLTypeDefDefinition;
|
||||
begin
|
||||
Result:=CreateDef(TIDLTypeDefDefinition,WithAttrs) as TIDLTypeDefDefinition;
|
||||
Result.TypeName:=ATypeName;
|
||||
end;
|
||||
|
||||
function TTestDefinition.CreateInterface(const AParentName: String;
|
||||
aMembers: array of TIDLDefinition; withAttrs: Boolean
|
||||
): TIDLInterfaceDefinition;
|
||||
|
||||
Var
|
||||
M : TIDLDefinition;
|
||||
|
||||
begin
|
||||
Result:=CreateDef(TIDLInterfaceDefinition,WithAttrs) as TIDLInterfaceDefinition;
|
||||
Result.ParentName:=AParentName;
|
||||
For M in aMembers do
|
||||
Result.members.Add(M);
|
||||
end;
|
||||
|
||||
function TTestDefinition.CreateDictionaryMember(const AName, aTypeName,
|
||||
aDefault: String; aRequired: Boolean; withAttrs: Boolean
|
||||
): TIDLDictionaryMemberDefinition;
|
||||
begin
|
||||
Result:=CreateDef(TIDLDictionaryMemberDefinition,WithAttrs) as TIDLDictionaryMemberDefinition;
|
||||
Result.Name:=aName;
|
||||
Result.MemberType:=TIDLTypeDefDefinition.Create(Result,'');
|
||||
Result.MemberType.TypeName:=aTypeName;
|
||||
Result.IsRequired:=aRequired;
|
||||
if (aDefault<>'') then
|
||||
begin
|
||||
Result.DefaultValue:=TIDLConstDefinition.Create(Result,'');
|
||||
Result.DefaultValue.Value:=aDefault;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TTestDefinition.CreateDictionary(const AParentName: String;
|
||||
aMembers: array of TIDLDictionaryMemberDefinition; withAttrs: Boolean
|
||||
): TIDLDictionaryDefinition;
|
||||
|
||||
Var
|
||||
M : TIDLDictionaryMemberDefinition;
|
||||
|
||||
begin
|
||||
Result:=CreateDef(TIDLDictionaryDefinition,WithAttrs) as TIDLDictionaryDefinition;
|
||||
Result.ParentName:=aParentName;
|
||||
for M in aMembers do
|
||||
Result.Members.Add(M);
|
||||
end;
|
||||
|
||||
function TTestDefinition.CreateSequence(const AElementName: String;
|
||||
withAttrs: Boolean): TIDLSequenceTypeDefDefinition;
|
||||
|
||||
begin
|
||||
Result:=CreateDef(TIDLSequenceTypeDefDefinition,WithAttrs) as TIDLSequenceTypeDefDefinition;
|
||||
Result.ElementType:=TIDLTypeDefDefinition.Create(Result,'');
|
||||
Result.ElementType.TypeName:=AElementName;
|
||||
end;
|
||||
|
||||
function TTestDefinition.CreatePromise(const AReturnTypeName: String;
|
||||
withAttrs: Boolean): TIDLPromiseTypeDefDefinition;
|
||||
begin
|
||||
Result:=CreateDef(TIDLPromiseTypeDefDefinition,withAttrs) as TIDLPromiseTypeDefDefinition;
|
||||
Result.ReturnType:=TIDLTypeDefDefinition.Create(Result,'');
|
||||
Result.ReturnType.TypeName:=AReturnTypeName;
|
||||
end;
|
||||
|
||||
function TTestDefinition.CreateSetLike(const AElementName: String;
|
||||
withAttrs: Boolean): TIDLSetLikeDefinition;
|
||||
begin
|
||||
Result:=CreateDef(TIDLSetLikeDefinition,WithAttrs) as TIDLSetLikeDefinition;
|
||||
Result.ElementType:=TIDLTypeDefDefinition.Create(Result,'');
|
||||
Result.ElementType.TypeName:=AElementName;
|
||||
|
||||
end;
|
||||
|
||||
function TTestDefinition.CreateMapLike(const AKeyTypeName,
|
||||
AValueTypeName: String; withAttrs: Boolean): TIDLMapLikeDefinition;
|
||||
begin
|
||||
Result:=CreateDef(TIDLMapLikeDefinition,WithAttrs) as TIDLMapLikeDefinition;
|
||||
Result.KeyType:=TIDLTypeDefDefinition.Create(Result,'');
|
||||
Result.KeyType.TypeName:=AKeyTypeName;
|
||||
Result.ValueType:=TIDLTypeDefDefinition.Create(Result,'');
|
||||
Result.ValueType.TypeName:=AValueTypeName;
|
||||
end;
|
||||
|
||||
function TTestDefinition.CreateRecord(const AKeyTypeName,
|
||||
AValueTypeName: String; withAttrs: Boolean): TIDLRecordDefinition;
|
||||
begin
|
||||
Result:=CreateDef(TIDLRecordDefinition,WithAttrs) as TIDLRecordDefinition;
|
||||
Result.KeyType:=TIDLTypeDefDefinition.Create(Result,'');
|
||||
Result.KeyType.TypeName:=AKeyTypeName;
|
||||
Result.ValueType:=TIDLTypeDefDefinition.Create(Result,'');
|
||||
Result.ValueType.TypeName:=AValueTypeName;
|
||||
end;
|
||||
|
||||
procedure TTestDefinition.TestConst;
|
||||
|
||||
begin
|
||||
CreateConst(False);
|
||||
TestDef('const short A 0x8080',true);
|
||||
TestDef('short A 0x8080',False);
|
||||
CreateConst(True);
|
||||
TestDef('[Me] const short A 0x8080',true);
|
||||
TestDef('short A 0x8080',False);
|
||||
end;
|
||||
|
||||
function TTestDefinition.CreateUnionTypeDef(Types: array of UTF8String;
|
||||
withAttrs: Boolean): TIDLUnionTypeDefDefinition;
|
||||
|
||||
Var
|
||||
S : UTF8String;
|
||||
T : TIDLTypeDefDefinition;
|
||||
|
||||
begin
|
||||
Result:=CreateDef(TIDLUnionTypeDefDefinition,WithAttrs) as TIDLUnionTypeDefDefinition;
|
||||
for S in Types do
|
||||
begin
|
||||
T:=TIDLTypeDefDefinition.Create(Result,'');
|
||||
T.TypeName:=S;
|
||||
Result.Union.Add(T);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TTestDefinition.CreateArgument(isOptional: Boolean; DefaultValue: string; withAttrs: Boolean): TIDLArgumentDefinition;
|
||||
begin
|
||||
Result:=CreateDef(TIDLArgumentDefinition,WithAttrs) as TIDLArgumentDefinition;
|
||||
Result.ArgumentType:=TIDLTypeDefDefinition.Create(Result,'AN');
|
||||
Result.ArgumentType.TypeName:='short';
|
||||
Result.HasDefaultValue:=(DefaultValue<>'');
|
||||
Result.DefaultValue:=DefaultValue;
|
||||
Result.IsOptional:=IsOptional;
|
||||
end;
|
||||
|
||||
function TTestDefinition.CreateFunction(Options: TFunctionOptions; Args: array of UTF8String; withAttrs: Boolean): TIDLFunctionDefinition;
|
||||
|
||||
Var
|
||||
I : integer;
|
||||
|
||||
begin
|
||||
Result:=CreateDef(TIDLFunctionDefinition,WithAttrs) as TIDLFunctionDefinition;
|
||||
Result.ReturnType:=TIDLTypeDefDefinition.Create(Result,'AN');
|
||||
Result.ReturnType.TypeName:='short';
|
||||
Result.Options:=Options;
|
||||
I:=0;
|
||||
While I<Length(Args)-1 do
|
||||
begin
|
||||
Result.Arguments.Add(TIDLArgumentDefinition,args[I+1]);
|
||||
Result.Argument[I div 2].ArgumentType:=TIDLTypeDefDefinition.Create(Result,'AN'+IntToStr(i));
|
||||
Result.Argument[I div 2].ArgumentType.TypeName:=args[i];
|
||||
// With Result.Argument[I div 2] do
|
||||
// Writeln(I,': ',Name+'->',ArgumentType.TypeName);
|
||||
Inc(I,2);
|
||||
end;
|
||||
end;
|
||||
|
||||
function TTestDefinition.CreateAttribute(Options: TAttributeOptions;
|
||||
withAttrs: Boolean): TIDLAttributeDefinition;
|
||||
|
||||
begin
|
||||
Result:=CreateDef(TIDLAttributeDefinition,WithAttrs) as TIDLAttributeDefinition;
|
||||
Result.AttributeType:=TIDLTypeDefDefinition.Create(Result,'AN');
|
||||
Result.AttributeType.TypeName:='short';
|
||||
Result.Options:=Options;
|
||||
end;
|
||||
|
||||
procedure TTestDefinition.TestAttribute;
|
||||
|
||||
begin
|
||||
CreateAttribute([],False);
|
||||
TestDef('attribute short A',true);
|
||||
TestDef('short A',False);
|
||||
CreateAttribute([],True);
|
||||
TestDef('[Me] attribute short A',true);
|
||||
TestDef('short A',False);
|
||||
CreateAttribute([aoReadonly],false);
|
||||
TestDef('readonly attribute short A',true);
|
||||
TestDef('short A',False);
|
||||
CreateAttribute([aoStatic],false);
|
||||
TestDef('static attribute short A',true);
|
||||
TestDef('short A',False);
|
||||
end;
|
||||
|
||||
procedure TTestDefinition.TestStringifierAttribute;
|
||||
begin
|
||||
CreateAttribute([aoStringifier],false);
|
||||
TestDef('stringifier attribute short A',true);
|
||||
TestDef('short A',False);
|
||||
CreateAttribute([aoStringifier,aoReadOnly],false);
|
||||
TestDef('stringifier readonly attribute short A',true);
|
||||
TestDef('short A',False);
|
||||
end;
|
||||
|
||||
procedure TTestDefinition.TestStringifierFunction;
|
||||
begin
|
||||
CreateFunction([foStringifier],[],False);
|
||||
TestDef('stringifier short A ()',True);
|
||||
end;
|
||||
|
||||
procedure TTestDefinition.TestFunction;
|
||||
|
||||
Var
|
||||
F : TIDLFunctionDefinition;
|
||||
|
||||
begin
|
||||
CreateFunction([],[],False);
|
||||
TestDef('short A ()',True);
|
||||
CreateFunction([],['short','B'],False);
|
||||
TestDef('short A (short B)',True);
|
||||
TestDef('short A (short B)',False);
|
||||
CreateFunction([],['short','B'],True);
|
||||
TestDef('[Me] short A (short B)',True);
|
||||
F:=CreateFunction([],['short','B','long','C'],False);
|
||||
F.Argument[1].IsOptional:=True;
|
||||
TestDef('short A (short B, optional long C)',True);
|
||||
F.Argument[1].HasDefaultValue:=True;
|
||||
F.Argument[1].DefaultValue:='123';
|
||||
TestDef('short A (short B, optional long C = 123)',True);
|
||||
CreateFunction([foStatic],[],False);
|
||||
TestDef('static short A ()',True);
|
||||
CreateFunction([foGetter],[],False);
|
||||
TestDef('getter short A ()',True);
|
||||
CreateFunction([foSetter],[],False);
|
||||
TestDef('setter short A ()',True);
|
||||
end;
|
||||
|
||||
procedure TTestDefinition.TestCallBackFunction;
|
||||
begin
|
||||
CreateFunction([foCallback],[],False);
|
||||
TestDef('callback A = short ()',True);
|
||||
end;
|
||||
|
||||
procedure TTestDefinition.TestArgument;
|
||||
|
||||
begin
|
||||
CreateArgument(False,'',False);
|
||||
TestDef('short A',true);
|
||||
CreateArgument(False,'',False).ArgumentType.AllowNull:=True;
|
||||
TestDef('short? A',true);
|
||||
CreateArgument(true,'',False);
|
||||
TestDef('optional short A',true);
|
||||
CreateArgument(true,'',true);
|
||||
TestDef('[Me] optional short A',true);
|
||||
CreateArgument(true,'1',true);
|
||||
TestDef('[Me] optional short A = 1',true);
|
||||
end;
|
||||
|
||||
procedure TTestDefinition.TestImplements;
|
||||
|
||||
begin
|
||||
CreateImplements('IME',False);
|
||||
TestDef('A implements IME',False);
|
||||
TestDef('A implements IME',True);
|
||||
CreateImplements('IME',True);
|
||||
TestDef('A implements IME',False);
|
||||
TestDef('[Me] A implements IME',True);
|
||||
end;
|
||||
|
||||
procedure TTestDefinition.TestIncludes;
|
||||
begin
|
||||
CreateIncludes('IME',False);
|
||||
TestDef('A includes IME',False);
|
||||
TestDef('A includes IME',True);
|
||||
CreateIncludes('IME',True);
|
||||
TestDef('A includes IME',False);
|
||||
TestDef('[Me] A includes IME',True);
|
||||
end;
|
||||
|
||||
procedure TTestDefinition.TestTypeDef;
|
||||
|
||||
begin
|
||||
CreateTypeDef('IME',False);
|
||||
TestDef('IME',False);
|
||||
TestDef('typedef IME A',true);
|
||||
CreateTypeDef('IME',True);
|
||||
TestDef('IME',False);
|
||||
TestDef('[Me] typedef IME A',true);
|
||||
CreateTypeDef('IME',True).AllowNull:=True;
|
||||
TestDef('IME?',False);
|
||||
TestDef('[Me] typedef IME? A',true);
|
||||
end;
|
||||
|
||||
procedure TTestDefinition.TestUnionTypeDef;
|
||||
begin
|
||||
CreateUnionTypeDef(['string','short'],False);
|
||||
TestDef('(string or short)',False);
|
||||
TestDef('typedef (string or short) A',true);
|
||||
CreateUnionTypeDef(['string','short','unsigned long long'],true);
|
||||
TestDef('(string or short or unsigned long long)',False);
|
||||
TestDef('[Me] typedef (string or short or unsigned long long) A',true);
|
||||
end;
|
||||
|
||||
procedure TTestDefinition.TestInterface;
|
||||
|
||||
Var
|
||||
C : TIDLConstDefinition;
|
||||
D : TIDLFunctionDefinition;
|
||||
|
||||
begin
|
||||
CreateInterface('',[],False);
|
||||
TestDef('interface A {'+sLinebreak+'}',True);
|
||||
CreateInterface('B',[]);
|
||||
TestDef('interface A : B {'+sLinebreak+'}',True);
|
||||
C:=CreateConst(False);
|
||||
Def:=Nil;
|
||||
CreateInterface('B',[C]);
|
||||
TestDef('interface A : B {'+sLinebreak+' const short A 0x8080;'+sLineBreak+'}',True);
|
||||
C:=CreateConst(False);
|
||||
C.Name:='D';
|
||||
Def:=Nil;
|
||||
D:=CreateFunction([],[],True);
|
||||
D.Name:='C';
|
||||
Def:=Nil;
|
||||
CreateInterface('B',[C,D]);
|
||||
TestDef('interface A : B {'+sLinebreak
|
||||
+' const short D 0x8080;'+sLineBreak
|
||||
+' [Me] short C ();'+sLineBreak
|
||||
+'}',True);
|
||||
CreateInterface('',[],False).IsPartial:=True;
|
||||
TestDef('partial interface A {'+sLinebreak+'}',True);
|
||||
end;
|
||||
|
||||
procedure TTestDefinition.TestDictionaryMember;
|
||||
|
||||
begin
|
||||
CreateDictionaryMember('A','short','',False,False);
|
||||
TestDef('short A',False);
|
||||
TestDef('short A',True);
|
||||
CreateDictionaryMember('A','short','""',False,False);
|
||||
TestDef('short A = ""',False);
|
||||
TestDef('short A = ""',True);
|
||||
CreateDictionaryMember('A','short','',True,False);
|
||||
TestDef('required short A',False);
|
||||
TestDef('required short A',True);
|
||||
CreateDictionaryMember('A','short','',False,True);
|
||||
TestDef('short A',False);
|
||||
TestDef('[Me] short A',True);
|
||||
CreateDictionaryMember('A','short','',true,True);
|
||||
TestDef('required short A',False);
|
||||
TestDef('[Me] required short A',True);
|
||||
end;
|
||||
|
||||
procedure TTestDefinition.TestDictionary;
|
||||
|
||||
Var
|
||||
m1,m2 : TIDLDictionaryMemberDefinition;
|
||||
|
||||
begin
|
||||
CreateDictionary('',[],False);
|
||||
TestDef('dictionary A {'+sLinebreak+'}',True);
|
||||
CreateDictionary('B',[],False);
|
||||
TestDef('dictionary A : B {'+sLinebreak+'}',True);
|
||||
m1:=CreateDictionaryMember('B','short','',False,False);
|
||||
Def:=Nil;
|
||||
CreateDictionary('',[m1],False);
|
||||
TestDef('dictionary A {'+sLinebreak+
|
||||
' short B;'+sLinebreak+
|
||||
'}',True);
|
||||
m1:=CreateDictionaryMember('C','short','',False,False);
|
||||
Def:=Nil;
|
||||
m2:=CreateDictionaryMember('D','short','',true,True);
|
||||
Def:=Nil;
|
||||
CreateDictionary('B',[m1,m2],False);
|
||||
TestDef('dictionary A : B {'+sLinebreak+
|
||||
' short C;'+sLinebreak+
|
||||
' [Me] required short D;'+sLinebreak+
|
||||
'}',True);
|
||||
|
||||
end;
|
||||
|
||||
procedure TTestDefinition.TestCallbackInterface;
|
||||
begin
|
||||
CreateInterface('',[],False).IsCallBack:=True;
|
||||
TestDef('callback interface A {'+sLinebreak+'}',True);
|
||||
end;
|
||||
|
||||
procedure TTestDefinition.TestSequence;
|
||||
begin
|
||||
CreateSequence('short',false);
|
||||
TestDef('typedef sequence <short> A',True);
|
||||
TestDef('sequence <short>',False);
|
||||
CreateSequence('short',True);
|
||||
TestDef('[Me] typedef sequence <short> A',True);
|
||||
TestDef('sequence <short>',False);
|
||||
end;
|
||||
|
||||
procedure TTestDefinition.TestPromise;
|
||||
begin
|
||||
CreatePromise('short',false);
|
||||
TestDef('typedef promise <short> A',True);
|
||||
TestDef('promise <short>',False);
|
||||
CreatePromise('short',true);
|
||||
TestDef('[Me] typedef promise <short> A',True);
|
||||
TestDef('promise <short>',False);
|
||||
CreatePromise('short',False).AllowNull:=True;
|
||||
TestDef('typedef promise <short>? A',True);
|
||||
TestDef('promise <short>?',False);
|
||||
end;
|
||||
|
||||
procedure TTestDefinition.TestMapLike;
|
||||
begin
|
||||
CreateMapLike('short','string',false);
|
||||
TestDef('maplike <short,string>',True);
|
||||
TestDef('maplike <short,string>',False);
|
||||
CreateMapLike('short','string', True);
|
||||
TestDef('[Me] maplike <short,string>',True);
|
||||
TestDef('maplike <short,string>',False);
|
||||
CreateMapLike('short','string' ,false).IsReadOnly:=True;
|
||||
TestDef('readonly maplike <short,string>',True);
|
||||
TestDef('readonly maplike <short,string>',False);
|
||||
end;
|
||||
|
||||
procedure TTestDefinition.TestSetLike;
|
||||
begin
|
||||
CreateSetLike('string',false);
|
||||
TestDef('setlike <string>',True);
|
||||
TestDef('setlike <string>',False);
|
||||
CreateSetLike('string', True);
|
||||
TestDef('[Me] setlike <string>',True);
|
||||
TestDef('setlike <string>',False);
|
||||
CreateSetLike('string' ,false).IsReadOnly:=True;
|
||||
TestDef('readonly setlike <string>',True);
|
||||
TestDef('readonly setlike <string>',False);
|
||||
end;
|
||||
|
||||
procedure TTestDefinition.TestRecord;
|
||||
begin
|
||||
CreateRecord('short','string',false);
|
||||
TestDef('typedef record <short,string>',True);
|
||||
TestDef('record <short,string>',False);
|
||||
CreateRecord('short','string', True);
|
||||
TestDef('[Me] typedef record <short,string>',True);
|
||||
TestDef('record <short,string>',False);
|
||||
end;
|
||||
|
||||
initialization
|
||||
RegisterTests([TTestDefinition])
|
||||
end.
|
||||
|
||||
96
packages/webidl/tests/testidl.lpi
Normal file
96
packages/webidl/tests/testidl.lpi
Normal file
@ -0,0 +1,96 @@
|
||||
r<?xml version="1.0" encoding="UTF-8"?>
|
||||
<CONFIG>
|
||||
<ProjectOptions>
|
||||
<Version Value="11"/>
|
||||
<General>
|
||||
<SessionStorage Value="InProjectDir"/>
|
||||
<MainUnit Value="0"/>
|
||||
<Title Value="testidl"/>
|
||||
<ResourceType Value="res"/>
|
||||
<UseXPManifest Value="True"/>
|
||||
<Icon Value="0"/>
|
||||
</General>
|
||||
<BuildModes Count="1">
|
||||
<Item1 Name="Default" Default="True"/>
|
||||
</BuildModes>
|
||||
<PublishOptions>
|
||||
<Version Value="2"/>
|
||||
</PublishOptions>
|
||||
<RunParams>
|
||||
<local>
|
||||
<CommandLineParams Value="--suite=TTestMapLikeInterfaceParser"/>
|
||||
</local>
|
||||
<FormatVersion Value="2"/>
|
||||
<Modes Count="1">
|
||||
<Mode0 Name="default">
|
||||
<local>
|
||||
<CommandLineParams Value="--suite=TTestMapLikeInterfaceParser"/>
|
||||
</local>
|
||||
</Mode0>
|
||||
</Modes>
|
||||
</RunParams>
|
||||
<Units Count="7">
|
||||
<Unit0>
|
||||
<Filename Value="testidl.pas"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit0>
|
||||
<Unit1>
|
||||
<Filename Value="../src/webidlscanner.pp"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit1>
|
||||
<Unit2>
|
||||
<Filename Value="tcidlscanner.pp"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit2>
|
||||
<Unit3>
|
||||
<Filename Value="../src/webidlparser.pp"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit3>
|
||||
<Unit4>
|
||||
<Filename Value="../src/webidldefs.pp"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit4>
|
||||
<Unit5>
|
||||
<Filename Value="tcidlparser.pp"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit5>
|
||||
<Unit6>
|
||||
<Filename Value="tcwebidldefs.pp"/>
|
||||
<IsPartOfProject Value="True"/>
|
||||
</Unit6>
|
||||
</Units>
|
||||
</ProjectOptions>
|
||||
<CompilerOptions>
|
||||
<Version Value="11"/>
|
||||
<Target>
|
||||
<Filename Value="testidl"/>
|
||||
</Target>
|
||||
<SearchPaths>
|
||||
<IncludeFiles Value="$(ProjOutDir)"/>
|
||||
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
|
||||
</SearchPaths>
|
||||
<Linking>
|
||||
<Debugging>
|
||||
<UseHeaptrc Value="True"/>
|
||||
</Debugging>
|
||||
<Options>
|
||||
<Win32>
|
||||
<GraphicApplication Value="True"/>
|
||||
</Win32>
|
||||
</Options>
|
||||
</Linking>
|
||||
</CompilerOptions>
|
||||
<Debugging>
|
||||
<Exceptions Count="3">
|
||||
<Item1>
|
||||
<Name Value="EAbort"/>
|
||||
</Item1>
|
||||
<Item2>
|
||||
<Name Value="ECodetoolError"/>
|
||||
</Item2>
|
||||
<Item3>
|
||||
<Name Value="EFOpenError"/>
|
||||
</Item3>
|
||||
</Exceptions>
|
||||
</Debugging>
|
||||
</CONFIG>
|
||||
21
packages/webidl/tests/testidl.pas
Normal file
21
packages/webidl/tests/testidl.pas
Normal file
@ -0,0 +1,21 @@
|
||||
program testidl;
|
||||
|
||||
{$mode objfpc}
|
||||
{$H+}
|
||||
|
||||
uses
|
||||
consoletestrunner, webidlscanner, tcidlscanner, webidlparser, webidldefs,
|
||||
tcidlparser, tcwebidldefs;
|
||||
|
||||
Var
|
||||
Application : TTestRunner;
|
||||
|
||||
begin
|
||||
DefaultRunAllTests:=True;
|
||||
DefaultFormat:=fPlain;
|
||||
Application:=TTestRunner.Create(Nil);
|
||||
Application.Initialize;
|
||||
Application.Run;
|
||||
Application.Free;
|
||||
end.
|
||||
|
||||
Loading…
Reference in New Issue
Block a user