* Correct label parsing

packages/fcl-passrc/src/pastree.pp

@@ -356,6 +356,7 @@ type
     Functions,  // TPasProcedure
     Properties, // TPasProperty
     ResStrings, // TPasResString
+    Labels,     // TPasLabel
     Types,      // TPasType, except TPasClassType, TPasRecordType
     Variables   // TPasVariable, not descendants
       : TFPList;
@@ -3285,6 +3286,7 @@ begin
   Properties := TFPList.Create;
   ResStrings := TFPList.Create;
   Types := TFPList.Create;
+  Labels := TFPList.Create;
   Variables := TFPList.Create;
 end;
 
@@ -3303,6 +3305,7 @@ begin
   FreeAndNil(Consts);
   FreeAndNil(Classes);
   FreeAndNil(Attributes);
+  FreeAndNil(Labels);
   {$IFDEF VerbosePasTreeMem}writeln('TPasDeclarations.Destroy Declarations');{$ENDIF}
   for i := 0 to Declarations.Count - 1 do
     begin

packages/fcl-passrc/src/pparser.pp

@@ -6650,6 +6650,14 @@ begin
     if not (CurToken in [tkSemicolon, tkComma]) then
       ParseExcTokenError(TokenInfos[tkSemicolon]);
   until CurToken=tkSemicolon;
+  if not (aParent is TPasDeclarations) then
+    FreeAndNil(Labels)
+  else
+    begin
+    TPasDeclarations(aParent).Declarations.Add(Labels);
+    TPasDeclarations(aParent).Labels.Add(Labels);
+    end;
+
 end;
 
 // Starts after the "procedure" or "function" token

packages/fcl-passrc/tests/tconstparser.pas

@@ -114,8 +114,64 @@ Type
     Procedure TestSum2Platform;
   end;
 
+  { TTestLabelParser }
+
+  TTestLabelParser = Class(TTestParser)
+  private
+    FExpr: TPasExpr;
+    FHint : string;
+    FTheStr: TPasResString;
+  Protected
+    Function ParseLabel(ASource : String) : TPasLabels;
+    Property Hint : string Read FHint Write FHint;
+  Published
+    Procedure TestSimple;
+    Procedure TestSimpleNumber;
+  end;
 
 implementation
+
+{ TTestLabelParser }
+
+function TTestLabelParser.ParseLabel(ASource: String): TPasLabels;
+Var
+  D : String;
+begin
+  UseImplementation:=True;
+  Add('label');
+  D:=ASource;
+  If Hint<>'' then
+    D:=D+' '+Hint;
+  Add('  '+D+';');
+  Add('end.');
+  //Writeln(source.text);
+  ParseDeclarations;
+  AssertEquals('One labels section',1,Declarations.Labels.Count);
+  AssertEquals('First declaration is label section.',TPasLabels,TObject(Declarations.Labels[0]).ClassType);
+  Result:=TPasLabels(Declarations.Labels[0]);
+end;
+
+procedure TTestLabelParser.TestSimple;
+
+Var
+  Res : TPasLabels;
+
+begin
+   Res:=ParseLabel('a');
+   AssertEquals('One label definition',1,Res.Labels.Count);
+   AssertEquals('One label definition','a',Res.Labels[0]);
+end;
+
+procedure TTestLabelParser.TestSimpleNumber;
+Var
+  Res : TPasLabels;
+
+begin
+   Res:=ParseLabel('100');
+   AssertEquals('One label definition',1,Res.Labels.Count);
+   AssertEquals('One label definition','100',Res.Labels[0]);
+end;
+
 { TTestConstParser }
 
 function TTestConstParser.ParseConst(ASource: String): TPasConst;
@@ -708,7 +764,7 @@ begin
 end;
 
 initialization
-  RegisterTests([TTestConstParser,TTestResourcestringParser]);
+  RegisterTests([TTestConstParser,TTestResourcestringParser,TTestLabelParser]);
 
 
 end.

packages/fcl-passrc/tests/testpassrc.lpi

@@ -24,13 +24,13 @@
     </PublishOptions>
     <RunParams>
       <local>
-        <CommandLineParams Value="--suite=TTestConstParser.TestRecordConstEmpty"/>
+        <CommandLineParams Value="--suite=TTestLabelParser"/>
       </local>
       <FormatVersion Value="2"/>
       <Modes Count="1">
         <Mode0 Name="default">
           <local>
-            <CommandLineParams Value="--suite=TTestConstParser.TestRecordConstEmpty"/>
+            <CommandLineParams Value="--suite=TTestLabelParser"/>
           </local>
         </Mode0>
       </Modes>