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

* Support Hints prior to variable initialization, properties in records

Browse Source 
git-svn-id: trunk@29556 -
This commit is contained in:
michael 2015-01-26 13:46:21 +00:00
parent 7bb0b187a4
commit 79e7ba678e
3 changed files with 48 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -2417,9 +2417,10 @@ begin
else
VarType := ParseComplexType(Parent);
Value:=Nil;
H:=CheckHint(Nil,False);
If Full then
GetVariableValueAndLocation(Parent,Value,Loc);
H:=CheckHint(Nil,Full);
H:=H+CheckHint(Nil,Full);
if full then
Mods:=GetVariableModifiers(varmods,alibname,aexpname)
else
@ -3619,12 +3620,21 @@ Var
v : TPasmemberVisibility;
Proc: TPasProcedure;
ProcType: TProcType;
Prop : TPasProperty;
begin
v:=visPublic;
while CurToken<>AEndToken do
begin
Case CurToken of
tkProperty:
begin
if Not AllowMethods then
ParseExc(SErrRecordMethodsNotAllowed);
ExpectToken(tkIdentifier);
Prop:=ParseProperty(ARec,CurtokenString,v);
Arec.Members.Add(Prop);
end;
tkProcedure,
tkFunction :
begin

22
packages/fcl-passrc/tests/tctypeparser.pas
View File

@ -161,6 +161,7 @@ type
procedure AssertField1(Hints: TPasMemberHints);
procedure AssertField2(Hints: TPasMemberHints);
procedure AssertMethod2(Hints: TPasMemberHints);
procedure AssertProperty2(Hints: TPasMemberHints);
procedure AssertVariant1(Hints: TPasMemberHints);
procedure AssertVariant1(Hints: TPasMemberHints; VariantLabels : Array of string);
procedure AssertVariant2(Hints: TPasMemberHints);
@ -232,6 +233,7 @@ type
Procedure TestTwoDeprecatedFieldsCombinedPlatform;
Procedure TestFieldAndMethod;
Procedure TestFieldAnd2Methods;
Procedure TestFieldAndProperty;
Procedure TestVisibilityAndMethods;
Procedure TestNested;
Procedure TestNestedDeprecated;
@ -1451,6 +1453,17 @@ begin
AssertTrue('Method hints match',P.Hints=Hints)
end;
procedure TTestRecordTypeParser.AssertProperty2(Hints: TPasMemberHints);
Var
P : TPasProperty;
begin
AssertEquals('Member 2 type',TPasProperty,TObject(TheRecord.Members[1]).ClassType);
P:=TPasProperty(TheRecord.Members[1]);
AssertEquals('Property name','something',P.Name);
AssertTrue('Property hints match',P.Hints=Hints);
end;
procedure TTestRecordTypeParser.AssertOneIntegerField(Hints : TPasMemberHints);
begin
@ -1819,6 +1832,15 @@ begin
AssertEquals('Method 2 result type','Integer', P.FuncType.ResultEl.ResultType.Name);
end;
procedure TTestRecordTypeParser.TestFieldAndProperty;
begin
TestFields(['x : integer;','property something read x write f;'],'',False);
AssertEquals('Member count',2,TheRecord.Members.Count);
AssertField1([]);
AssertProperty2([]);
end;
procedure TTestRecordTypeParser.TestVisibilityAndMethods;
begin
ParseType('record '+slineBreak+

15
packages/fcl-passrc/tests/tcvarparser.pas
View File

@ -47,6 +47,7 @@ Type
Procedure TestVarPublic;
Procedure TestVarPublicName;
Procedure TestVarDeprecatedExternalName;
Procedure TestVarHintPriorToInit;
end;
implementation
@ -293,6 +294,20 @@ begin
AssertEquals('Library name','''me''',TheVar.ExportName);
end;
procedure TTestVarParser.TestVarHintPriorToInit;
Var
E : TBoolConstExpr;
begin
ParseVar('boolean platform = false','');
CheckHint(TPasMemberHint(Getenumvalue(typeinfo(TPasMemberHint),'hplatform')));
AssertNotNull('Correctly initialized',Thevar.Expr);
AssertEquals('Correctly initialized',TBoolConstExpr,Thevar.Expr.ClassType);
E:=Thevar.Expr as TBoolConstExpr;
AssertEquals('Correct initialization value',False, E.Value);
end;
initialization
RegisterTests([TTestVarParser]);