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

pastojs: write proctype

Browse Source 
git-svn-id: trunk@38214 -
This commit is contained in:
Mattias Gaertner 2018-02-11 21:50:51 +00:00
parent db4db36793
commit 30d80beb7e
4 changed files with 1421 additions and 259 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
packages/pastojs/src/fppas2js.pp
View File

@ -1,6 +1,6 @@
{ {
This file is part of the Free Component Library (FCL) This file is part of the Free Component Library (FCL)
Copyright (c) 2014 by Michael Van Canneyt Copyright (c) 2018 by Michael Van Canneyt
Pascal to Javascript converter class. Pascal to Javascript converter class.

1582
packages/pastojs/src/pas2jsfiler.pp
View File

File diff suppressed because it is too large Load Diff

94
packages/pastojs/tests/tcfiler.pas
View File

@ -1,6 +1,6 @@
{ {
This file is part of the Free Component Library (FCL) This file is part of the Free Component Library (FCL)
Copyright (c) 2014 by Michael Van Canneyt Copyright (c) 2018 by Michael Van Canneyt
Unit tests for Pascal-to-Javascript precompile class. Unit tests for Pascal-to-Javascript precompile class.
@ -44,13 +44,16 @@ type
procedure TearDown; override; procedure TearDown; override;
procedure WriteReadUnit; virtual; procedure WriteReadUnit; virtual;
procedure StartParsing; override; procedure StartParsing; override;
function CheckRestoredObject(const Path: string; Orig, Rest: TObject): boolean; virtual;
procedure CheckRestoredResolver(Original, Restored: TPas2JSResolver); virtual; procedure CheckRestoredResolver(Original, Restored: TPas2JSResolver); virtual;
procedure CheckRestoredDeclarations(const Path: string; Orig, Rest: TPasDeclarations); virtual; procedure CheckRestoredDeclarations(const Path: string; Orig, Rest: TPasDeclarations); virtual;
procedure CheckRestoredSection(const Path: string; Orig, Rest: TPasSection); virtual; procedure CheckRestoredSection(const Path: string; Orig, Rest: TPasSection); virtual;
procedure CheckRestoredModule(const Path: string; Orig, Rest: TPasModule); virtual; procedure CheckRestoredModule(const Path: string; Orig, Rest: TPasModule); virtual;
procedure CheckRestoredScopeReference(const Path: string; Orig, Rest: TPasScope); virtual;
procedure CheckRestoredModuleScope(const Path: string; Orig, Rest: TPasModuleScope); virtual; procedure CheckRestoredModuleScope(const Path: string; Orig, Rest: TPasModuleScope); virtual;
procedure CheckRestoredIdentifierScope(const Path: string; Orig, Rest: TPasIdentifierScope); virtual; procedure CheckRestoredIdentifierScope(const Path: string; Orig, Rest: TPasIdentifierScope); virtual;
procedure CheckRestoredSectionScope(const Path: string; Orig, Rest: TPasSectionScope); virtual; procedure CheckRestoredSectionScope(const Path: string; Orig, Rest: TPasSectionScope); virtual;
procedure CheckRestoredProcScope(const Path: string; Orig, Rest: TPas2JSProcedureScope); virtual;
procedure CheckRestoredCustomData(const Path: string; El: TPasElement; Orig, Rest: TObject); virtual; procedure CheckRestoredCustomData(const Path: string; El: TPasElement; Orig, Rest: TObject); virtual;
procedure CheckRestoredElement(const Path: string; Orig, Rest: TPasElement); virtual; procedure CheckRestoredElement(const Path: string; Orig, Rest: TPasElement); virtual;
procedure CheckRestoredElementList(const Path: string; Orig, Rest: TFPList); virtual; procedure CheckRestoredElementList(const Path: string; Orig, Rest: TFPList); virtual;
@ -224,6 +227,22 @@ begin
// ToDo: defines // ToDo: defines
end; end;
function TCustomTestPrecompile.CheckRestoredObject(const Path: string; Orig,
Rest: TObject): boolean;
begin
if Orig=nil then
begin
if Rest<>nil then
Fail(Path+': Orig=nil Rest='+GetObjName(Rest));
exit(false);
end
else if Rest=nil then
Fail(Path+': Orig='+GetObjName(Orig)+' Rest=nil');
if Orig.ClassType<>Rest.ClassType then
Fail(Path+': Orig='+GetObjName(Orig)+' Rest='+GetObjName(Rest));
Result:=true;
end;
procedure TCustomTestPrecompile.CheckRestoredResolver(Original, procedure TCustomTestPrecompile.CheckRestoredResolver(Original,
Restored: TPas2JSResolver); Restored: TPas2JSResolver);
begin begin
@ -281,6 +300,13 @@ begin
CheckRestoredElement(Path+'.FinalizationSection',Orig.FinalizationSection,Rest.FinalizationSection); CheckRestoredElement(Path+'.FinalizationSection',Orig.FinalizationSection,Rest.FinalizationSection);
end; end;
procedure TCustomTestPrecompile.CheckRestoredScopeReference(const Path: string;
Orig, Rest: TPasScope);
begin
if not CheckRestoredObject(Path,Orig,Rest) then exit;
CheckRestoredReference(Path+'.Element',Orig.Element,Rest.Element);
end;
procedure TCustomTestPrecompile.CheckRestoredModuleScope(const Path: string; procedure TCustomTestPrecompile.CheckRestoredModuleScope(const Path: string;
Orig, Rest: TPasModuleScope); Orig, Rest: TPasModuleScope);
begin begin
@ -359,27 +385,40 @@ begin
CheckRestoredIdentifierScope(Path,Orig,Rest); CheckRestoredIdentifierScope(Path,Orig,Rest);
end; end;
procedure TCustomTestPrecompile.CheckRestoredProcScope(const Path: string;
Orig, Rest: TPas2JSProcedureScope);
begin
AssertEquals(Path+': ResultVarName',Orig.ResultVarName,Rest.ResultVarName);
// DeclarationProc: TPasProcedure; only the declaration is stored
// ImplProc: TPasProcedure; only the declaration is stored
CheckRestoredReference(Path+': OverriddenProc',Orig.OverriddenProc,Rest.OverriddenProc);
CheckRestoredScopeReference(Path+': ClassScope',Orig.ClassScope,Rest.ClassScope);
CheckRestoredElement(Path+'.SelfArg',Orig.SelfArg,Rest.SelfArg);
AssertEquals(Path+'.Mode',PJUModeSwitchNames[Orig.Mode],PJUModeSwitchNames[Rest.Mode]);
if Orig.Flags<>Rest.Flags then
Fail(Path+'.Flags');
if Orig.BoolSwitches<>Rest.BoolSwitches then
Fail(Path+'.BoolSwitches');
CheckRestoredIdentifierScope(Path,Orig,Rest);
end;
procedure TCustomTestPrecompile.CheckRestoredCustomData(const Path: string; procedure TCustomTestPrecompile.CheckRestoredCustomData(const Path: string;
El: TPasElement; Orig, Rest: TObject); El: TPasElement; Orig, Rest: TObject);
var var
C: TClass; C: TClass;
begin begin
if Orig=nil then if not CheckRestoredObject(Path,Orig,Rest) then exit;
begin
if Rest<>nil then
Fail(Path+': Orig=nil Rest='+GetObjName(Rest));
exit;
end
else if Rest=nil then
Fail(Path+': Orig='+GetObjName(Orig)+' Rest=nil');
if Orig.ClassType<>Rest.ClassType then
Fail(Path+': Orig='+GetObjName(Orig)+' Rest='+GetObjName(Rest));
C:=Orig.ClassType; C:=Orig.ClassType;
if C=TPasModuleScope then if C=TPasModuleScope then
CheckRestoredModuleScope(Path+'[TPasModuleScope]',TPasModuleScope(Orig),TPasModuleScope(Rest)) CheckRestoredModuleScope(Path+'[TPasModuleScope]',TPasModuleScope(Orig),TPasModuleScope(Rest))
else if C=TPasSectionScope then else if C=TPasSectionScope then
CheckRestoredSectionScope(Path+'[TPasSectionScope]',TPasSectionScope(Orig),TPasSectionScope(Rest)) CheckRestoredSectionScope(Path+'[TPasSectionScope]',TPasSectionScope(Orig),TPasSectionScope(Rest))
else if C=TPas2JSProcedureScope then
CheckRestoredProcScope(Path+'[TPas2JSProcedureScope]',TPas2JSProcedureScope(Orig),TPas2JSProcedureScope(Rest))
else else
Fail(Path+': unknown CustomData "'+GetObjName(Orig)+'" El='+GetObjName(El)); Fail(Path+': unknown CustomData "'+GetObjName(Orig)+'" El='+GetObjName(El));
end; end;
@ -389,16 +428,7 @@ procedure TCustomTestPrecompile.CheckRestoredElement(const Path: string; Orig,
var var
C: TClass; C: TClass;
begin begin
if Orig=nil then if not CheckRestoredObject(Path,Orig,Rest) then exit;
begin
if Rest<>nil then
Fail(Path+': Orig=nil Rest='+GetObjName(Rest));
exit;
end
else if Rest=nil then
Fail(Path+': Orig='+GetObjName(Orig)+' Rest=nil');
if Orig.ClassType<>Rest.ClassType then
Fail(Path+': Orig='+GetObjName(Orig)+' Rest='+GetObjName(Rest));
AssertEquals(Path+': Name',Orig.Name,Rest.Name); AssertEquals(Path+': Name',Orig.Name,Rest.Name);
AssertEquals(Path+': SourceFilename',Orig.SourceFilename,Rest.SourceFilename); AssertEquals(Path+': SourceFilename',Orig.SourceFilename,Rest.SourceFilename);
@ -523,16 +553,7 @@ var
i: Integer; i: Integer;
SubPath: String; SubPath: String;
begin begin
if Orig=nil then if not CheckRestoredObject(Path,Orig,Rest) then exit;
begin
if Rest=nil then
exit;
Fail(Path+' Orig=nil Rest='+GetObjName(Rest));
end
else if Rest=nil then
Fail(Path+' Orig='+GetObjName(Orig)+' Rest=nil')
else if Orig.ClassType<>Rest.ClassType then
Fail(Path+' Orig='+GetObjName(Orig)+' Rest='+GetObjName(Rest));
AssertEquals(Path+'.Count',Orig.Count,Rest.Count); AssertEquals(Path+'.Count',Orig.Count,Rest.Count);
for i:=0 to Orig.Count-1 do for i:=0 to Orig.Count-1 do
begin begin
@ -848,16 +869,7 @@ end;
procedure TCustomTestPrecompile.CheckRestoredReference(const Path: string; procedure TCustomTestPrecompile.CheckRestoredReference(const Path: string;
Orig, Rest: TPasElement); Orig, Rest: TPasElement);
begin begin
if Orig=nil then if not CheckRestoredObject(Path,Orig,Rest) then exit;
begin
if Rest<>nil then
Fail(Path+': Orig=nil Rest='+GetObjName(Rest));
exit;
end
else if Rest=nil then
Fail(Path+': Orig='+GetObjName(Orig)+' Rest=nil');
if Orig.ClassType<>Rest.ClassType then
Fail(Path+': Orig='+GetObjName(Orig)+' Rest='+GetObjName(Rest));
AssertEquals(Path+': Name',Orig.Name,Rest.Name); AssertEquals(Path+': Name',Orig.Name,Rest.Name);
if Orig is TPasUnresolvedSymbolRef then if Orig is TPasUnresolvedSymbolRef then

2
packages/pastojs/tests/tcmodules.pas
View File

@ -1,6 +1,6 @@
{ {
This file is part of the Free Component Library (FCL) This file is part of the Free Component Library (FCL)
Copyright (c) 2014 by Michael Van Canneyt Copyright (c) 2018 by Michael Van Canneyt
Unit tests for Pascal-to-Javascript converter class. Unit tests for Pascal-to-Javascript converter class.