From 79e7ba678ecc920076072552d06b4cf6b1282255 Mon Sep 17 00:00:00 2001
From: michael <michael@freepascal.org>
Date: Mon, 26 Jan 2015 13:46:21 +0000
Subject: [PATCH] * Support Hints prior to variable initialization, properties
 in records

git-svn-id: trunk@29556 -
---
 packages/fcl-passrc/src/pparser.pp         | 12 +++++++++++-
 packages/fcl-passrc/tests/tctypeparser.pas | 22 ++++++++++++++++++++++
 packages/fcl-passrc/tests/tcvarparser.pas  | 15 +++++++++++++++
 3 files changed, 48 insertions(+), 1 deletion(-)

diff --git a/packages/fcl-passrc/src/pparser.pp b/packages/fcl-passrc/src/pparser.pp
index 241ff2223b..bf861e95c7 100644
--- a/packages/fcl-passrc/src/pparser.pp
+++ b/packages/fcl-passrc/src/pparser.pp
@@ -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
diff --git a/packages/fcl-passrc/tests/tctypeparser.pas b/packages/fcl-passrc/tests/tctypeparser.pas
index b4416840b8..6e6349d5c0 100644
--- a/packages/fcl-passrc/tests/tctypeparser.pas
+++ b/packages/fcl-passrc/tests/tctypeparser.pas
@@ -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+
diff --git a/packages/fcl-passrc/tests/tcvarparser.pas b/packages/fcl-passrc/tests/tcvarparser.pas
index a823bfd198..58bae61867 100644
--- a/packages/fcl-passrc/tests/tcvarparser.pas
+++ b/packages/fcl-passrc/tests/tcvarparser.pas
@@ -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]);