* Support Hints prior to variable initialization, properties in records

git-svn-id: trunk@29556 -

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

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+

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]);