mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-13 08:19:27 +02:00
* Correctly write labels. Patch by Simone Tacconi. Fixes issue #41133
This commit is contained in:
parent
b3d555c258
commit
ac98583fb4
@ -1462,6 +1462,7 @@ type
|
|||||||
Labels: TStrings;
|
Labels: TStrings;
|
||||||
constructor Create(const AName: TPasTreeString; AParent: TPasElement); override;
|
constructor Create(const AName: TPasTreeString; AParent: TPasElement); override;
|
||||||
destructor Destroy; override;
|
destructor Destroy; override;
|
||||||
|
function GetDeclaration(full : Boolean) : TPasTreeString; override;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
TPasImplBeginBlock = class;
|
TPasImplBeginBlock = class;
|
||||||
@ -6316,4 +6317,9 @@ begin
|
|||||||
inherited Destroy;
|
inherited Destroy;
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
function TPasLabels.GetDeclaration(full: Boolean): TPasTreeString;
|
||||||
|
begin
|
||||||
|
Result:=Labels.CommaText;
|
||||||
|
end;
|
||||||
|
|
||||||
end.
|
end.
|
||||||
|
@ -73,7 +73,6 @@ type
|
|||||||
procedure SetForwardClasses(AValue: TStrings);
|
procedure SetForwardClasses(AValue: TStrings);
|
||||||
procedure SetIndentSize(AValue: Integer);
|
procedure SetIndentSize(AValue: Integer);
|
||||||
function CheckUnitAlias(const AUnitName : String) : String;
|
function CheckUnitAlias(const AUnitName : String) : String;
|
||||||
procedure WriteImplWithDo(aWith: TPasImplWithDo);
|
|
||||||
protected
|
protected
|
||||||
procedure DisableHintsWarnings;
|
procedure DisableHintsWarnings;
|
||||||
procedure PrepareDeclSectionInStruct(const ADeclSection: string);
|
procedure PrepareDeclSectionInStruct(const ADeclSection: string);
|
||||||
@ -100,6 +99,9 @@ type
|
|||||||
destructor Destroy; override;
|
destructor Destroy; override;
|
||||||
procedure WriteMembers(aMembers: TFPList; aDefaultVisibility: TPasMemberVisibility=visDefault); virtual;
|
procedure WriteMembers(aMembers: TFPList; aDefaultVisibility: TPasMemberVisibility=visDefault); virtual;
|
||||||
procedure AddForwardClasses(aSection: TPasSection); 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 WriteResourceString(aStr: TPasResString); virtual;
|
||||||
procedure WriteEnumType(AType: TPasEnumType); virtual;
|
procedure WriteEnumType(AType: TPasEnumType); virtual;
|
||||||
procedure WriteElement(AElement: TPasElement;SkipSection : Boolean = False);virtual;
|
procedure WriteElement(AElement: TPasElement;SkipSection : Boolean = False);virtual;
|
||||||
@ -276,7 +278,11 @@ begin
|
|||||||
WriteImplElement(TPasImplElement(AElement),false)
|
WriteImplElement(TPasImplElement(AElement),false)
|
||||||
else if AElement.InheritsFrom(TPasResString) then
|
else if AElement.InheritsFrom(TPasResString) then
|
||||||
WriteResourceString(TPasResString(AElement))
|
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]);
|
raise EPasWriter.CreateFmt('Writing not implemented for %s nodes',[AElement.ElementTypeName]);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
@ -1714,6 +1720,27 @@ begin
|
|||||||
DeclSectionStack.Clear;
|
DeclSectionStack.Clear;
|
||||||
end;
|
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);
|
procedure WritePasFile(AElement: TPasElement; const AFilename: string);
|
||||||
var
|
var
|
||||||
Stream: TFileStream;
|
Stream: TFileStream;
|
||||||
|
@ -9,7 +9,7 @@ uses
|
|||||||
//MemCheck,
|
//MemCheck,
|
||||||
Classes, consoletestrunner, tcscanner, tctypeparser, tcstatements,
|
Classes, consoletestrunner, tcscanner, tctypeparser, tcstatements,
|
||||||
tcbaseparser, tcmoduleparser, tconstparser, tcvarparser, tcclasstype,
|
tcbaseparser, tcmoduleparser, tconstparser, tcvarparser, tcclasstype,
|
||||||
tcexprparser, tcprocfunc, tcpassrcutil, TCGenerics,
|
tcexprparser, tcprocfunc, tcpassrcutil, TCGenerics, paswrite,
|
||||||
TCResolver, TCResolveGenerics, TCResolveMultiErrors,
|
TCResolver, TCResolveGenerics, TCResolveMultiErrors,
|
||||||
TCUseAnalyzer;
|
TCUseAnalyzer;
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user