mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-13 21:02:09 +02:00
* 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 -
This commit is contained in:
parent
89e2a493a7
commit
3d2c13d1f4
@ -38,7 +38,8 @@ type
|
|||||||
woForceOverload, // Force 'overload;' on overloads that are not marked as such.
|
woForceOverload, // Force 'overload;' on overloads that are not marked as such.
|
||||||
woNoAsm, // Do not allow asm block
|
woNoAsm, // Do not allow asm block
|
||||||
woSkipPrivateExternals, // Skip generation of external procedure declaration in implementation section
|
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;
|
TPasWriterOptions = Set of TPasWriterOption;
|
||||||
|
|
||||||
@ -717,9 +718,54 @@ end;
|
|||||||
|
|
||||||
procedure TPasWriter.WriteConst(AConst: TPasConst);
|
procedure TPasWriter.WriteConst(AConst: TPasConst);
|
||||||
|
|
||||||
|
Const
|
||||||
|
Seps : Array[Boolean] of Char = ('=',':');
|
||||||
|
|
||||||
|
Var
|
||||||
|
Vart,Decl : String;
|
||||||
|
|
||||||
begin
|
begin
|
||||||
PrepareDeclSection('const');
|
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;
|
end;
|
||||||
|
|
||||||
procedure TPasWriter.WriteVariable(aVar: TPasVariable);
|
procedure TPasWriter.WriteVariable(aVar: TPasVariable);
|
||||||
@ -821,7 +867,9 @@ begin
|
|||||||
end;
|
end;
|
||||||
AddLn(Temp);
|
AddLn(Temp);
|
||||||
IncIndent;
|
IncIndent;
|
||||||
|
IncDeclSectionLevel;
|
||||||
WriteMembers(AType.Members,visPublic);
|
WriteMembers(AType.Members,visPublic);
|
||||||
|
DecDeclSectionLevel;
|
||||||
DecIndent;
|
DecIndent;
|
||||||
Add('end');
|
Add('end');
|
||||||
end;
|
end;
|
||||||
@ -861,7 +909,7 @@ begin
|
|||||||
PrepareDeclSection('');
|
PrepareDeclSection('');
|
||||||
if Not IsImpl then
|
if Not IsImpl then
|
||||||
IsImpl:=FInImplementation;
|
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;
|
Exit;
|
||||||
Add(AProc.TypeName + ' ' + NamePrefix+AProc.SafeName);
|
Add(AProc.TypeName + ' ' + NamePrefix+AProc.SafeName);
|
||||||
if Assigned(AProc.ProcType) and (AProc.ProcType.Args.Count > 0) then
|
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;
|
// delphi compatible order for example: procedure foo; reintroduce; overload; static;
|
||||||
if not IsImpl and AProc.IsReintroduced then
|
if not IsImpl and AProc.IsReintroduced then
|
||||||
Add(' reintroduce;');
|
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;');
|
Add(' overload;');
|
||||||
if not IsImpl then
|
if not IsImpl then
|
||||||
begin
|
begin
|
||||||
|
Loading…
Reference in New Issue
Block a user