mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-28 10:52:40 +02:00
729 lines
19 KiB
ObjectPascal
729 lines
19 KiB
ObjectPascal
{
|
|
This file is part of the Free Component Library (FCL)
|
|
Copyright (c) 2018 by Michael Van Canneyt
|
|
|
|
Unit tests for Pascal-to-Javascript converter class.
|
|
|
|
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.
|
|
|
|
**********************************************************************
|
|
|
|
Examples:
|
|
./testpas2js --suite=TTestCLI_Precompile
|
|
./testpas2js --suite=TTestModule.TestEmptyUnit
|
|
}
|
|
unit TCPrecompile;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, fpcunit, testregistry, Pas2jsFileUtils, Pas2JsFiler,
|
|
Pas2jsCompiler, Pas2JSUtils, TCUnitSearch, TCModules;
|
|
|
|
type
|
|
|
|
{ TCustomTestCLI_Precompile }
|
|
|
|
TCustomTestCLI_Precompile = class(TCustomTestCLI)
|
|
private
|
|
FPCUFormat: TPas2JSPrecompileFormat;
|
|
FUnitOutputDir: string;
|
|
protected
|
|
procedure SetUp; override;
|
|
procedure CheckPrecompile(MainFile, UnitPaths: string;
|
|
SharedParams: TStringList = nil;
|
|
FirstRunParams: TStringList = nil;
|
|
SecondRunParams: TStringList = nil; ExpExitCode: integer = 0);
|
|
function GetJSFilename(ModuleName: string): string; virtual;
|
|
public
|
|
constructor Create; override;
|
|
property PCUFormat: TPas2JSPrecompileFormat read FPCUFormat write FPCUFormat;
|
|
property UnitOutputDir: string read FUnitOutputDir write FUnitOutputDir;
|
|
end;
|
|
|
|
{ TTestCLI_Precompile }
|
|
|
|
TTestCLI_Precompile = class(TCustomTestCLI_Precompile)
|
|
published
|
|
procedure TestPCU_EmptyUnit;
|
|
procedure TestPCU_UnitWithoutImplementation;
|
|
procedure TestPCU_UTF8BOM;
|
|
procedure TestPCU_ParamNS;
|
|
procedure TestPCU_Overloads;
|
|
procedure TestPCU_Overloads_MDelphi_ModeObjFPC;
|
|
procedure TestPCU_UnitCycle;
|
|
procedure TestPCU_Class_Forward;
|
|
procedure TestPCU_Class_Constructor;
|
|
procedure TestPCU_Class_ClassConstructor;
|
|
procedure TestPCU_ClassInterface;
|
|
procedure TestPCU_EnumNames;
|
|
procedure TestPCU_Namespace;
|
|
procedure TestPCU_CheckVersionMain;
|
|
procedure TestPCU_CheckVersionMain2;
|
|
procedure TestPCU_CheckVersionSystem;
|
|
procedure TestPCU_RecordGeneric_TValueInference; // ToDo
|
|
end;
|
|
|
|
function LinesToList(const Lines: array of string): TStringList;
|
|
|
|
implementation
|
|
|
|
function LinesToList(const Lines: array of string): TStringList;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
Result:=TStringList.Create;
|
|
for i:=Low(Lines) to High(Lines) do Result.Add(Lines[i]);
|
|
end;
|
|
|
|
{ TCustomTestCLI_Precompile }
|
|
|
|
procedure TCustomTestCLI_Precompile.SetUp;
|
|
begin
|
|
inherited SetUp;
|
|
UnitOutputDir:='units';
|
|
end;
|
|
|
|
procedure TCustomTestCLI_Precompile.CheckPrecompile(MainFile,
|
|
UnitPaths: string; SharedParams: TStringList; FirstRunParams: TStringList;
|
|
SecondRunParams: TStringList; ExpExitCode: integer);
|
|
var
|
|
JSFilename, OrigSrc, NewSrc, s: String;
|
|
JSFile: TCLIFile;
|
|
begin
|
|
try
|
|
AddDir(UnitOutputDir);
|
|
// compile, create .pcu files
|
|
{$IFDEF VerbosePCUFiler}
|
|
writeln('TTestCLI_Precompile.CheckPrecompile create pcu files=========================');
|
|
{$ENDIF}
|
|
Params.Clear;
|
|
Params.Add('-Jminclude');
|
|
Params.Add('-Jc');
|
|
if SharedParams<>nil then
|
|
Params.AddStrings(SharedParams);
|
|
if FirstRunParams<>nil then
|
|
Params.AddStrings(FirstRunParams);
|
|
Compile([MainFile,'-Fu'+UnitPaths,'-JU'+PCUFormat.Ext,'-FU'+UnitOutputDir]);
|
|
AssertFileExists(UnitOutputDir+'/system.'+PCUFormat.Ext);
|
|
JSFilename:=GetJSFilename(MainFile);
|
|
AssertFileExists(JSFilename);
|
|
JSFile:=FindFile(JSFilename);
|
|
OrigSrc:=JSFile.Source;
|
|
// compile, using .pcu files
|
|
//for i:=0 to FileCount-1 do
|
|
// writeln('TCustomTestCLI_Precompile.CheckPrecompile ',i,' ',Files[i].Filename);
|
|
{$IFDEF VerbosePCUFiler}
|
|
writeln('TTestCLI_Precompile.CheckPrecompile compile using pcu files==================');
|
|
{$ENDIF}
|
|
JSFile.Source:='';
|
|
Compiler.Reset;
|
|
Params.Clear;
|
|
Params.Add('-Jminclude');
|
|
Params.Add('-Jc');
|
|
if SharedParams<>nil then
|
|
Params.AddStrings(SharedParams);
|
|
if SecondRunParams<>nil then
|
|
Params.AddStrings(SecondRunParams);
|
|
Compile([MainFile,'-FU'+UnitOutputDir],ExpExitCode);
|
|
if ExpExitCode=0 then
|
|
begin
|
|
NewSrc:=JSFile.Source;
|
|
//writeln('TCustomTestCLI_Precompile.CheckPrecompile ',NewSrc);
|
|
if not CheckSrcDiff(OrigSrc,NewSrc,s) then
|
|
begin
|
|
WriteSources;
|
|
writeln('TCustomTestCLI_Precompile.CheckPrecompile OrigSrc==================');
|
|
writeln(OrigSrc);
|
|
writeln('TCustomTestCLI_Precompile.CheckPrecompile NewSrc==================');
|
|
writeln(NewSrc);
|
|
Fail('test1.js: '+s);
|
|
end;
|
|
end;
|
|
finally
|
|
SharedParams.Free;
|
|
FirstRunParams.Free;
|
|
SecondRunParams.Free;
|
|
end;
|
|
end;
|
|
|
|
function TCustomTestCLI_Precompile.GetJSFilename(ModuleName: string): string;
|
|
begin
|
|
Result:=UnitOutputDir+PathDelim+ExtractFilenameOnly(ModuleName)+'.js';
|
|
end;
|
|
|
|
constructor TCustomTestCLI_Precompile.Create;
|
|
begin
|
|
inherited Create;
|
|
FPCUFormat:=PrecompileFormats[0];
|
|
end;
|
|
|
|
{ TTestCLI_Precompile }
|
|
|
|
procedure TTestCLI_Precompile.TestPCU_EmptyUnit;
|
|
begin
|
|
AddUnit('src/system.pp',[''],['']);
|
|
AddFile('test1.pas',[
|
|
'begin',
|
|
'end.']);
|
|
CheckPrecompile('test1.pas','src');
|
|
end;
|
|
|
|
procedure TTestCLI_Precompile.TestPCU_UnitWithoutImplementation;
|
|
begin
|
|
AddUnit('src/system.pp',[''],['']);
|
|
AddFile('src/unit1.pas',
|
|
'unit unit1;'+LineEnding
|
|
+'interface'+LineEnding
|
|
+'end.'+LineEnding);
|
|
AddFile('src/unit2.pas',
|
|
'unit unit2;'+LineEnding
|
|
+'interface'+LineEnding
|
|
+'uses unit1;'+LineEnding
|
|
+'end.'+LineEnding);
|
|
AddFile('test1.pas',[
|
|
'uses unit2;',
|
|
'begin',
|
|
'end.']);
|
|
CheckPrecompile('test1.pas','src');
|
|
end;
|
|
|
|
procedure TTestCLI_Precompile.TestPCU_UTF8BOM;
|
|
var
|
|
aFile: TCLIFile;
|
|
begin
|
|
aFile:=AddUnit('src/system.pp',
|
|
['var',
|
|
' s: string = ''aaaäö'';',
|
|
' s2: string = ''😊'';', // 1F60A
|
|
''],
|
|
['']);
|
|
aFile.Source:=UTF8BOM+aFile.Source;
|
|
aFile:=AddFile('test1.pas',[
|
|
'begin',
|
|
' s:=''ö😊'';',
|
|
'end.']);
|
|
aFile.Source:=UTF8BOM+aFile.Source;
|
|
CheckPrecompile('test1.pas','src');
|
|
end;
|
|
|
|
procedure TTestCLI_Precompile.TestPCU_ParamNS;
|
|
begin
|
|
AddUnit('src/system.pp',[''],['']);
|
|
AddUnit('src/foo.unit1.pp',['var i: longint;'],['']);
|
|
AddFile('test1.pas',[
|
|
'uses unit1;',
|
|
'begin',
|
|
' i:=3;',
|
|
'end.']);
|
|
CheckPrecompile('test1.pas','src',LinesToList(['-FNfoo']));
|
|
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:=length(s);',
|
|
'end;']);
|
|
AddFile('test1.pas',[
|
|
'uses unit1, unit2;',
|
|
'procedure DoIt(d: double); overload;',
|
|
'begin',
|
|
' unit1.i:=4;',
|
|
'end;',
|
|
'begin',
|
|
' DoIt(3);',
|
|
' DoIt(''abc'');',
|
|
' DoIt(true);',
|
|
' DoIt(3.3);',
|
|
'end.']);
|
|
CheckPrecompile('test1.pas','src');
|
|
end;
|
|
|
|
procedure TTestCLI_Precompile.TestPCU_Overloads_MDelphi_ModeObjFPC;
|
|
var
|
|
SharedParams: TStringList;
|
|
begin
|
|
AddUnit('src/system.pp',[
|
|
'type',
|
|
' integer = longint;',
|
|
' TDateTime = type double;'],
|
|
['']);
|
|
AddFile('src/unit1.pp',
|
|
LinesToStr([
|
|
'unit unit1;',
|
|
'{$mode objfpc}',
|
|
'interface',
|
|
'function DoIt(i: integer): TDateTime;', // no overload needed in ObjFPC
|
|
'function DoIt(i, j: integer): TDateTime;',
|
|
'implementation',
|
|
'function DoIt(i: integer): TDateTime;',
|
|
'begin',
|
|
' Result:=i;',
|
|
'end;',
|
|
'function DoIt(i, j: integer): TDateTime;',
|
|
'begin',
|
|
' Result:=i+j;',
|
|
'end;',
|
|
'end.']));
|
|
AddFile('test1.pas',[
|
|
'uses unit1;',
|
|
'var d: TDateTime;',
|
|
'begin',
|
|
' d:=DoIt(3);',
|
|
' d:=DoIt(4,5);',
|
|
'end.']);
|
|
SharedParams:=TStringList.Create;
|
|
SharedParams.Add('-MDelphi');
|
|
CheckPrecompile('test1.pas','src',SharedParams);
|
|
end;
|
|
|
|
procedure TTestCLI_Precompile.TestPCU_UnitCycle;
|
|
begin
|
|
AddUnit('src/system.pp',['type integer = longint;'],['']);
|
|
AddUnit('src/unit1.pp',
|
|
['var i: integer;',
|
|
'procedure Do1(j: integer);'],
|
|
['uses unit2;',
|
|
'procedure Do1(j: integer);',
|
|
'begin',
|
|
' Do2(j);',
|
|
'end;']);
|
|
AddUnit('src/unit2.pp',
|
|
['uses unit1;',
|
|
'procedure Do2(j: integer);'],
|
|
['procedure Do2(j: integer);',
|
|
'begin',
|
|
' unit1.i:=j;',
|
|
'end;']);
|
|
AddFile('test1.pas',[
|
|
'uses unit1;',
|
|
'begin',
|
|
' Do1(3);',
|
|
'end.']);
|
|
CheckPrecompile('test1.pas','src');
|
|
end;
|
|
|
|
procedure TTestCLI_Precompile.TestPCU_Class_Forward;
|
|
begin
|
|
AddUnit('src/system.pp',[
|
|
'type integer = longint;',
|
|
'procedure Writeln; varargs;'],
|
|
['procedure Writeln; begin end;']);
|
|
AddUnit('src/unit1.pp',
|
|
['type',
|
|
' TClass = class of TObject;',
|
|
' TBirdClass = class of TBird;',
|
|
' TObject = class',
|
|
' FBirdClass: TBirdClass;',
|
|
' constructor Create;',
|
|
' constructor Create(Id: integer);',
|
|
' property BirdClass: TBirdClass read FBirdClass;',
|
|
' end;',
|
|
' TBird = class',
|
|
' constructor Create(d: double); overload;',
|
|
' end;',
|
|
''],
|
|
['constructor TObject.Create; begin end;',
|
|
'constructor TObject.Create(Id: integer); begin end;',
|
|
'constructor TBird.Create(d: double); begin end;']);
|
|
AddFile('test1.pas',[
|
|
'uses unit1;',
|
|
'var',
|
|
' b: TBird;',
|
|
' c: TClass;',
|
|
'begin',
|
|
' c:=TObject;',
|
|
' c:=TBird;',
|
|
' c:=b.BirdClass;',
|
|
' b:=TBird.Create;',
|
|
' b:=TBird.Create(1);',
|
|
' b:=TBird.Create(3.3);',
|
|
'end.']);
|
|
CheckPrecompile('test1.pas','src');
|
|
end;
|
|
|
|
procedure TTestCLI_Precompile.TestPCU_Class_Constructor;
|
|
begin
|
|
AddUnit('src/system.pp',[
|
|
'type integer = longint;',
|
|
'procedure Writeln; varargs;'],
|
|
['procedure Writeln; begin end;']);
|
|
AddUnit('src/unit1.pp',[
|
|
'type',
|
|
' TObject = class',
|
|
' constructor Create;',
|
|
' end;',
|
|
' TBird = class',
|
|
' constructor Create; reintroduce;',
|
|
' end;',
|
|
' TCow = class',
|
|
' constructor Create; reintroduce;',
|
|
' end;',
|
|
''],[
|
|
'constructor TObject.Create; begin end;',
|
|
'constructor TBird.Create; begin end;',
|
|
'constructor TCow.Create; begin end;',
|
|
'']);
|
|
AddUnit('src/unit2.pp',[
|
|
'uses unit1;',
|
|
'procedure DoIt;',
|
|
''],[
|
|
'procedure DoIt;',
|
|
'begin',
|
|
' TBird.Create;',
|
|
' TCow.Create;',
|
|
'end;',
|
|
'']);
|
|
AddFile('test1.pas',[
|
|
'uses unit2;',
|
|
'begin',
|
|
' DoIt;',
|
|
'end.']);
|
|
CheckPrecompile('test1.pas','src');
|
|
end;
|
|
|
|
procedure TTestCLI_Precompile.TestPCU_Class_ClassConstructor;
|
|
begin
|
|
AddUnit('src/system.pp',[
|
|
'type integer = longint;',
|
|
'procedure Writeln; varargs;'],
|
|
['procedure Writeln; begin end;']);
|
|
AddUnit('src/unit1.pp',[
|
|
'type',
|
|
' TObject = class',
|
|
' constructor Create;',
|
|
' end;',
|
|
' TBird = class',
|
|
' class constructor InitBird;',
|
|
' end;',
|
|
''],[
|
|
'constructor TObject.Create; begin end;',
|
|
'class constructor TBird.InitBird;',
|
|
'begin',
|
|
' exit;',
|
|
'end;',
|
|
'']);
|
|
AddUnit('src/unit2.pp',[
|
|
'uses unit1;',
|
|
'procedure DoIt;',
|
|
''],[
|
|
'procedure DoIt;',
|
|
'begin',
|
|
' TBird.Create;',
|
|
'end;',
|
|
'']);
|
|
AddFile('test1.pas',[
|
|
'uses unit2;',
|
|
'begin',
|
|
' DoIt;',
|
|
'end.']);
|
|
CheckPrecompile('test1.pas','src');
|
|
end;
|
|
|
|
procedure TTestCLI_Precompile.TestPCU_ClassInterface;
|
|
begin
|
|
AddUnit('src/system.pp',[
|
|
'{$interfaces corba}',
|
|
'type',
|
|
' integer = longint;',
|
|
' IUnknown = interface',
|
|
' end;',
|
|
'procedure Writeln; varargs;'],
|
|
['procedure Writeln; begin end;']);
|
|
AddUnit('src/unit1.pp',[
|
|
'type',
|
|
' IIntf = interface',
|
|
' function GetItems(Index: longint): longint;',
|
|
' procedure SetItems(Index: longint; Value: longint);',
|
|
' property Items[Index: longint]: longint read GetItems write SetItems; default;',
|
|
' end;',
|
|
''],[
|
|
'']);
|
|
AddUnit('src/unit2.pp',[
|
|
'uses unit1;',
|
|
'type',
|
|
' IAlias = IIntf;',
|
|
' TObject = class end;',
|
|
' TBird = class(IIntf)',
|
|
' strict private',
|
|
' function IIntf.GetItems = FetchItems;',
|
|
' function FetchItems(Index: longint): longint; virtual; abstract;',
|
|
' procedure SetItems(Index: longint; Value: longint); virtual; abstract;',
|
|
' end;',
|
|
''],[
|
|
'']);
|
|
AddUnit('src/unit3.pp',[
|
|
'uses unit2;',
|
|
'type',
|
|
' TEagle = class(TBird)',
|
|
' function FetchItems(Index: longint): longint; override;',
|
|
' procedure SetItems(Index: longint; Value: longint); override;',
|
|
' end;',
|
|
' TFlying = class(IAlias)',
|
|
' strict private',
|
|
' FEagle: TEagle;',
|
|
' property Eagle: TEagle read FEagle implements IAlias;',
|
|
' public',
|
|
' constructor Create;',
|
|
' end;',
|
|
''],[
|
|
'function TEagle.FetchItems(Index: longint): longint; begin end;',
|
|
'procedure TEagle.SetItems(Index: longint; Value: longint); begin end;',
|
|
'constructor TFlying.Create;',
|
|
'begin',
|
|
' FEagle:=nil;',
|
|
'end;',
|
|
'']);
|
|
AddFile('test1.pas',[
|
|
'uses unit2, unit3;',
|
|
'type IAlias2 = IAlias;',
|
|
'var',
|
|
' f: TFlying;',
|
|
' i: IAlias2;',
|
|
'begin',
|
|
' f:=TFlying.Create;',
|
|
' i:=f;',
|
|
' i[2]:=i[3];',
|
|
'end.']);
|
|
CheckPrecompile('test1.pas','src');
|
|
end;
|
|
|
|
procedure TTestCLI_Precompile.TestPCU_EnumNames;
|
|
var
|
|
SharedParams: TStringList;
|
|
begin
|
|
AddUnit('src/system.pp',[
|
|
'type integer = longint;',
|
|
' TObject = class end;',
|
|
'procedure Writeln; varargs;'],
|
|
['procedure Writeln; begin end;']);
|
|
AddUnit('src/unit1.pp',
|
|
['type',
|
|
' TEnum = (red,green,blue);',
|
|
' TBird = class ',
|
|
' private',
|
|
' Color: TEnum;',
|
|
' public',
|
|
' procedure Fly;',
|
|
' procedure Run;',
|
|
' end;',
|
|
''],
|
|
['procedure TBird.Fly;',
|
|
'begin',
|
|
' Color:=blue;',
|
|
'end;',
|
|
'procedure TBird.Run;',
|
|
'begin',
|
|
' Color:=green;',
|
|
'end;']);
|
|
AddFile('test1.pas',[
|
|
'uses unit1;',
|
|
'var b: TBird;',
|
|
'begin',
|
|
' b.Fly();',
|
|
' b.Run();',
|
|
'end.']);
|
|
SharedParams:=TStringList.Create;
|
|
SharedParams.Add('-OoEnumNumbers-');
|
|
CheckPrecompile('test1.pas','src',SharedParams);
|
|
end;
|
|
|
|
procedure TTestCLI_Precompile.TestPCU_Namespace;
|
|
begin
|
|
AddUnit('src/system.pp',[
|
|
'type integer = longint;',
|
|
'procedure Writeln; varargs;'],
|
|
['procedure Writeln; begin end;']);
|
|
AddUnit('src/Web.Unit1.pp',[
|
|
'var i: integer;',
|
|
''],[
|
|
'']);
|
|
AddUnit('src/Unit2.pp',[
|
|
'uses WEB.uNit1;',
|
|
'procedure DoIt;',
|
|
''],[
|
|
'procedure DoIt;',
|
|
'begin',
|
|
' writeln(i);',
|
|
'end;',
|
|
'']);
|
|
AddFile('test1.pas',[
|
|
'uses unIT2;',
|
|
'begin',
|
|
' DoIt;',
|
|
'end.']);
|
|
CheckPrecompile('test1.pas','src');
|
|
AssertFileExists(UnitOutputDir+'/Unit2.'+PCUFormat.Ext);
|
|
AssertFileExists(UnitOutputDir+'/Web.Unit1.'+PCUFormat.Ext);
|
|
end;
|
|
|
|
procedure TTestCLI_Precompile.TestPCU_CheckVersionMain;
|
|
var
|
|
aFile: TCLIFile;
|
|
s, JSFilename, ExpectedSrc: string;
|
|
begin
|
|
AddUnit('src/system.pp',[
|
|
'type integer = longint;'],
|
|
['']);
|
|
AddFile('test1.pas',[
|
|
'begin',
|
|
'end.']);
|
|
CheckPrecompile('test1.pas','src',LinesToList(['-JoCheckVersion=Main','-Jm-','-Jc-']));
|
|
JSFilename:=GetJSFilename('test1.js');
|
|
aFile:=FindFile(JSFilename);
|
|
AssertNotNull('File not found '+JSFilename,aFile);
|
|
ExpectedSrc:=LinesToStr([
|
|
UTF8BOM+'rtl.module("program",["system"],function () {',
|
|
' "use strict";',
|
|
' var $mod = this;',
|
|
' $mod.$main = function () {',
|
|
' rtl.checkVersion('+IntToStr((VersionMajor*100+VersionMinor)*100+VersionRelease)+');',
|
|
' };',
|
|
'});',
|
|
'']);
|
|
if not CheckSrcDiff(ExpectedSrc,aFile.Source,s) then
|
|
Fail('TTestCLI_Precompile.TestPCU_CheckVersionMain src diff: '+s);
|
|
end;
|
|
|
|
procedure TTestCLI_Precompile.TestPCU_CheckVersionMain2;
|
|
var
|
|
aFile: TCLIFile;
|
|
s, JSFilename, ExpectedSrc: string;
|
|
begin
|
|
AddUnit('src/system.pp',[
|
|
'type integer = longint;',
|
|
'procedure Writeln; varargs;'],
|
|
['procedure Writeln; begin end;']);
|
|
AddFile('test1.pas',[
|
|
'begin',
|
|
' Writeln;',
|
|
'end.']);
|
|
CheckPrecompile('test1.pas','src',LinesToList(['-JoCheckVersion=Main','-Jm-','-Jc-']));
|
|
JSFilename:=GetJSFilename('test1.js');
|
|
aFile:=FindFile(JSFilename);
|
|
AssertNotNull('File not found '+JSFilename,aFile);
|
|
ExpectedSrc:=LinesToStr([
|
|
UTF8BOM+'rtl.module("program",["system"],function () {',
|
|
' "use strict";',
|
|
' var $mod = this;',
|
|
' $mod.$main = function () {',
|
|
' rtl.checkVersion('+IntToStr((VersionMajor*100+VersionMinor)*100+VersionRelease)+');',
|
|
' pas.system.Writeln();',
|
|
' };',
|
|
'});',
|
|
'']);
|
|
if not CheckSrcDiff(ExpectedSrc,aFile.Source,s) then
|
|
Fail('TTestCLI_Precompile.TestPCU_CheckVersionMain src diff: '+s);
|
|
end;
|
|
|
|
procedure TTestCLI_Precompile.TestPCU_CheckVersionSystem;
|
|
var
|
|
aFile: TCLIFile;
|
|
s, JSFilename, ExpectedSrc, VerStr: string;
|
|
begin
|
|
AddUnit('src/system.pp',[
|
|
'type integer = longint;'],
|
|
['']);
|
|
AddFile('test1.pas',[
|
|
'begin',
|
|
'end.']);
|
|
CheckPrecompile('test1.pas','src',LinesToList(['-JoCheckVersion=system','-Jm-','-Jc-']));
|
|
JSFilename:=GetJSFilename('system.js');
|
|
aFile:=FindFile(JSFilename);
|
|
AssertNotNull('File not found '+JSFilename,aFile);
|
|
writeln('TTestCLI_Precompile.TestPCU_CheckVersionMain ',aFile.Source);
|
|
VerStr:=IntToStr((VersionMajor*100+VersionMinor)*100+VersionRelease);
|
|
ExpectedSrc:=LinesToStr([
|
|
UTF8BOM+'rtl.module("system",[],function () {',
|
|
' "use strict";',
|
|
' rtl.checkVersion('+VerStr+');',
|
|
' var $mod = this;',
|
|
'});',
|
|
'']);
|
|
if not CheckSrcDiff(ExpectedSrc,aFile.Source,s) then
|
|
Fail('TTestCLI_Precompile.TestPCU_CheckVersionMain src diff: '+s);
|
|
end;
|
|
|
|
procedure TTestCLI_Precompile.TestPCU_RecordGeneric_TValueInference;
|
|
begin
|
|
exit;
|
|
|
|
AddUnit('src/system.pp',[
|
|
'type',
|
|
' integer = longint;',
|
|
' TObject = class',
|
|
' end;',
|
|
''],['']);
|
|
AddUnit('src/typinfo.pas',[
|
|
'{$modeswitch externalclass}',
|
|
'type',
|
|
' TTypeInfo = class external name ''rtl.tTypeInfo''',
|
|
' end;',
|
|
' TTypeInfoInteger = class external name ''rtl.tTypeInfoInteger''(TTypeInfo)',
|
|
' end;',
|
|
' PTypeInfo = Pointer;',
|
|
''],[
|
|
'']);
|
|
AddUnit('src/unit1.pas',[
|
|
'{$modeswitch AdvancedRecords}',
|
|
'uses typinfo;',
|
|
'type',
|
|
' TValue = record',
|
|
' private',
|
|
' FTypeInfo: TTypeInfo;',
|
|
' FData: JSValue;',
|
|
' public',
|
|
' generic class function From<T>(const Value: T): TValue; static;',
|
|
' class procedure Make(ABuffer: JSValue; ATypeInfo: PTypeInfo; var Result: TValue); overload; static;',
|
|
' end;',
|
|
''],[
|
|
'generic class function TValue.From<T>(const Value: T): TValue;',
|
|
'begin',
|
|
' if Value=3 then ;',
|
|
//' Make(Value, TypeInfo(T), Result);',
|
|
'end;',
|
|
'class procedure TValue.Make(ABuffer: JSValue; ATypeInfo: PTypeInfo; var Result: TValue);',
|
|
'begin',
|
|
//' Result.FData := ABuffer;',
|
|
//' Result.FTypeInfo := ATypeInfo;',
|
|
'end;',
|
|
'']);
|
|
AddFile('test1.pas',[
|
|
'{$mode Delphi}',
|
|
'uses unit1;',
|
|
'begin',
|
|
' TValue.From<longint>(1234);',
|
|
'end.']);
|
|
CheckPrecompile('test1.pas','src');
|
|
end;
|
|
|
|
Initialization
|
|
RegisterTests([TTestCLI_Precompile]);
|
|
RegisterPCUFormat;
|
|
end.
|
|
|