mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-14 09:29:26 +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/fpmake.pp svneol=native#text/plain
|
||||||
packages/uuid/src/libuuid.pp svneol=native#text/plain
|
packages/uuid/src/libuuid.pp svneol=native#text/plain
|
||||||
packages/uuid/src/macuuid.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 svneol=native#text/plain
|
||||||
packages/winceunits/Makefile.fpc svneol=native#text/plain
|
packages/winceunits/Makefile.fpc svneol=native#text/plain
|
||||||
packages/winceunits/Makefile.fpc.fpcmake svneol=native#text/plain
|
packages/winceunits/Makefile.fpc.fpcmake svneol=native#text/plain
|
||||||
|
|||||||
@ -138,5 +138,6 @@
|
|||||||
add_libgc(ADirectory+IncludeTrailingPathDelimiter('libgc'));
|
add_libgc(ADirectory+IncludeTrailingPathDelimiter('libgc'));
|
||||||
add_libfontconfig(ADirectory+IncludeTrailingPathDelimiter('libfontconfig'));
|
add_libfontconfig(ADirectory+IncludeTrailingPathDelimiter('libfontconfig'));
|
||||||
add_fcl_report(ADirectory+IncludeTrailingPathDelimiter('fcl-report'));
|
add_fcl_report(ADirectory+IncludeTrailingPathDelimiter('fcl-report'));
|
||||||
|
add_webidl(ADirectory+IncludeTrailingPathDelimiter('webidl'));
|
||||||
add_ide(ADirectory+IncludeTrailingPathDelimiter('ide'));
|
add_ide(ADirectory+IncludeTrailingPathDelimiter('ide'));
|
||||||
|
|
||||||
|
|||||||
@ -789,4 +789,11 @@ begin
|
|||||||
{$include fcl-report/fpmake.pp}
|
{$include fcl-report/fpmake.pp}
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
procedure add_webidl(const ADirectory: string);
|
||||||
|
begin
|
||||||
|
with Installer do
|
||||||
|
{$include webidl/fpmake.pp}
|
||||||
|
end;
|
||||||
|
|
||||||
|
|
||||||
{$include ide/fpmake.pp}
|
{$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