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

* Fix bug #25720

Browse Source 
git-svn-id: trunk@26876 -
This commit is contained in:
michael 2014-02-25 10:09:27 +00:00
parent 48eacbae41
commit e28824465f
3 changed files with 121 additions and 75 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
packages/fcl-passrc/src/pparser.pp
View File

@ -3764,7 +3764,7 @@ begin
AType.Members.Add(t); AType.Members.Add(t);
// Writeln(CurtokenString,' ',TokenInfos[Curtoken]); // Writeln(CurtokenString,' ',TokenInfos[Curtoken]);
NextToken; NextToken;
Done:=Curtoken<>tkIdentifier; Done:=(Curtoken<>tkIdentifier) or CheckVisibility(CurtokenString,AVisibility);
if Done then if Done then
UngetToken; UngetToken;
Until Done; Until Done;
@ -3783,7 +3783,7 @@ begin
AType.Members.Add(C); AType.Members.Add(C);
// Writeln(CurtokenString,' ',TokenInfos[Curtoken]); // Writeln(CurtokenString,' ',TokenInfos[Curtoken]);
NextToken; NextToken;
Done:=Curtoken<>tkIdentifier; Done:=(Curtoken<>tkIdentifier) or CheckVisibility(CurtokenString,AVisibility);
if Done then if Done then
UngetToken; UngetToken;
Until Done; Until Done;

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

@ -74,6 +74,9 @@ type
Procedure TestTwoFieldsB; Procedure TestTwoFieldsB;
Procedure TestTwoVarFieldsB; Procedure TestTwoVarFieldsB;
Procedure TestTwoFieldsVisibility; Procedure TestTwoFieldsVisibility;
Procedure TestConstProtectedEnd;
Procedure TestTypeProtectedEnd;
Procedure TestVarProtectedEnd;
procedure TestHintFieldDeprecated; procedure TestHintFieldDeprecated;
procedure TestHintFieldPlatform; procedure TestHintFieldPlatform;
procedure TestHintFieldExperimental; procedure TestHintFieldExperimental;
@ -155,7 +158,7 @@ begin
Result:=TPasElement(TheClass.Members[AIndex]) Result:=TPasElement(TheClass.Members[AIndex])
end; end;
function TTestClassType.GetMM(AIndex : integer): TPasProcedure; function TTestClassType.GetMM(AIndex: Integer): TPasProcedure;
begin begin
AssertNotNull('Have member '+IntToStr(AIndex),Members[AIndex]); AssertNotNull('Have member '+IntToStr(AIndex),Members[AIndex]);
AssertEquals('Member is method '+IntToStr(AIndex),TPasProcedure,Members[Aindex].ClassType); AssertEquals('Member is method '+IntToStr(AIndex),TPasProcedure,Members[Aindex].ClassType);
@ -183,7 +186,7 @@ begin
Result:=TPasProperty(Members[1]); Result:=TPasProperty(Members[1]);
end; end;
function TTestClassType.GetT(Aindex :integer): TPasType; function TTestClassType.GetT(AIndex: Integer): TPasType;
begin begin
AssertNotNull('Have member '+IntToStr(AIndex),Members[AIndex]); AssertNotNull('Have member '+IntToStr(AIndex),Members[AIndex]);
if not (Members[AIndex] is TPasType) then if not (Members[AIndex] is TPasType) then
@ -206,7 +209,7 @@ begin
Result:=TPasConst(Members[AIndex]); Result:=TPasConst(Members[AIndex]);
end; end;
procedure TTestClassType.StartClass(AParent: String = 'TObject'; InterfaceList: String = ''); Procedure TTestClassType.StartClass(AParent: String; InterfaceList: String);
Var Var
S : String; S : String;
@ -224,7 +227,7 @@ begin
FParent:=AParent; FParent:=AParent;
end; end;
procedure TTestClassType.StartClassHelper(ForType: String; AParent: String); Procedure TTestClassType.StartClassHelper(ForType: String; AParent: String);
Var Var
S : String; S : String;
begin begin
@ -240,7 +243,7 @@ begin
FParent:=AParent; FParent:=AParent;
end; end;
procedure TTestClassType.StartInterface(AParent: String; UUID: String); Procedure TTestClassType.StartInterface(AParent: String; UUID: String);
Var Var
S : String; S : String;
begin begin
@ -254,7 +257,7 @@ begin
FParent:=AParent; FParent:=AParent;
end; end;
procedure TTestClassType.StartRecordHelper(ForType: String; AParent: String); Procedure TTestClassType.StartRecordHelper(ForType: String; AParent: String);
Var Var
S : String; S : String;
begin begin
@ -270,14 +273,14 @@ begin
FParent:=AParent; FParent:=AParent;
end; end;
procedure TTestClassType.StartVisibility(A: TPasMemberVisibility); Procedure TTestClassType.StartVisibility(A: TPasMemberVisibility);
begin begin
if not FStarted then if not FStarted then
StartClass; StartClass;
FDecl.Add(' '+VisibilityNames[A]); FDecl.Add(' '+VisibilityNames[A]);
end; end;
procedure TTestClassType.EndClass(AEnd: String); Procedure TTestClassType.EndClass(AEnd: String);
begin begin
if FEnded then exit; if FEnded then exit;
if not FStarted then if not FStarted then
@ -287,14 +290,14 @@ begin
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;
begin begin
EndClass; EndClass;
Add('Type'); Add('Type');
@ -333,7 +336,7 @@ begin
inherited TearDown; inherited TearDown;
end; end;
procedure TTestClassType.AssertVisibility(V: TPasMemberVisibility; Procedure TTestClassType.AssertVisibility(V: TPasMemberVisibility;
Member: TPasElement); Member: TPasElement);
begin begin
If Member=Nil then If Member=Nil then
@ -356,8 +359,9 @@ begin
AssertEquals('Member name ',AName,Member.Name) AssertEquals('Member name ',AName,Member.Name)
end; end;
procedure TTestClassType.AssertProperty(P: TPasProperty; AVisibility : TPasMemberVisibility;AName, ARead, AWrite, Procedure TTestClassType.AssertProperty(P: TPasProperty;
AStored,AImplements: String; AArgCount: Integer; ADefault, ANodefault: Boolean); AVisibility: TPasMemberVisibility; AName, ARead, AWrite, AStored,
AImplements: String; AArgCount: Integer; ADefault, ANodefault: Boolean);
begin begin
AssertEquals(P.Name+': Visibility',AVisibility,P.Visibility); AssertEquals(P.Name+': Visibility',AVisibility,P.Visibility);
Assertequals(P.Name+': No args',AArgCount,P.Args.Count); Assertequals(P.Name+': No args',AArgCount,P.Args.Count);
@ -397,7 +401,7 @@ begin
AssertEquals('No members',0,TheClass.Members.Count); AssertEquals('No members',0,TheClass.Members.Count);
end; end;
procedure TTestClassType.TestOneInterface; Procedure TTestClassType.TestOneInterface;
begin begin
StartClass('TObject','ISomething'); StartClass('TObject','ISomething');
ParseClass; ParseClass;
@ -407,7 +411,7 @@ begin
AssertEquals('Interface name','ISomething',TPasUnresolvedTypeRef(TheClass.Interfaces[0]).Name); AssertEquals('Interface name','ISomething',TPasUnresolvedTypeRef(TheClass.Interfaces[0]).Name);
end; end;
procedure TTestClassType.TestTwoInterfaces; Procedure TTestClassType.TestTwoInterfaces;
begin begin
StartClass('TObject','ISomething, ISomethingElse'); StartClass('TObject','ISomething, ISomethingElse');
ParseClass; ParseClass;
@ -420,7 +424,7 @@ begin
AssertEquals('Interface name','ISomethingElse',TPasUnresolvedTypeRef(TheClass.Interfaces[1]).Name); AssertEquals('Interface name','ISomethingElse',TPasUnresolvedTypeRef(TheClass.Interfaces[1]).Name);
end; end;
procedure TTestClassType.TestOneField; Procedure TTestClassType.TestOneField;
begin begin
AddMember('a : integer'); AddMember('a : integer');
ParseClass; ParseClass;
@ -429,7 +433,7 @@ begin
AssertVisibility; AssertVisibility;
end; end;
procedure TTestClassType.TestOneVarField; Procedure TTestClassType.TestOneVarField;
begin begin
StartVisibility(visPublished); StartVisibility(visPublished);
FDecl.Add('var'); FDecl.Add('var');
@ -440,7 +444,7 @@ begin
AssertVisibility(visPublished); AssertVisibility(visPublished);
end; end;
procedure TTestClassType.TestOneClassField; Procedure TTestClassType.TestOneClassField;
begin begin
StartVisibility(visPublished); StartVisibility(visPublished);
FDecl.Add('class var'); FDecl.Add('class var');
@ -453,7 +457,7 @@ begin
Fail('Field is not a class field'); Fail('Field is not a class field');
end; end;
procedure TTestClassType.TestOneFieldVisibility; Procedure TTestClassType.TestOneFieldVisibility;
begin begin
StartVisibility(visPublished); StartVisibility(visPublished);
AddMember('a : integer'); AddMember('a : integer');
@ -463,7 +467,7 @@ begin
AssertVisibility(visPublished); AssertVisibility(visPublished);
end; end;
procedure TTestClassType.TestOneFieldDeprecated; Procedure TTestClassType.TestOneFieldDeprecated;
begin begin
AddMember('a : integer deprecated'); AddMember('a : integer deprecated');
ParseClass; ParseClass;
@ -473,7 +477,7 @@ begin
AssertVisibility; AssertVisibility;
end; end;
procedure TTestClassType.TestTwoFields; Procedure TTestClassType.TestTwoFields;
begin begin
AddMember('a : integer'); AddMember('a : integer');
AddMember('b : integer'); AddMember('b : integer');
@ -488,7 +492,7 @@ begin
AssertVisibility(visDefault,Members[1]); AssertVisibility(visDefault,Members[1]);
end; end;
procedure TTestClassType.TestTwoFieldsB; Procedure TTestClassType.TestTwoFieldsB;
begin begin
AddMember('a,b : integer'); AddMember('a,b : integer');
ParseClass; ParseClass;
@ -502,7 +506,7 @@ begin
AssertVisibility(visDefault,Members[1]); AssertVisibility(visDefault,Members[1]);
end; end;
procedure TTestClassType.TestTwoVarFieldsB; Procedure TTestClassType.TestTwoVarFieldsB;
begin begin
StartVisibility(visPublic); StartVisibility(visPublic);
FDecl.Add('var'); FDecl.Add('var');
@ -518,7 +522,7 @@ begin
AssertVisibility(visPublic,Members[1]); AssertVisibility(visPublic,Members[1]);
end; end;
procedure TTestClassType.TestTwoFieldsVisibility; Procedure TTestClassType.TestTwoFieldsVisibility;
begin begin
StartVisibility(visPublic); StartVisibility(visPublic);
AddMember('a,b : integer'); AddMember('a,b : integer');
@ -533,6 +537,48 @@ begin
AssertVisibility(visPublic,Members[1]); AssertVisibility(visPublic,Members[1]);
end; end;
Procedure TTestClassType.TestConstProtectedEnd;
begin
// After bug report 25720
StartVisibility(visPrivate);
AddMember('fmy : Integer');
StartVisibility(visProtected);
AddMember('fmy : Integer');
FDecl.Add('protected const');
FDecl.Add('cconst = 10;');
StartVisibility(visProtected);
AddMember('I : Integer');
ParseClass;
end;
Procedure TTestClassType.TestTypeProtectedEnd;
begin
// After bug report 25720
StartVisibility(visPrivate);
AddMember('fmy : Integer');
StartVisibility(visProtected);
AddMember('fmy : Integer');
FDecl.Add('protected type');
FDecl.Add('mytype = integer;');
StartVisibility(visProtected);
AddMember('I : Integer');
ParseClass;
end;
Procedure TTestClassType.TestVarProtectedEnd;
begin
// After bug report 25720
StartVisibility(visPrivate);
AddMember('fmy : Integer');
StartVisibility(visProtected);
AddMember('fmy : Integer');
FDecl.Add('protected var');
FDecl.Add('mytype : integer;');
StartVisibility(visProtected);
AddMember('I : Integer');
ParseClass;
end;
procedure TTestClassType.TestHintFieldDeprecated; procedure TTestClassType.TestHintFieldDeprecated;
begin begin
AddMember('deprecated : integer'); AddMember('deprecated : integer');
@ -575,7 +621,7 @@ begin
AssertMemberName('unimplemented'); AssertMemberName('unimplemented');
end; end;
procedure TTestClassType.TestMethodSimple; Procedure TTestClassType.TestMethodSimple;
begin begin
AddMember('Procedure DoSomething'); AddMember('Procedure DoSomething');
ParseClass; ParseClass;
@ -589,7 +635,7 @@ begin
AssertEquals('No arguments',0,Method1.ProcType.Args.Count) AssertEquals('No arguments',0,Method1.ProcType.Args.Count)
end; end;
procedure TTestClassType.TestClassMethodSimple; Procedure TTestClassType.TestClassMethodSimple;
begin begin
AddMember('Class Procedure DoSomething'); AddMember('Class Procedure DoSomething');
ParseClass; ParseClass;
@ -603,7 +649,7 @@ begin
AssertEquals('No arguments',0,TPasClassProcedure(Members[0]).ProcType.Args.Count) AssertEquals('No arguments',0,TPasClassProcedure(Members[0]).ProcType.Args.Count)
end; end;
procedure TTestClassType.TestFunctionMethodSimple; Procedure TTestClassType.TestFunctionMethodSimple;
begin begin
AddMember('Function DoSomething : integer'); AddMember('Function DoSomething : integer');
ParseClass; ParseClass;
@ -617,7 +663,7 @@ begin
AssertEquals('No arguments',0,functionMethod1.ProcType.Args.Count) AssertEquals('No arguments',0,functionMethod1.ProcType.Args.Count)
end; end;
procedure TTestClassType.TestClassFunctionMethodSimple; Procedure TTestClassType.TestClassFunctionMethodSimple;
begin begin
AddMember('Class Function DoSomething : integer'); AddMember('Class Function DoSomething : integer');
ParseClass; ParseClass;
@ -643,12 +689,12 @@ begin
AssertEquals('Argument name','A',TPasVariable(Method1.ProcType.Args[0]).Name); AssertEquals('Argument name','A',TPasVariable(Method1.ProcType.Args[0]).Name);
end; end;
procedure TTestClassType.AssertParserError(Const Msg : String); Procedure TTestClassType.AssertParserError(Const Msg: String);
begin begin
AssertException(Msg,EParserError,@ParseClass) AssertException(Msg,EParserError,@ParseClass)
end; end;
procedure TTestClassType.TestMethodOneArg; Procedure TTestClassType.TestMethodOneArg;
begin begin
AddMember('Procedure DoSomething(A : Integer)'); AddMember('Procedure DoSomething(A : Integer)');
ParseClass; ParseClass;
@ -658,7 +704,7 @@ begin
AssertEquals('Default calling convention',ccDefault, Method1.ProcType.CallingConvention); AssertEquals('Default calling convention',ccDefault, Method1.ProcType.CallingConvention);
end; end;
procedure TTestClassType.TestMethodVirtual; Procedure TTestClassType.TestMethodVirtual;
begin begin
AddMember('Procedure DoSomething(A : Integer) virtual'); AddMember('Procedure DoSomething(A : Integer) virtual');
ParseClass; ParseClass;
@ -668,7 +714,7 @@ begin
AssertEquals('Default calling convention',ccDefault, Method1.ProcType.CallingConvention); AssertEquals('Default calling convention',ccDefault, Method1.ProcType.CallingConvention);
end; end;
procedure TTestClassType.TestMethodVirtualSemicolon; Procedure TTestClassType.TestMethodVirtualSemicolon;
begin begin
AddMember('Procedure DoSomething(A : Integer); virtual'); AddMember('Procedure DoSomething(A : Integer); virtual');
ParseClass; ParseClass;
@ -678,7 +724,7 @@ begin
AssertEquals('Default calling convention',ccDefault, Method1.ProcType.CallingConvention); AssertEquals('Default calling convention',ccDefault, Method1.ProcType.CallingConvention);
end; end;
procedure TTestClassType.TestMethodVirtualAbstract; Procedure TTestClassType.TestMethodVirtualAbstract;
begin begin
AddMember('Procedure DoSomething(A : Integer) virtual abstract'); AddMember('Procedure DoSomething(A : Integer) virtual abstract');
ParseClass; ParseClass;
@ -689,7 +735,7 @@ begin
end; end;
procedure TTestClassType.TestMethodOverride; Procedure TTestClassType.TestMethodOverride;
begin begin
AddMember('Procedure DoSomething(A : Integer) override'); AddMember('Procedure DoSomething(A : Integer) override');
ParseClass; ParseClass;
@ -729,7 +775,7 @@ begin
AssertEquals('Default calling convention',ccDefault, Method1.ProcType.CallingConvention); AssertEquals('Default calling convention',ccDefault, Method1.ProcType.CallingConvention);
end; end;
procedure TTestClassType.TestMethodVisibility; Procedure TTestClassType.TestMethodVisibility;
begin begin
StartVisibility(visPublic); StartVisibility(visPublic);
AddMember('Procedure DoSomething(A : Integer)'); AddMember('Procedure DoSomething(A : Integer)');
@ -740,7 +786,7 @@ begin
AssertEquals('Default calling convention',ccDefault, Method1.ProcType.CallingConvention); AssertEquals('Default calling convention',ccDefault, Method1.ProcType.CallingConvention);
end; end;
procedure TTestClassType.TestMethodSVisibility; Procedure TTestClassType.TestMethodSVisibility;
begin begin
AddMember('Procedure DoSomething(A : Integer)'); AddMember('Procedure DoSomething(A : Integer)');
StartVisibility(visPublic); StartVisibility(visPublic);
@ -758,7 +804,7 @@ begin
AssertEquals('Argument name','A',TPasVariable(Method2.ProcType.Args[0]).Name); AssertEquals('Argument name','A',TPasVariable(Method2.ProcType.Args[0]).Name);
end; end;
procedure TTestClassType.TestMethodOverloadVisibility; Procedure TTestClassType.TestMethodOverloadVisibility;
begin begin
AddMember('Procedure DoSomething(A : Integer)'); AddMember('Procedure DoSomething(A : Integer)');
StartVisibility(visPublic); StartVisibility(visPublic);
@ -769,7 +815,7 @@ begin
AssertEquals('Default visibility',visDefault,Member1.Visibility); AssertEquals('Default visibility',visDefault,Member1.Visibility);
end; end;
procedure TTestClassType.TestMethodHint; Procedure TTestClassType.TestMethodHint;
begin begin
AddMember('Procedure DoSomething(A : Integer) deprecated'); AddMember('Procedure DoSomething(A : Integer) deprecated');
ParseClass; ParseClass;
@ -781,7 +827,7 @@ begin
AssertEquals('Default calling convention',ccDefault, Method1.ProcType.CallingConvention); AssertEquals('Default calling convention',ccDefault, Method1.ProcType.CallingConvention);
end; end;
procedure TTestClassType.TestMethodVirtualHint; Procedure TTestClassType.TestMethodVirtualHint;
begin begin
AddMember('Procedure DoSomething(A : Integer) virtual; deprecated'); AddMember('Procedure DoSomething(A : Integer) virtual; deprecated');
ParseClass; ParseClass;
@ -793,7 +839,7 @@ begin
AssertEquals('Default calling convention',ccDefault, Method1.ProcType.CallingConvention); AssertEquals('Default calling convention',ccDefault, Method1.ProcType.CallingConvention);
end; end;
procedure TTestClassType.TestIntegerMessageMethod; Procedure TTestClassType.TestIntegerMessageMethod;
begin begin
AddMember('Procedure DoSomething(A : Integer) message 123'); AddMember('Procedure DoSomething(A : Integer) message 123');
ParseClass; ParseClass;
@ -804,7 +850,7 @@ begin
AssertEquals('Message name','123',Method1.MessageName); AssertEquals('Message name','123',Method1.MessageName);
end; end;
procedure TTestClassType.TestStringMessageMethod; Procedure TTestClassType.TestStringMessageMethod;
begin begin
AddMember('Procedure DoSomething(A : Integer) message ''aha'''); AddMember('Procedure DoSomething(A : Integer) message ''aha''');
ParseClass; ParseClass;
@ -815,7 +861,7 @@ begin
AssertEquals('Message name','''aha''',Method1.MessageName); AssertEquals('Message name','''aha''',Method1.MessageName);
end; end;
procedure TTestClassType.Test2Methods; Procedure TTestClassType.Test2Methods;
begin begin
AddMember('Procedure DoSomething(A : Integer) virtual'); AddMember('Procedure DoSomething(A : Integer) virtual');
AddMember('Procedure DoSomethingElse'); AddMember('Procedure DoSomethingElse');
@ -830,7 +876,7 @@ begin
AssertEquals('Default calling convention',ccDefault, TPasProcedure(Members[1]).ProcType.CallingConvention); AssertEquals('Default calling convention',ccDefault, TPasProcedure(Members[1]).ProcType.CallingConvention);
end; end;
procedure TTestClassType.Test2MethodsDifferentVisibility; Procedure TTestClassType.Test2MethodsDifferentVisibility;
begin begin
AddMember('Procedure DoSomething(A : Integer) virtual'); AddMember('Procedure DoSomething(A : Integer) virtual');
StartVisibility(visPublic); StartVisibility(visPublic);
@ -847,7 +893,7 @@ begin
end; end;
procedure TTestClassType.TestPropertyRedeclare; Procedure TTestClassType.TestPropertyRedeclare;
begin begin
StartVisibility(visPublished); StartVisibility(visPublished);
AddMember('Property Something'); AddMember('Property Something');
@ -860,7 +906,7 @@ begin
Assertequals('No default value','',Property1.DefaultValue); Assertequals('No default value','',Property1.DefaultValue);
end; end;
procedure TTestClassType.TestPropertyReadOnly; Procedure TTestClassType.TestPropertyReadOnly;
begin begin
StartVisibility(visPublished); StartVisibility(visPublished);
AddMember('Property Something : integer Read FSomething'); AddMember('Property Something : integer Read FSomething');
@ -875,7 +921,7 @@ begin
Assertequals('No default value','',Property1.DefaultValue); Assertequals('No default value','',Property1.DefaultValue);
end; end;
procedure TTestClassType.TestPropertyReadWrite; Procedure TTestClassType.TestPropertyReadWrite;
begin begin
StartVisibility(visPublished); StartVisibility(visPublished);
AddMember('Property Something : integer Read FSomething Write FSomething'); AddMember('Property Something : integer Read FSomething Write FSomething');
@ -890,7 +936,7 @@ begin
Assertequals('No default value','',Property1.DefaultValue); Assertequals('No default value','',Property1.DefaultValue);
end; end;
procedure TTestClassType.TestPropertyWriteOnly; Procedure TTestClassType.TestPropertyWriteOnly;
begin begin
StartVisibility(visPublished); StartVisibility(visPublished);
AddMember('Property Something : integer Write FSomething'); AddMember('Property Something : integer Write FSomething');
@ -905,7 +951,7 @@ begin
Assertequals('No default value','',Property1.DefaultValue); Assertequals('No default value','',Property1.DefaultValue);
end; end;
procedure TTestClassType.TestPropertyDefault; Procedure TTestClassType.TestPropertyDefault;
begin begin
StartVisibility(visPublished); StartVisibility(visPublished);
AddMember('Property Something : integer Read FSomething Write FSomething default 1'); AddMember('Property Something : integer Read FSomething Write FSomething default 1');
@ -920,7 +966,7 @@ begin
Assertequals('Default value','1',Property1.DefaultValue); Assertequals('Default value','1',Property1.DefaultValue);
end; end;
procedure TTestClassType.TestPropertyNoDefault; Procedure TTestClassType.TestPropertyNoDefault;
begin begin
StartVisibility(visPublished); StartVisibility(visPublished);
AddMember('Property Something : integer Read FSomething Write FSomething nodefault'); AddMember('Property Something : integer Read FSomething Write FSomething nodefault');
@ -935,7 +981,7 @@ begin
Assertequals('No Default value','',Property1.DefaultValue); Assertequals('No Default value','',Property1.DefaultValue);
end; end;
procedure TTestClassType.TestPropertyIndex; Procedure TTestClassType.TestPropertyIndex;
begin begin
StartVisibility(visPublished); StartVisibility(visPublished);
AddMember('Property Something : integer Index 2 Read GetF Write SetF'); AddMember('Property Something : integer Index 2 Read GetF Write SetF');
@ -950,7 +996,7 @@ begin
Assertequals('No Default value','',Property1.DefaultValue); Assertequals('No Default value','',Property1.DefaultValue);
end; end;
procedure TTestClassType.TestPropertyStored; Procedure TTestClassType.TestPropertyStored;
begin begin
StartVisibility(visPublished); StartVisibility(visPublished);
AddMember('Property Something : integer Read GetF Write SetF Stored CheckStored'); AddMember('Property Something : integer Read GetF Write SetF Stored CheckStored');
@ -965,7 +1011,7 @@ begin
Assertequals('No Default value','',Property1.DefaultValue); Assertequals('No Default value','',Property1.DefaultValue);
end; end;
procedure TTestClassType.TestPropertyStoredFalse; Procedure TTestClassType.TestPropertyStoredFalse;
begin begin
StartVisibility(visPublished); StartVisibility(visPublished);
AddMember('Property Something : integer Read GetF Write SetF Stored False'); AddMember('Property Something : integer Read GetF Write SetF Stored False');
@ -980,7 +1026,7 @@ begin
Assertequals('No Default value','',Property1.DefaultValue); Assertequals('No Default value','',Property1.DefaultValue);
end; end;
procedure TTestClassType.TestPropertyFullyQualifiedType; Procedure TTestClassType.TestPropertyFullyQualifiedType;
begin begin
StartVisibility(visPublished); StartVisibility(visPublished);
AddMember('Property Something : unita.typeb Read FSomething'); AddMember('Property Something : unita.typeb Read FSomething');
@ -995,7 +1041,7 @@ begin
Assertequals('No default value','',Property1.DefaultValue); Assertequals('No default value','',Property1.DefaultValue);
end; end;
procedure TTestClassType.TestPropertyArrayReadOnly; Procedure TTestClassType.TestPropertyArrayReadOnly;
Var Var
A : TPasArgument; A : TPasArgument;
begin begin
@ -1019,7 +1065,7 @@ begin
AssertEquals('Argument class type name','Integer',A.ArgType.Name); AssertEquals('Argument class type name','Integer',A.ArgType.Name);
end; end;
procedure TTestClassType.TestPropertyArrayReadWrite; Procedure TTestClassType.TestPropertyArrayReadWrite;
Var Var
A : TPasArgument; A : TPasArgument;
begin begin
@ -1043,7 +1089,7 @@ begin
AssertEquals('Argument class type name','Integer',A.ArgType.Name); AssertEquals('Argument class type name','Integer',A.ArgType.Name);
end; end;
procedure TTestClassType.TestPropertyArrayReadOnlyDefault; Procedure TTestClassType.TestPropertyArrayReadOnlyDefault;
Var Var
A : TPasArgument; A : TPasArgument;
@ -1068,7 +1114,7 @@ begin
AssertEquals('Argument class type name','Integer',A.ArgType.Name); AssertEquals('Argument class type name','Integer',A.ArgType.Name);
end; end;
procedure TTestClassType.TestPropertyArrayReadWriteDefault; Procedure TTestClassType.TestPropertyArrayReadWriteDefault;
Var Var
A : TPasArgument; A : TPasArgument;
begin begin
@ -1092,7 +1138,7 @@ begin
AssertEquals('Argument class type name','Integer',A.ArgType.Name); AssertEquals('Argument class type name','Integer',A.ArgType.Name);
end; end;
procedure TTestClassType.TestPropertyArrayMultiDimReadOnly; Procedure TTestClassType.TestPropertyArrayMultiDimReadOnly;
Var Var
A : TPasArgument; A : TPasArgument;
begin begin
@ -1124,7 +1170,7 @@ begin
AssertEquals('Argument 2 class type name','Integer',A.ArgType.Name); AssertEquals('Argument 2 class type name','Integer',A.ArgType.Name);
end; end;
procedure TTestClassType.TestPropertyImplements; Procedure TTestClassType.TestPropertyImplements;
begin begin
StartVisibility(visPublished); StartVisibility(visPublished);
AddMember('Property Something : AInterface Read FSomething Implements ISomeInterface'); AddMember('Property Something : AInterface Read FSomething Implements ISomeInterface');
@ -1140,7 +1186,7 @@ begin
end; end;
procedure TTestClassType.TestPropertyImplementsFullyQualifiedName; Procedure TTestClassType.TestPropertyImplementsFullyQualifiedName;
begin begin
StartVisibility(visPublished); StartVisibility(visPublished);
AddMember('Property Something : AInterface Read FSomething Implements UnitB.ISomeInterface'); AddMember('Property Something : AInterface Read FSomething Implements UnitB.ISomeInterface');
@ -1155,7 +1201,7 @@ begin
Assertequals('Default value','',Property1.DefaultValue); Assertequals('Default value','',Property1.DefaultValue);
end; end;
procedure TTestClassType.TestPropertyReadFromRecordField; Procedure TTestClassType.TestPropertyReadFromRecordField;
begin begin
StartVisibility(visPublished); StartVisibility(visPublished);
AddMember('Property Something : Integer Read FPoint.X'); AddMember('Property Something : Integer Read FPoint.X');
@ -1185,7 +1231,7 @@ begin
Assertequals('Default value','',Property1.DefaultValue); Assertequals('Default value','',Property1.DefaultValue);
end; end;
procedure TTestClassType.TestLocalSimpleType; Procedure TTestClassType.TestLocalSimpleType;
begin begin
StartVisibility(visPublic); StartVisibility(visPublic);
FDecl.add('Type'); FDecl.add('Type');
@ -1200,7 +1246,7 @@ begin
AssertEquals('method name','Something', Method2.Name); AssertEquals('method name','Something', Method2.Name);
end; end;
procedure TTestClassType.TestLocalSimpleTypes; Procedure TTestClassType.TestLocalSimpleTypes;
begin begin
StartVisibility(visPublic); StartVisibility(visPublic);
FDecl.add('Type'); FDecl.add('Type');
@ -1220,7 +1266,7 @@ begin
AssertEquals('method name','Something', Method3.Name); AssertEquals('method name','Something', Method3.Name);
end; end;
procedure TTestClassType.TestLocalSimpleConst; Procedure TTestClassType.TestLocalSimpleConst;
begin begin
StartVisibility(visPublic); StartVisibility(visPublic);
FDecl.add('Const'); FDecl.add('Const');
@ -1236,7 +1282,7 @@ begin
AssertEquals('method name','Something', Method2.Name); AssertEquals('method name','Something', Method2.Name);
end; end;
procedure TTestClassType.TestLocalSimpleConsts; Procedure TTestClassType.TestLocalSimpleConsts;
begin begin
StartVisibility(visPublic); StartVisibility(visPublic);
FDecl.add('Const'); FDecl.add('Const');

16
packages/fcl-passrc/tests/testpassrc.lpi
View File

@ -1,8 +1,13 @@
<?xml version="1.0"?> <?xml version="1.0" encoding="UTF-8"?>
<CONFIG> <CONFIG>
<ProjectOptions> <ProjectOptions>
<Version Value="9"/> <Version Value="9"/>
<General> <General>
<Flags>
<SaveOnlyProjectUnits Value="True"/>
<SaveJumpHistory Value="False"/>
<SaveFoldState Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/> <SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/> <MainUnit Value="0"/>
<UseAppBundle Value="False"/> <UseAppBundle Value="False"/>
@ -25,8 +30,8 @@
<RunParams> <RunParams>
<local> <local>
<FormatVersion Value="1"/> <FormatVersion Value="1"/>
<CommandLineParams Value="--suite=TTestTypeParser"/> <CommandLineParams Value="--suite=TTestClassType.TestConstProtected"/>
<LaunchingApplication Use="True" PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> <LaunchingApplication Use="True"/>
</local> </local>
</RunParams> </RunParams>
<RequiredPackages Count="2"> <RequiredPackages Count="2">
@ -105,11 +110,6 @@
<SearchPaths> <SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/> <IncludeFiles Value="$(ProjOutDir)"/>
</SearchPaths> </SearchPaths>
<Linking>
<Debugging>
<UseHeaptrc Value="True"/>
</Debugging>
</Linking>
<Other> <Other>
<CompilerMessages> <CompilerMessages>
<UseMsgFile Value="True"/> <UseMsgFile Value="True"/>