From 1023a6ff6b975a44dd4b8b4ad536160e16646032 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Micha=C3=ABl=20Van=20Canneyt?= <michael@freepascal.org>
Date: Thu, 4 Nov 2021 19:05:59 +0100
Subject: [PATCH] * Correct label parsing

---
 packages/fcl-passrc/src/pastree.pp         |  3 ++
 packages/fcl-passrc/src/pparser.pp         |  8 +++
 packages/fcl-passrc/tests/tconstparser.pas | 58 +++++++++++++++++++++-
 packages/fcl-passrc/tests/testpassrc.lpi   |  4 +-
 4 files changed, 70 insertions(+), 3 deletions(-)

diff --git a/packages/fcl-passrc/src/pastree.pp b/packages/fcl-passrc/src/pastree.pp
index c6cd31aa68..bc456fac73 100644
--- a/packages/fcl-passrc/src/pastree.pp
+++ b/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
diff --git a/packages/fcl-passrc/src/pparser.pp b/packages/fcl-passrc/src/pparser.pp
index 54305a898e..f3ced89d0f 100644
--- a/packages/fcl-passrc/src/pparser.pp
+++ b/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
diff --git a/packages/fcl-passrc/tests/tconstparser.pas b/packages/fcl-passrc/tests/tconstparser.pas
index 7c75c15c79..b743c22432 100644
--- a/packages/fcl-passrc/tests/tconstparser.pas
+++ b/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.
diff --git a/packages/fcl-passrc/tests/testpassrc.lpi b/packages/fcl-passrc/tests/testpassrc.lpi
index 381ef64ec7..b2ef11a869 100644
--- a/packages/fcl-passrc/tests/testpassrc.lpi
+++ b/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>