From f36c74dfcda96d17de7406744bcec0f8b8cd819e Mon Sep 17 00:00:00 2001 From: Mattias Gaertner Date: Mon, 15 May 2017 15:14:02 +0000 Subject: [PATCH] fcl-passrc: generic tests git-svn-id: trunk@36221 - --- packages/fcl-passrc/tests/tcgenerics.pp | 85 ++++++++++++++++++++++++- 1 file changed, 84 insertions(+), 1 deletion(-) diff --git a/packages/fcl-passrc/tests/tcgenerics.pp b/packages/fcl-passrc/tests/tcgenerics.pp index d5c969b133..7b7220ff91 100644 --- a/packages/fcl-passrc/tests/tcgenerics.pp +++ b/packages/fcl-passrc/tests/tcgenerics.pp @@ -5,7 +5,7 @@ unit tcgenerics; interface uses - Classes, SysUtils, fpcunit, pastree, testregistry, tctypeparser; + Classes, SysUtils, fpcunit, pastree, testregistry, pscanner, tctypeparser; Type @@ -17,6 +17,10 @@ Type Procedure TestRecordGenerics; Procedure TestArrayGenerics; Procedure TestSpecializationDelphi; + Procedure TestDeclarationDelphi; + Procedure TestDeclarationDelphiSpecialize; + Procedure TestMethodImplementation; + Procedure TestInlineSpecializationInProcedure; Procedure TestSpecializeNested; end; @@ -58,6 +62,85 @@ begin ParseType('TFPGList',TPasSpecializeType,''); end; +procedure TTestGenerics.TestDeclarationDelphi; +Var + T : TPasClassType; +begin + Scanner.CurrentModeSwitches:=[msDelphi]+Scanner.CurrentModeSwitches ; + Source.Add('Type'); + Source.Add(' TSomeClass = 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 = Class(TSomeGeneric)'); + 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 = object'); + Add(' procedure foo(v:T);'); + Add(' end;'); + Add('implementation'); + Add('procedure TTest.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;const index:Integer);'); + Add(' end;'); + Add('implementation'); + end; + ParseModule; +end; + procedure TTestGenerics.TestSpecializeNested; begin Add([