From 3d2c13d1f4fd80482d57f85db0ec59789b669cdb Mon Sep 17 00:00:00 2001
From: michael <michael@freepascal.org>
Date: Sun, 23 Aug 2020 09:44:47 +0000
Subject: [PATCH] * Merging revisions
 r46350,r46358,r46359,r46360,r46361,r46363,r46364,r46367 from trunk:    
 ------------------------------------------------------------------------    
 r46350 | michael | 2020-08-10 15:31:46 +0200 (Mon, 10 Aug 2020) | 1 line

    * Fix bug #37533: extra type section starts
    ------------------------------------------------------------------------
    r46358 | michael | 2020-08-11 12:56:25 +0200 (Tue, 11 Aug 2020) | 1 line

    * Allow skipping hints
    ------------------------------------------------------------------------
    r46359 | michael | 2020-08-11 12:56:47 +0200 (Tue, 11 Aug 2020) | 1 line

    * skip hints (bug ID 37511)
    ------------------------------------------------------------------------
    r46360 | michael | 2020-08-11 13:23:28 +0200 (Tue, 11 Aug 2020) | 1 line

    * Fix bug ID #0037538 (need implementation for dummy bodys)
    ------------------------------------------------------------------------
    r46361 | michael | 2020-08-11 13:44:23 +0200 (Tue, 11 Aug 2020) | 1 line

    * Fix bug ID #37537: External constant support
    ------------------------------------------------------------------------
    r46363 | michael | 2020-08-11 15:32:29 +0200 (Tue, 11 Aug 2020) | 1 line

    * Always define makestub
    ------------------------------------------------------------------------
    r46364 | michael | 2020-08-11 15:42:25 +0200 (Tue, 11 Aug 2020) | 1 line

    * Fix bug ID #37537: External constant support (also for class consts)
    ------------------------------------------------------------------------
    r46367 | michael | 2020-08-12 09:47:55 +0200 (Wed, 12 Aug 2020) | 1 line

    * Fix 0037544: overload writing refinement
    ------------------------------------------------------------------------

git-svn-id: branches/fixes_3_2@46616 -
---
 packages/fcl-passrc/src/paswrite.pp | 58 +++++++++++++++++++++++++++--
 1 file changed, 54 insertions(+), 4 deletions(-)

diff --git a/packages/fcl-passrc/src/paswrite.pp b/packages/fcl-passrc/src/paswrite.pp
index 77d9e4b401..89692a0cbe 100644
--- a/packages/fcl-passrc/src/paswrite.pp
+++ b/packages/fcl-passrc/src/paswrite.pp
@@ -38,7 +38,8 @@ type
                       woForceOverload,     // Force 'overload;' on overloads that are not marked as such.
                       woNoAsm,         // Do not allow asm block
                       woSkipPrivateExternals,  // Skip generation of external procedure declaration in implementation section
-                      woAlwaysRecordHelper     // Force use of record helper for type helper
+                      woAlwaysRecordHelper,     // Force use of record helper for type helper
+                      woSkipHints          // Do not add identifier hints
                       );
   TPasWriterOptions = Set of TPasWriterOption;
 
@@ -717,9 +718,54 @@ end;
 
 procedure TPasWriter.WriteConst(AConst: TPasConst);
 
+Const
+  Seps : Array[Boolean] of Char = ('=',':');
+
+Var
+  Vart,Decl : String;
+
 begin
   PrepareDeclSection('const');
-  AddLn(AConst.GetDeclaration(True)+';');
+  Decl:='';
+  With AConst do
+    begin
+    If Assigned(VarType) then
+      begin
+      If VarType.Name='' then
+        Vart:=VarType.GetDeclaration(False)
+      else
+        Vart:=VarType.SafeName;
+      Decl:=Vart+Modifiers;
+      Vart:=LowerCase(Vart);
+      if (Value<>'') then
+         Decl:=Decl+' = '+Value
+      else if (ExportName<>Nil) or ((Parent is TPasClassType) and (TPasClassType(Parent).ExternalName<>'')) then // external name
+        case VarT of
+          'integer',
+          'byte',
+          'word',
+          'smallint',
+          'int64',
+          'nativeint',
+          'shortint',
+          'longint' : Decl:=Decl+' = 0';
+          'double',
+          'single',
+          'extended' : Decl:=Decl+' = 0.0';
+          'string' : Decl:=Decl+' = ''''';
+        else
+          if Pos('array',Vart)>0 then
+            Decl:=Decl+' = []';
+        end;
+      end
+    else
+      Decl:=Value;
+
+    Decl:=SafeName+' '+Seps[Assigned(VarType)]+' '+Decl;
+    if NotOption(woSkipHints) then
+      Decl:=Decl+HintsString;
+    end;
+  AddLn(Decl+';');
 end;
 
 procedure TPasWriter.WriteVariable(aVar: TPasVariable);
@@ -821,7 +867,9 @@ begin
     end;
   AddLn(Temp);
   IncIndent;
+  IncDeclSectionLevel;
   WriteMembers(AType.Members,visPublic);
+  DecDeclSectionLevel;
   DecIndent;
   Add('end');
 end;
@@ -861,7 +909,7 @@ begin
     PrepareDeclSection('');
   if Not IsImpl then
     IsImpl:=FInImplementation;
-  if FInImplementation and (Assigned(AProc.LibraryExpr) or Assigned(AProc.LibrarySymbolName)) and HasOption(woSkipPrivateExternals)  then
+  if FInImplementation and not forcebody and (Assigned(AProc.LibraryExpr) or Assigned(AProc.LibrarySymbolName)) and HasOption(woSkipPrivateExternals)  then
     Exit;
   Add(AProc.TypeName + ' ' + NamePrefix+AProc.SafeName);
   if Assigned(AProc.ProcType) and (AProc.ProcType.Args.Count > 0) then
@@ -876,7 +924,9 @@ begin
   // delphi compatible order for example: procedure foo; reintroduce; overload; static;
   if not IsImpl and AProc.IsReintroduced then
     Add(' reintroduce;');
-  if AProc.IsOverload then
+  // if NamePrefix is not empty, we're writing a dummy for external class methods.
+  // In that case, we must not write the 'overload'.
+  if AProc.IsOverload and (NamePrefix='') and not IsImpl then
     Add(' overload;');
   if not IsImpl then
     begin