Browse Source

* Correctly write labels. Patch by Simone Tacconi. Fixes issue #41133

Michaël Van Canneyt 6 months ago
parent
commit
ac98583fb4

+ 6 - 0
packages/fcl-passrc/src/pastree.pp

@@ -1462,6 +1462,7 @@ type
     Labels: TStrings;
     constructor Create(const AName: TPasTreeString; AParent: TPasElement); override;
     destructor Destroy; override;
+    function GetDeclaration(full : Boolean) : TPasTreeString; override;
   end;
 
   TPasImplBeginBlock = class;
@@ -6316,4 +6317,9 @@ begin
   inherited Destroy;
 end;
 
+function TPasLabels.GetDeclaration(full: Boolean): TPasTreeString;
+begin
+  Result:=Labels.CommaText;
+end;
+
 end.

+ 29 - 2
packages/fcl-passrc/src/paswrite.pp

@@ -73,7 +73,6 @@ type
     procedure SetForwardClasses(AValue: TStrings);
     procedure SetIndentSize(AValue: Integer);
     function CheckUnitAlias(const AUnitName : String) : String;
-    procedure WriteImplWithDo(aWith: TPasImplWithDo);
   protected
     procedure DisableHintsWarnings;
     procedure PrepareDeclSectionInStruct(const ADeclSection: string);
@@ -100,6 +99,9 @@ type
     destructor Destroy; override;
     procedure WriteMembers(aMembers: TFPList; aDefaultVisibility: TPasMemberVisibility=visDefault); virtual;
     procedure AddForwardClasses(aSection: TPasSection); virtual;
+    procedure WriteImplWithDo(aWith: TPasImplWithDo); virtual;
+    procedure WriteImplLabelMark(aLabelMark: TPasImplLabelMark); virtual;
+    procedure WriteLabels(aLabels: TPasLabels); virtual;
     procedure WriteResourceString(aStr: TPasResString); virtual;
     procedure WriteEnumType(AType: TPasEnumType); virtual;
     procedure WriteElement(AElement: TPasElement;SkipSection : Boolean = False);virtual;
@@ -276,7 +278,11 @@ begin
     WriteImplElement(TPasImplElement(AElement),false)
   else if AElement.InheritsFrom(TPasResString) then
     WriteResourceString(TPasResString(AElement))
- else
+  else if AElement.InheritsFrom(TPasLabels) then
+     WriteLabels(TPasLabels(AElement))
+  else if AElement.InheritsFrom(TPasImplLabelMark) then
+    WriteImplLabelMark(TPasImplLabelMark(AElement))
+  else
     raise EPasWriter.CreateFmt('Writing not implemented for %s nodes',[AElement.ElementTypeName]);
 end;
 
@@ -1714,6 +1720,27 @@ begin
   DeclSectionStack.Clear;
 end;
 
+procedure TPasWriter.WriteLabels(aLabels: TPasLabels);
+var
+  ind : integer;
+begin
+  Add('label ');
+  for ind:=0 to aLabels.Labels.Count-1 do
+    begin
+      Add(aLabels.Labels[ind]);
+      if ind<aLabels.Labels.Count-1 then
+        Add(', ')
+      else
+        AddLn(';');
+    end;
+  AddLn;
+end;
+
+procedure TPasWriter.WriteImplLabelMark(aLabelMark: TPasImplLabelMark);
+begin
+  AddLn(aLabelMark.LabelId+':');
+end;
+
 procedure WritePasFile(AElement: TPasElement; const AFilename: string);
 var
   Stream: TFileStream;

+ 1 - 1
packages/fcl-passrc/tests/testpassrc.lpr

@@ -9,7 +9,7 @@ uses
   //MemCheck,
   Classes, consoletestrunner, tcscanner,  tctypeparser, tcstatements,
   tcbaseparser, tcmoduleparser, tconstparser, tcvarparser, tcclasstype,
-  tcexprparser, tcprocfunc, tcpassrcutil, TCGenerics,
+  tcexprparser, tcprocfunc, tcpassrcutil, TCGenerics, paswrite,
   TCResolver, TCResolveGenerics, TCResolveMultiErrors,
   TCUseAnalyzer;