mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-10 22:09:18 +02:00
pastojs: filer: write final switches, test overloads
git-svn-id: trunk@38534 -
This commit is contained in:
Mattias Gaertner
parent
b1cc01e317
commit
823ab4ee98
@ -1205,7 +1205,8 @@ begin
|
||||
JS:=Converter.ConvertPasElement(PasModule,PascalResolver);
|
||||
Converter.Options:=Converter.Options-[coStoreImplJS];
|
||||
|
||||
Writer.WritePCU(PascalResolver,Converter,Compiler.PrecompileInitialFlags,ms,false);
|
||||
Writer.WritePCU(PascalResolver,Converter,Compiler.PrecompileInitialFlags,ms,
|
||||
{$IFDEF DisablePCUCompressed}false{$ELSE}true{$ENDIF});
|
||||
{$IF defined(VerboseUnitQueue) or defined(VerbosePCUFiler)}
|
||||
writeln('TPas2jsCompilerFile.WritePCU precompiled ',PCUFilename);
|
||||
{$ENDIF}
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -145,9 +145,11 @@ type
|
||||
procedure TestPC_Proc_UTF8;
|
||||
procedure TestPC_Class;
|
||||
procedure TestPC_Initialization;
|
||||
procedure TestPC_BoolSwitches;
|
||||
|
||||
procedure TestPC_UseUnit;
|
||||
procedure TestPC_UseUnit_Class;
|
||||
procedure TestPC_UseIndirectUnit;
|
||||
end;
|
||||
|
||||
function CompareListOfProcScopeRef(Item1, Item2: Pointer): integer;
|
||||
@ -478,12 +480,22 @@ end;
|
||||
|
||||
procedure TCustomTestPrecompile.CheckRestoredResolver(Original,
|
||||
Restored: TPas2JSResolver);
|
||||
var
|
||||
OrigParser, RestParser: TPasParser;
|
||||
begin
|
||||
AssertNotNull('CheckRestoredResolver Original',Original);
|
||||
AssertNotNull('CheckRestoredResolver Restored',Restored);
|
||||
if Original.ClassType<>Restored.ClassType then
|
||||
Fail('CheckRestoredResolver Original='+Original.ClassName+' Restored='+Restored.ClassName);
|
||||
CheckRestoredElement('RootElement',Original.RootElement,Restored.RootElement);
|
||||
OrigParser:=Original.CurrentParser;
|
||||
RestParser:=Restored.CurrentParser;
|
||||
if OrigParser.Options<>RestParser.Options then
|
||||
Fail('CheckRestoredResolver Parser.Options');
|
||||
if OrigParser.Scanner.CurrentBoolSwitches<>RestParser.Scanner.CurrentBoolSwitches then
|
||||
Fail('CheckRestoredResolver Scanner.BoolSwitches');
|
||||
if OrigParser.Scanner.CurrentModeSwitches<>RestParser.Scanner.CurrentModeSwitches then
|
||||
Fail('CheckRestoredResolver Scanner.ModeSwitches');
|
||||
end;
|
||||
|
||||
procedure TCustomTestPrecompile.CheckRestoredDeclarations(const Path: string;
|
||||
@ -1719,6 +1731,32 @@ begin
|
||||
WriteReadUnit;
|
||||
end;
|
||||
|
||||
procedure TTestPrecompile.TestPC_BoolSwitches;
|
||||
begin
|
||||
StartUnit(false);
|
||||
Add([
|
||||
'interface',
|
||||
'{$R+}',
|
||||
'{$C+}',
|
||||
'type',
|
||||
' TObject = class',
|
||||
'{$C-}',
|
||||
' procedure DoIt;',
|
||||
' end;',
|
||||
'{$C+}',
|
||||
'implementation',
|
||||
'{$R-}',
|
||||
'procedure TObject.DoIt;',
|
||||
'begin',
|
||||
'end;',
|
||||
'{$C-}',
|
||||
'initialization',
|
||||
'{$R+}',
|
||||
'end.',
|
||||
'']);
|
||||
WriteReadUnit;
|
||||
end;
|
||||
|
||||
procedure TTestPrecompile.TestPC_UseUnit;
|
||||
begin
|
||||
AddModuleWithIntfImplSrc('unit2.pp',
|
||||
@ -1789,6 +1827,37 @@ begin
|
||||
WriteReadUnit;
|
||||
end;
|
||||
|
||||
procedure TTestPrecompile.TestPC_UseIndirectUnit;
|
||||
begin
|
||||
AddModuleWithIntfImplSrc('unit2.pp',
|
||||
LinesToStr([
|
||||
'type',
|
||||
' TObject = class',
|
||||
' public',
|
||||
' i: longint;',
|
||||
' end;']),
|
||||
LinesToStr([
|
||||
'']));
|
||||
|
||||
AddModuleWithIntfImplSrc('unit1.pp',
|
||||
LinesToStr([
|
||||
'uses unit2;',
|
||||
'var o: TObject;']),
|
||||
LinesToStr([
|
||||
'']));
|
||||
|
||||
StartUnit(true);
|
||||
Add([
|
||||
'interface',
|
||||
'uses unit1;',
|
||||
'implementation',
|
||||
'initialization',
|
||||
' o.i:=3;',
|
||||
'end.',
|
||||
'']);
|
||||
WriteReadUnit;
|
||||
end;
|
||||
|
||||
Initialization
|
||||
RegisterTests([TTestPrecompile]);
|
||||
end.
|
||||
|
||||
@ -25,22 +25,33 @@ interface
|
||||
|
||||
uses
|
||||
Classes, SysUtils,
|
||||
fpcunit, testregistry,
|
||||
tcunitsearch, tcmodules, Pas2jsFileUtils;
|
||||
fpcunit, testregistry, Pas2jsFileUtils, Pas2JsFiler,
|
||||
tcunitsearch, tcmodules;
|
||||
|
||||
type
|
||||
|
||||
{ TTestCLI_Precompile }
|
||||
{ TCustomTestCLI_Precompile }
|
||||
|
||||
TTestCLI_Precompile = class(TCustomTestCLI)
|
||||
TCustomTestCLI_Precompile = class(TCustomTestCLI)
|
||||
private
|
||||
FFormat: TPas2JSPrecompileFormat;
|
||||
protected
|
||||
procedure CheckPrecompile(MainFile, UnitPaths: string;
|
||||
SharedParams: TStringList = nil;
|
||||
FirstRunParams: TStringList = nil;
|
||||
SecondRunParams: TStringList = nil);
|
||||
public
|
||||
constructor Create; override;
|
||||
property Format: TPas2JSPrecompileFormat read FFormat write FFormat;
|
||||
end;
|
||||
|
||||
{ TTestCLI_Precompile }
|
||||
|
||||
TTestCLI_Precompile = class(TCustomTestCLI_Precompile)
|
||||
published
|
||||
procedure TestPCU_EmptyUnit;
|
||||
procedure TestPCU_ParamNS;
|
||||
procedure TestPCU_Overloads;
|
||||
procedure TestPCU_UnitCycle;
|
||||
end;
|
||||
|
||||
@ -56,9 +67,9 @@ begin
|
||||
for i:=Low(Lines) to High(Lines) do Result.Add(Lines[i]);
|
||||
end;
|
||||
|
||||
{ TTestCLI_Precompile }
|
||||
{ TCustomTestCLI_Precompile }
|
||||
|
||||
procedure TTestCLI_Precompile.CheckPrecompile(MainFile, UnitPaths: string;
|
||||
procedure TCustomTestCLI_Precompile.CheckPrecompile(MainFile, UnitPaths: string;
|
||||
SharedParams: TStringList; FirstRunParams: TStringList;
|
||||
SecondRunParams: TStringList);
|
||||
var
|
||||
@ -77,8 +88,8 @@ begin
|
||||
Params.Assign(SharedParams);
|
||||
if FirstRunParams<>nil then
|
||||
Params.AddStrings(FirstRunParams);
|
||||
Compile([MainFile,'-Jc','-Fu'+UnitPaths,'-JUpcu','-FU'+UnitOutputDir]);
|
||||
AssertFileExists('units/system.pcu');
|
||||
Compile([MainFile,'-Jc','-Fu'+UnitPaths,'-JU'+Format.Ext,'-FU'+UnitOutputDir]);
|
||||
AssertFileExists('units/system.'+Format.Ext);
|
||||
JSFilename:=UnitOutputDir+PathDelim+ExtractFilenameOnly(MainFile)+'.js';
|
||||
AssertFileExists(JSFilename);
|
||||
JSFile:=FindFile(JSFilename);
|
||||
@ -108,6 +119,14 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
constructor TCustomTestCLI_Precompile.Create;
|
||||
begin
|
||||
inherited Create;
|
||||
FFormat:=PrecompileFormats.FindExt('pcu');
|
||||
end;
|
||||
|
||||
{ TTestCLI_Precompile }
|
||||
|
||||
procedure TTestCLI_Precompile.TestPCU_EmptyUnit;
|
||||
begin
|
||||
AddUnit('src/system.pp',[''],['']);
|
||||
@ -129,6 +148,43 @@ begin
|
||||
CheckPrecompile('test1.pas','src',LinesToList(['-NSfoo']));
|
||||
end;
|
||||
|
||||
procedure TTestCLI_Precompile.TestPCU_Overloads;
|
||||
begin
|
||||
AddUnit('src/system.pp',['type integer = longint;'],['']);
|
||||
AddUnit('src/unit1.pp',
|
||||
['var i: integer;',
|
||||
'procedure DoIt(j: integer); overload;',
|
||||
'procedure DoIt(b: boolean);'],
|
||||
['procedure DoIt(j: integer);',
|
||||
'begin',
|
||||
' i:=j;',
|
||||
'end;',
|
||||
'procedure DoIt(b: boolean);',
|
||||
'begin',
|
||||
' i:=3;',
|
||||
'end;']);
|
||||
AddUnit('src/unit2.pp',
|
||||
['uses unit1;',
|
||||
'procedure DoIt(s: string); overload;'],
|
||||
['procedure DoIt(s: string);',
|
||||
'begin',
|
||||
' unit1.i:=j;',
|
||||
'end;']);
|
||||
AddFile('test1.pas',[
|
||||
'uses unit1;',
|
||||
'procedure DoIt(d: double); overload;',
|
||||
'begin',
|
||||
' unit1.i:=j;',
|
||||
'end;',
|
||||
'begin',
|
||||
' DoIt(3);',
|
||||
' DoIt(''abc'');',
|
||||
' Do1(true);',
|
||||
' Do1(3.3);',
|
||||
'end.']);
|
||||
CheckPrecompile('test1.pas','src');
|
||||
end;
|
||||
|
||||
procedure TTestCLI_Precompile.TestPCU_UnitCycle;
|
||||
begin
|
||||
AddUnit('src/system.pp',['type integer = longint;'],['']);
|
||||
|
||||
Loading…
Reference in New Issue
Block a user