paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-07 12:07:58 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Merging revisions r46302,r46303,r46304 from trunk:

Browse Source 
------------------------------------------------------------------------
    r46302 | michael | 2020-08-07 00:07:05 +0200 (Fri, 07 Aug 2020) | 1 line
    
    * Fix writing ranges (bug ID 37505)
    ------------------------------------------------------------------------
    r46303 | michael | 2020-08-07 00:28:03 +0200 (Fri, 07 Aug 2020) | 1 line
    
    * Correctly propagate full param when writing type
    ------------------------------------------------------------------------
    r46304 | michael | 2020-08-07 00:28:25 +0200 (Fri, 07 Aug 2020) | 1 line
    
    * Do not escape string type name
    ------------------------------------------------------------------------

git-svn-id: branches/fixes_3_2@46612 -
This commit is contained in:
michael 2020-08-23 09:31:45 +00:00
parent ed27ad4438
commit d518cd0800
2 changed files with 16 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
packages/fcl-passrc/src/pastree.pp
View File

@ -170,7 +170,7 @@ type
const Arg: Pointer); virtual;
procedure ForEachChildCall(const aMethodCall: TOnForEachPasElement;
const Arg: Pointer; Child: TPasElement; CheckParent: boolean); virtual;
Function SafeName : String; // Name but with & prepended if name is a keyword.
Function SafeName : String; virtual; // Name but with & prepended if name is a keyword.
function FullPath: string; // parent's names, until parent is not TPasDeclarations
function ParentPath: string; // parent's names
function FullName: string; virtual; // FullPath + Name
@ -510,6 +510,7 @@ type
Protected
Function FixTypeDecl(aDecl: String) : String;
public
Function SafeName : String; override;
function ElementTypeName: string; override;
end;
TPasTypeArray = array of TPasType;
@ -2558,6 +2559,14 @@ begin
ProcessHints(false,Result);
end;
function TPasType.SafeName: String;
begin
if SameText(Name,'string') then
Result:=Name
else
Result:=inherited SafeName;
end;
function TPasType.ElementTypeName: string; begin Result := SPasTreeType; end;
function TPasPointerType.ElementTypeName: string; begin Result := SPasTreePointerType; end;
function TPasAliasType.ElementTypeName: string; begin Result := SPasTreeAliasType; end;

10
packages/fcl-passrc/src/paswrite.pp
View File

@ -101,7 +101,7 @@ type
procedure WriteOverloadedProc(aProc : TPasOverloadedProc; ForceBody: Boolean = False; NamePrefix : String = ''); virtual;
Procedure WriteAliasType(AType : TPasAliasType); virtual;
Procedure WriteRecordType(AType : TPasRecordType); virtual;
Procedure WriteArrayType(AType : TPasArrayType); virtual;
Procedure WriteArrayType(AType : TPasArrayType; Full : Boolean = True); virtual;
procedure WriteProcType(AProc: TPasProcedureType); virtual;
procedure WriteProcDecl(AProc: TPasProcedure; ForceBody: Boolean = False; NamePrefix : String = ''); virtual;
procedure WriteProcImpl(AProc: TProcedureBody; IsAsm : Boolean = false); virtual;
@ -282,7 +282,7 @@ begin
else if AType is TPasProcedureType then
WriteProcType(TPasProcedureType(AType))
else if AType is TPasArrayType then
WriteArrayType(TPasArrayType(AType))
WriteArrayType(TPasArrayType(AType),Full)
else if AType is TPasRecordType then
WriteRecordType(TPasRecordType(AType))
else if AType is TPasAliasType then
@ -291,6 +291,8 @@ begin
Add(AType.GetDeclaration(true))
else if AType is TPasSetType then
Add(AType.GetDeclaration(true))
else if AType is TPasRangeType then
Add(AType.GetDeclaration(true))
else
raise EPasWriter.CreateFmt('Writing not implemented for %s type nodes',[aType.ElementTypeName]);
if Full then
@ -785,10 +787,10 @@ begin
end;
end;
procedure TPasWriter.WriteArrayType(AType: TPasArrayType);
procedure TPasWriter.WriteArrayType(AType: TPasArrayType; Full : Boolean = True);
begin
Add(AType.GetDeclaration(true));
Add(AType.GetDeclaration(Full));
end;
procedure TPasWriter.WriteProcType(AProc: TPasProcedureType);