paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-14 10:49:09 +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 AddMember(S : String);
Procedure ParseClass; Procedure ParseClass;
Procedure ParseClassFail(Msg: string; MsgNumber: integer); Procedure ParseClassFail(Msg: string; MsgNumber: integer);
Procedure DoParseClass(FromSpecial : Boolean = False); Procedure DoParseClass(FromSpecial : Boolean = False; SkipTests : Boolean = False);
procedure SetUp; override; procedure SetUp; override;
procedure TearDown; override; procedure TearDown; override;
procedure DefaultMethod; procedure DefaultMethod;
@ -71,6 +71,9 @@ type
procedure TestEmptyEndNoParent; procedure TestEmptyEndNoParent;
procedure TestEmptyObjC; procedure TestEmptyObjC;
procedure TestEmptyObjCCategory; procedure TestEmptyObjCCategory;
Procedure TestForward;
Procedure TestForwardAndDeclaration;
Procedure TestForwardAndDeclarationKeepForward;
Procedure TestOneInterface; Procedure TestOneInterface;
Procedure TestTwoInterfaces; Procedure TestTwoInterfaces;
procedure TestOneSpecializedClass; procedure TestOneSpecializedClass;
@ -380,14 +383,14 @@ begin
StartClass; StartClass;
FEnded:=True; FEnded:=True;
if (AEnd<>'') then if (AEnd<>'') then
FDecl.Add(' '+AEnd); FDecl.Add(AEnd);
end; end;
procedure TTestClassType.AddMember(S: String); procedure TTestClassType.AddMember(S: String);
begin begin
if Not FStarted then if Not FStarted then
StartClass; StartClass;
FDecl.Add(' '+S+';'); FDecl.Add(' '+S+';');
end; end;
procedure TTestClassType.ParseClass; procedure TTestClassType.ParseClass;
@ -413,9 +416,12 @@ begin
AssertEquals('Missing parser error {'+Msg+'} ('+IntToStr(MsgNumber)+')',true,ok); AssertEquals('Missing parser error {'+Msg+'} ('+IntToStr(MsgNumber)+')',true,ok);
end; end;
procedure TTestClassType.DoParseClass(FromSpecial: Boolean); procedure TTestClassType.DoParseClass(FromSpecial: Boolean; SkipTests : Boolean = False);
var var
AncestorType: TPasType; AncestorType: TPasType;
I : Integer;
S : String;
begin begin
EndClass; EndClass;
Add('Type'); Add('Type');
@ -424,8 +430,16 @@ begin
Add('// A comment'); Add('// A comment');
Engine.NeedComments:=True; Engine.NeedComments:=True;
end; 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; ParseDeclarations;
if SkipTests then
exit;
AssertEquals('One class type definition',1,Declarations.Classes.Count); AssertEquals('One class type definition',1,Declarations.Classes.Count);
AssertEquals('First declaration is type definition.',TPasClassType,TObject(Declarations.Classes[0]).ClassType); AssertEquals('First declaration is type definition.',TPasClassType,TObject(Declarations.Classes[0]).ClassType);
FClass:=TObject(Declarations.Classes[0]) as TPasClassType; FClass:=TObject(Declarations.Classes[0]) as TPasClassType;
@ -564,6 +578,45 @@ begin
AssertTrue('Is objectivec',TheClass.IsObjCClass); AssertTrue('Is objectivec',TheClass.IsObjCClass);
end; 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; procedure TTestClassType.TestOneInterface;
begin begin
StartClass('TObject','ISomething'); StartClass('TObject','ISomething');