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

* Test for po_keepclassforward

Browse Source
This commit is contained in:
Michaël Van Canneyt 2021-11-19 09:17:04 +01:00
parent 14f62b06d2
commit f1cb5e678c
1 changed files with 58 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

63
packages/fcl-passrc/tests/tcclasstype.pas
View File

@ -40,7 +40,7 @@ type
Procedure AddMember(S : String);
Procedure ParseClass;
Procedure ParseClassFail(Msg: string; MsgNumber: integer);
Procedure DoParseClass(FromSpecial : Boolean = False);
Procedure DoParseClass(FromSpecial : Boolean = False; SkipTests : Boolean = False);
procedure SetUp; override;
procedure TearDown; override;
procedure DefaultMethod;
@ -71,6 +71,9 @@ type
procedure TestEmptyEndNoParent;
procedure TestEmptyObjC;
procedure TestEmptyObjCCategory;
Procedure TestForward;
Procedure TestForwardAndDeclaration;
Procedure TestForwardAndDeclarationKeepForward;
Procedure TestOneInterface;
Procedure TestTwoInterfaces;
procedure TestOneSpecializedClass;
@ -380,14 +383,14 @@ begin
StartClass;
FEnded:=True;
if (AEnd<>'') then
FDecl.Add(' '+AEnd);
FDecl.Add(AEnd);
end;
procedure TTestClassType.AddMember(S: String);
begin
if Not FStarted then
StartClass;
FDecl.Add(' '+S+';');
FDecl.Add(' '+S+';');
end;
procedure TTestClassType.ParseClass;
@ -413,9 +416,12 @@ begin
AssertEquals('Missing parser error {'+Msg+'} ('+IntToStr(MsgNumber)+')',true,ok);
end;
procedure TTestClassType.DoParseClass(FromSpecial: Boolean);
procedure TTestClassType.DoParseClass(FromSpecial: Boolean; SkipTests : Boolean = False);
var
AncestorType: TPasType;
I : Integer;
S : String;
begin
EndClass;
Add('Type');
@ -424,8 +430,16 @@ begin
Add('// A comment');
Engine.NeedComments:=True;
end;
Add(' '+TrimRight(FDecl.Text)+';');
For I:=0 to FDecl.Count-1 do
begin
S:=TrimRight(FDecl[i]);
if I=FDecl.Count-1 then
S:=S+';';
Add(' '+S);
end;
ParseDeclarations;
if SkipTests then
exit;
AssertEquals('One class type definition',1,Declarations.Classes.Count);
AssertEquals('First declaration is type definition.',TPasClassType,TObject(Declarations.Classes[0]).ClassType);
FClass:=TObject(Declarations.Classes[0]) as TPasClassType;
@ -564,6 +578,45 @@ begin
AssertTrue('Is objectivec',TheClass.IsObjCClass);
end;
procedure TTestClassType.TestForward;
begin
FStarted:=True;
FEnded:=True;
FDecl.Add('TMyClass = Class');
ParseClass;
end;
procedure TTestClassType.TestForwardAndDeclaration;
begin
FStarted:=True;
FEnded:=True;
FDecl.Add('TMyClass = Class;');
FDecl.Add('');
FDecl.Add('TMyClass = Class (TObject) a : Integer; end');
ParseClass;
end;
procedure TTestClassType.TestForwardAndDeclarationKeepForward;
begin
FStarted:=True;
FEnded:=True;
Parser.Options:=Parser.Options+[po_KeepClassForward];
FDecl.Add('TMyClass = Class;');
FDecl.Add('');
FDecl.Add('TMyClass = Class (TObject) a : Integer; end');
DoParseClass(False,True);
AssertEquals('Declaration types count ',2,Declarations.Types.Count);
AssertEquals('First declaration is type definition.',TPasClassType,TObject(Declarations.Types[0]).ClassType);
FClass:=TObject(Declarations.Types[0]) as TPasClassType;
AssertTrue('1st type is Forward class',FClass.IsForward);
AssertEquals('Second declaration is type definition.',TPasClassType,TObject(Declarations.Types[1]).ClassType);
FClass:=TObject(Declarations.Types[1]) as TPasClassType;
AssertFalse('2nd type is not Forward class',FClass.IsForward);
AssertEquals('2nd type has fields',1,FClass.Members.Count);
TheType:=FClass; // So assertcomment can get to it
end;
procedure TTestClassType.TestOneInterface;
begin
StartClass('TObject','ISomething');