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

fcl-passrc: generic tests

Browse Source 
git-svn-id: trunk@36221 -
This commit is contained in:
Mattias Gaertner 2017-05-15 15:14:02 +00:00
parent e38a0fa118
commit f36c74dfcd
1 changed files with 84 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

85
packages/fcl-passrc/tests/tcgenerics.pp
View File

@ -5,7 +5,7 @@ unit tcgenerics;
interface interface
uses uses
Classes, SysUtils, fpcunit, pastree, testregistry, tctypeparser; Classes, SysUtils, fpcunit, pastree, testregistry, pscanner, tctypeparser;
Type Type
@ -17,6 +17,10 @@ Type
Procedure TestRecordGenerics; Procedure TestRecordGenerics;
Procedure TestArrayGenerics; Procedure TestArrayGenerics;
Procedure TestSpecializationDelphi; Procedure TestSpecializationDelphi;
Procedure TestDeclarationDelphi;
Procedure TestDeclarationDelphiSpecialize;
Procedure TestMethodImplementation;
Procedure TestInlineSpecializationInProcedure;
Procedure TestSpecializeNested; Procedure TestSpecializeNested;
end; end;
@ -58,6 +62,85 @@ begin
ParseType('TFPGList<integer>',TPasSpecializeType,''); ParseType('TFPGList<integer>',TPasSpecializeType,'');
end; end;
procedure TTestGenerics.TestDeclarationDelphi;
Var
T : TPasClassType;
begin
Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches ;
Source.Add('Type');
Source.Add(' TSomeClass<T,T2> = Class(TObject)');
Source.Add(' b : T;');
Source.Add(' b2 : T2;');
Source.Add('end;');
ParseDeclarations;
AssertNotNull('have generic definition',Declarations.Classes);
AssertEquals('have generic definition',1,Declarations.Classes.Count);
AssertEquals('Pascal class',TPasClassType,TObject(Declarations.Classes[0]).ClassType);
T:=TPasClassType(Declarations.Classes[0]);
AssertNotNull('have generic templates',T.GenericTemplateTypes);
AssertEquals('2 template types',2,T.GenericTemplateTypes.Count);
AssertSame('Parent 0 is class',T,TPasElement(T.GenericTemplateTypes[0]).Parent);
AssertSame('Parent 1 is class',T,TPasElement(T.GenericTemplateTypes[1]).Parent);
end;
procedure TTestGenerics.TestDeclarationDelphiSpecialize;
Var
T : TPasClassType;
begin
Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches ;
Source.Add('Type');
Source.Add(' TSomeClass<T,T2> = Class(TSomeGeneric<Integer,Integer>)');
Source.Add(' b : T;');
Source.Add(' b2 : T2;');
Source.Add('end;');
ParseDeclarations;
AssertNotNull('have generic definition',Declarations.Classes);
AssertEquals('have generic definition',1,Declarations.Classes.Count);
AssertEquals('Pascal class',TPasClassType,TObject(Declarations.Classes[0]).ClassType);
T:=TPasClassType(Declarations.Classes[0]);
AssertEquals('Name is correct','TSomeClass',T.Name);
AssertNotNull('have generic templates',T.GenericTemplateTypes);
AssertEquals('2 template types',2,T.GenericTemplateTypes.Count);
AssertSame('Parent 0 is class',T,TPasElement(T.GenericTemplateTypes[0]).Parent);
AssertSame('Parent 1 is class',T,TPasElement(T.GenericTemplateTypes[1]).Parent);
end;
procedure TTestGenerics.TestMethodImplementation;
begin
With source do
begin
Add('unit afile;');
Add('{$MODE DELPHI}');
Add('interface');
Add('type');
Add(' TTest<T> = object');
Add(' procedure foo(v:T);');
Add(' end;');
Add('implementation');
Add('procedure TTest<T>.foo;');
Add('begin');
Add('end;');
end;
ParseModule;
end;
procedure TTestGenerics.TestInlineSpecializationInProcedure;
begin
With source do
begin
Add('unit afile;');
Add('{$MODE DELPHI}');
Add('interface');
Add('type');
Add(' TFoo=class');
Add(' procedure foo(var Node:TSomeGeneric<TBoundingBox>;const index:Integer);');
Add(' end;');
Add('implementation');
end;
ParseModule;
end;
procedure TTestGenerics.TestSpecializeNested; procedure TTestGenerics.TestSpecializeNested;
begin begin
Add([ Add([