mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-07 02:48:07 +02:00
* Merging revisions r46311,r46312,r46313,r46314,r46315,r46316,r46317,r46318,r46319,r46320 from trunk:
------------------------------------------------------------------------
r46311 | michael | 2020-08-08 09:48:48 +0200 (Sat, 08 Aug 2020) | 1 line
* Fix bug ID #0037516, only add extra uses to interface
------------------------------------------------------------------------
r46312 | michael | 2020-08-08 09:56:36 +0200 (Sat, 08 Aug 2020) | 1 line
* Add woNoAsm option
------------------------------------------------------------------------
r46313 | michael | 2020-08-08 10:00:15 +0200 (Sat, 08 Aug 2020) | 1 line
* Also use woNoAsm option for procedure body
------------------------------------------------------------------------
r46314 | michael | 2020-08-08 10:01:06 +0200 (Sat, 08 Aug 2020) | 1 line
* Fix bug #37519: no assembler
------------------------------------------------------------------------
r46315 | michael | 2020-08-08 10:35:54 +0200 (Sat, 08 Aug 2020) | 1 line
* Fix bug ID #37517; remove externa from record members
------------------------------------------------------------------------
r46316 | michael | 2020-08-08 10:55:14 +0200 (Sat, 08 Aug 2020) | 1 line
* Refactor disabling of hints and warnings. Add woSkipPrivateExternals
------------------------------------------------------------------------
r46317 | michael | 2020-08-08 10:55:36 +0200 (Sat, 08 Aug 2020) | 1 line
* Fix bug id #37515
------------------------------------------------------------------------
r46318 | michael | 2020-08-08 11:08:44 +0200 (Sat, 08 Aug 2020) | 1 line
* Add woAlwaysRecordHelper option
------------------------------------------------------------------------
r46319 | michael | 2020-08-08 11:09:18 +0200 (Sat, 08 Aug 2020) | 1 line
* Fix bug id #37514 : type helper not recognized
------------------------------------------------------------------------
r46320 | michael | 2020-08-08 11:12:37 +0200 (Sat, 08 Aug 2020) | 1 line
* Fix bug id #37513 : type helper declaration incomplete
------------------------------------------------------------------------
git-svn-id: branches/fixes_3_2@46615 -
This commit is contained in:
michael
parent
834ceb69b5
commit
89e2a493a7
@ -35,7 +35,10 @@ type
|
||||
woAddLineNumber, // Prefix line with generated line numbers in comment
|
||||
woAddSourceLineNumber, // Prefix line with original source line numbers (when available) in comment
|
||||
woForwardClasses, // Add forward definitions for all classes
|
||||
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
|
||||
woSkipPrivateExternals, // Skip generation of external procedure declaration in implementation section
|
||||
woAlwaysRecordHelper // Force use of record helper for type helper
|
||||
);
|
||||
TPasWriterOptions = Set of TPasWriterOption;
|
||||
|
||||
@ -60,6 +63,7 @@ type
|
||||
procedure SetForwardClasses(AValue: TStrings);
|
||||
procedure SetIndentSize(AValue: Integer);
|
||||
protected
|
||||
procedure DisableHintsWarnings;
|
||||
procedure PrepareDeclSectionInStruct(const ADeclSection: string);
|
||||
procedure MaybeSetLineElement(AElement: TPasElement);
|
||||
function GetExpr(E: TPasExpr): String; virtual;
|
||||
@ -82,10 +86,11 @@ type
|
||||
public
|
||||
constructor Create(AStream: TStream); virtual;
|
||||
destructor Destroy; override;
|
||||
procedure WriteMembers(aMembers: TFPList; aDefaultVisibility: TPasMemberVisibility=visDefault); virtual;
|
||||
procedure AddForwardClasses(aSection: TPasSection); virtual;
|
||||
procedure WriteResourceString(aStr: TPasResString); virtual;
|
||||
procedure WriteEnumType(AType: TPasEnumType); virtual;
|
||||
procedure WriteElement(AElement: TPasElement);virtual;
|
||||
procedure WriteElement(AElement: TPasElement;SkipSection : Boolean = False);virtual;
|
||||
procedure WriteType(AType: TPasType; Full : Boolean = True);virtual;
|
||||
procedure WriteProgram(aModule : TPasProgram); virtual;
|
||||
Procedure WriteLibrary(aModule : TPasLibrary); virtual;
|
||||
@ -220,10 +225,11 @@ begin
|
||||
FLineElement:=AElement;
|
||||
end;
|
||||
|
||||
procedure TPasWriter.WriteElement(AElement: TPasElement);
|
||||
procedure TPasWriter.WriteElement(AElement: TPasElement;SkipSection : Boolean = False);
|
||||
|
||||
begin
|
||||
MaybeSetLineElement(AElement);
|
||||
if not SkipSection then
|
||||
MaybeSetLineElement(AElement);
|
||||
if AElement.InheritsFrom(TPasModule) then
|
||||
WriteModule(TPasModule(AElement))
|
||||
else if AElement.InheritsFrom(TPasSection) then
|
||||
@ -299,6 +305,16 @@ begin
|
||||
AddLn(';');
|
||||
end;
|
||||
|
||||
procedure TPasWriter.DisableHintsWarnings;
|
||||
|
||||
begin
|
||||
Addln('{$HINTS OFF}');
|
||||
Addln('{$WARNINGS OFF}');
|
||||
Addln('{$IFDEF FPC}');
|
||||
Addln('{$NOTES OFF}');
|
||||
Addln('{$ENDIF FPC}');
|
||||
end;
|
||||
|
||||
procedure TPasWriter.WriteProgram(aModule: TPasProgram);
|
||||
|
||||
Var
|
||||
@ -321,13 +337,7 @@ begin
|
||||
AddLn;
|
||||
end;
|
||||
if HasOption(woNoImplementation) then
|
||||
begin
|
||||
Addln('{$HINTS OFF}');
|
||||
Addln('{$WARNINGS OFF}');
|
||||
Addln('{$IFDEF FPC}');
|
||||
Addln('{$NOTES OFF}');
|
||||
Addln('{$ENDIF FPC}');
|
||||
end;
|
||||
DisableHintsWarnings;
|
||||
if Assigned(aModule.ProgramSection) then
|
||||
WriteSection(aModule.ProgramSection);
|
||||
if Assigned(AModule.InitializationSection) then
|
||||
@ -364,11 +374,7 @@ begin
|
||||
AddLn;
|
||||
end;
|
||||
if HasOption(woNoImplementation) then
|
||||
begin
|
||||
Addln('{$HINTS OFF}');
|
||||
Addln('{$WARNINGS OFF}');
|
||||
Addln('{$NOTES OFF}');
|
||||
end;
|
||||
DisableHintsWarnings;
|
||||
if Assigned(AModule.InitializationSection) then
|
||||
begin
|
||||
PrepareDeclSection('');
|
||||
@ -484,18 +490,14 @@ begin
|
||||
AddLn('implementation');
|
||||
FInImplementation:=True;
|
||||
if HasOption(woNoImplementation) then
|
||||
begin
|
||||
Addln('{$HINTS OFF}');
|
||||
Addln('{$WARNINGS OFF}');
|
||||
Addln('{$NOTES OFF}');
|
||||
end;
|
||||
DisableHintsWarnings;
|
||||
if hasOption(woNoExternalFunc) then
|
||||
WriteDummyExternalFunctions(AModule.InterfaceSection);
|
||||
if Assigned(AModule.ImplementationSection) then
|
||||
begin
|
||||
begin
|
||||
AddLn;
|
||||
WriteSection(AModule.ImplementationSection);
|
||||
end;
|
||||
end;
|
||||
AddLn;
|
||||
if NotOption(woNoImplementation) then
|
||||
begin
|
||||
@ -564,12 +566,13 @@ begin
|
||||
C:=0;
|
||||
if ASection.UsesList.Count>0 then
|
||||
begin
|
||||
For I:=1 to WordCount(ExtraUnits,UnitSeps) do
|
||||
begin
|
||||
u:=Trim(ExtractWord(1,ExtraUnits,UnitSeps));
|
||||
if (U<>'') then
|
||||
AddUnit(U,Nil);
|
||||
end;
|
||||
if not (aSection is TImplementationSection) then
|
||||
For I:=1 to WordCount(ExtraUnits,UnitSeps) do
|
||||
begin
|
||||
u:=Trim(ExtractWord(1,ExtraUnits,UnitSeps));
|
||||
if (U<>'') then
|
||||
AddUnit(U,Nil);
|
||||
end;
|
||||
if length(ASection.UsesClause)=ASection.UsesList.Count then
|
||||
begin
|
||||
for i := 0 to length(ASection.UsesClause)-1 do
|
||||
@ -609,17 +612,7 @@ procedure TPasWriter.WriteClass(AClass: TPasClassType);
|
||||
|
||||
var
|
||||
i: Integer;
|
||||
Member, LastMember: TPasElement;
|
||||
InterfacesListPrefix: string;
|
||||
LastVisibility, CurVisibility: TPasMemberVisibility;
|
||||
|
||||
function ForceVisibility: boolean;
|
||||
begin
|
||||
Result := (LastMember <> nil) and
|
||||
// variables can't be declared directly after methods nor properties
|
||||
// (visibility section or var keyword is required)
|
||||
((Member is TPasVariable) and not (Member is TPasProperty)) and not (LastMember is TPasVariable);
|
||||
end;
|
||||
|
||||
begin
|
||||
PrepareDeclSection('type');
|
||||
@ -632,9 +625,22 @@ begin
|
||||
okObject: Add('object');
|
||||
okClass: Add('class');
|
||||
okInterface: Add('interface');
|
||||
okTypeHelper :
|
||||
if HasOption(woAlwaysRecordHelper) then
|
||||
Add('record helper')
|
||||
else
|
||||
Add('type helper');
|
||||
okRecordHelper: Add('record helper');
|
||||
okClassHelper: Add('class helper');
|
||||
end;
|
||||
if (AClass.ObjKind in [okTypeHelper,okRecordHelper,okClassHelper]) then
|
||||
begin
|
||||
if not Assigned(AClass.HelperForType) then
|
||||
Add(' for unknowntype')
|
||||
else
|
||||
Add(' for '+AClass.HelperForType.SafeName)
|
||||
end;
|
||||
|
||||
if AClass.IsForward then
|
||||
exit;
|
||||
if (AClass.ObjKind=okClass) and (ACLass.ExternalName<>'') and NotOption(woNoExternalClass) then
|
||||
@ -660,11 +666,35 @@ begin
|
||||
AddLn('['+AClass.InterfaceGUID+']');
|
||||
IncIndent;
|
||||
IncDeclSectionLevel;
|
||||
LastVisibility := visDefault;
|
||||
WriteMembers(AClass.Members);
|
||||
DecDeclSectionLevel;
|
||||
DecIndent;
|
||||
Add('end');
|
||||
end;
|
||||
|
||||
procedure TPasWriter.WriteMembers(aMembers : TFPList; aDefaultVisibility : TPasMemberVisibility = visDefault);
|
||||
|
||||
Var
|
||||
Member, LastMember: TPasElement;
|
||||
LastVisibility, CurVisibility: TPasMemberVisibility;
|
||||
|
||||
function ForceVisibility: boolean;
|
||||
begin
|
||||
Result := (LastMember <> nil) and
|
||||
// variables can't be declared directly after methods nor properties
|
||||
// (visibility section or var keyword is required)
|
||||
((Member is TPasVariable) and not (Member is TPasProperty)) and not (LastMember is TPasVariable);
|
||||
end;
|
||||
|
||||
Var
|
||||
I : integer;
|
||||
|
||||
begin
|
||||
LastVisibility:=aDefaultVisibility;
|
||||
LastMember := nil;
|
||||
for i := 0 to AClass.Members.Count - 1 do
|
||||
for i := 0 to aMembers.Count - 1 do
|
||||
begin
|
||||
Member := TPasElement(AClass.Members[i]);
|
||||
Member := TPasElement(aMembers[i]);
|
||||
CurVisibility := Member.Visibility;
|
||||
if (CurVisibility <> LastVisibility) or ForceVisibility then
|
||||
begin
|
||||
@ -683,9 +713,6 @@ begin
|
||||
WriteElement(Member);
|
||||
LastMember := Member;
|
||||
end;
|
||||
DecDeclSectionLevel;
|
||||
DecIndent;
|
||||
Add('end');
|
||||
end;
|
||||
|
||||
procedure TPasWriter.WriteConst(AConst: TPasConst);
|
||||
@ -708,7 +735,7 @@ begin
|
||||
// handle variables in classes/records
|
||||
else if vmClass in aVar.VarModifiers then
|
||||
PrepareDeclSectionInStruct('class var')
|
||||
else if CurDeclSection<>'' then
|
||||
else if (CurDeclSection<>'') and not (aVar.Parent.ClassType = TPasRecordType) then
|
||||
PrepareDeclSectionInStruct('var');
|
||||
Add(aVar.SafeName + ': ');
|
||||
if Not Assigned(aVar.VarType) then
|
||||
@ -720,11 +747,13 @@ begin
|
||||
begin
|
||||
if LParentIsClassOrRecord then
|
||||
begin
|
||||
Writeln('a');
|
||||
if NotOption(woNoExternalClass) then
|
||||
Add('; external name ''%s''',[aVar.ExportName.GetDeclaration(true)]);
|
||||
end
|
||||
else if NotOption(woNoExternalVar) then
|
||||
begin
|
||||
Writeln('b');
|
||||
Add('; external ');
|
||||
if (aVar.LibraryName<>Nil) then
|
||||
Add('%s ',[aVar.LibraryName.GetDeclaration(true)]);
|
||||
@ -772,19 +801,29 @@ end;
|
||||
procedure TPasWriter.WriteRecordType(AType: TPasRecordType);
|
||||
|
||||
Var
|
||||
S : TStrings;
|
||||
I : Integer;
|
||||
Temp : String;
|
||||
el : TPasElement;
|
||||
|
||||
begin
|
||||
S:=TStringList.Create;
|
||||
try
|
||||
S.Text:=AType.GetDeclaration(true);
|
||||
For I:=0 to S.Count-2 do
|
||||
AddLn(S[i]);
|
||||
Add(S[S.Count-1]);
|
||||
finally
|
||||
S.Free;
|
||||
end;
|
||||
Temp:='record';
|
||||
If aType.IsPacked then
|
||||
if Atype.IsBitPacked then
|
||||
Temp:='bitpacked '+Temp
|
||||
else
|
||||
Temp:='packed '+Temp;
|
||||
If (Atype.Name<>'') then
|
||||
begin
|
||||
if AType.GenericTemplateTypes.Count>0 then
|
||||
Temp:=AType.SafeName+GenericTemplateTypesAsString(AType.GenericTemplateTypes)+' = '+Temp
|
||||
else
|
||||
Temp:=AType.SafeName+' = '+Temp;
|
||||
end;
|
||||
AddLn(Temp);
|
||||
IncIndent;
|
||||
WriteMembers(AType.Members,visPublic);
|
||||
DecIndent;
|
||||
Add('end');
|
||||
end;
|
||||
|
||||
procedure TPasWriter.WriteArrayType(AType: TPasArrayType; Full : Boolean = True);
|
||||
@ -803,16 +842,27 @@ end;
|
||||
|
||||
procedure TPasWriter.WriteProcDecl(AProc: TPasProcedure; ForceBody : Boolean = False; NamePrefix : String = '');
|
||||
|
||||
Procedure EmptyBody;
|
||||
|
||||
begin
|
||||
Addln('');
|
||||
Addln('begin');
|
||||
AddLn('end;');
|
||||
Addln('');
|
||||
end;
|
||||
Var
|
||||
AddExternal : boolean;
|
||||
IsImpl : Boolean;
|
||||
|
||||
begin
|
||||
|
||||
IsImpl:=AProc.Parent is TPasSection;
|
||||
if IsImpl then
|
||||
PrepareDeclSection('');
|
||||
if Not IsImpl then
|
||||
IsImpl:=FInImplementation;
|
||||
if FInImplementation 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
|
||||
AddProcArgs(AProc.ProcType.Args) ;
|
||||
@ -841,7 +891,7 @@ begin
|
||||
if AProc.IsStatic then
|
||||
Add(' static;');
|
||||
end;
|
||||
if pmAssembler in AProc.Modifiers then
|
||||
if (pmAssembler in AProc.Modifiers) and Not (woNoAsm in OPtions) then
|
||||
Add(' assembler;');
|
||||
if AProc.CallingConvention<>ccDefault then
|
||||
Add(' '+cCallingConventions[AProc.CallingConvention]+';');
|
||||
@ -863,16 +913,15 @@ begin
|
||||
end;
|
||||
AddLn;
|
||||
|
||||
if Assigned(AProc.Body) then
|
||||
WriteProcImpl(AProc.Body,pmAssembler in AProc.Modifiers)
|
||||
else if ForceBody then
|
||||
if Assigned(AProc.Body) then
|
||||
begin
|
||||
Addln('');
|
||||
Addln('begin');
|
||||
AddLn('end;');
|
||||
Addln('');
|
||||
end;
|
||||
|
||||
if (pmAssembler in AProc.Modifiers) and (woNoAsm in Options) then
|
||||
EmptyBody
|
||||
else
|
||||
WriteProcImpl(AProc.Body,pmAssembler in AProc.Modifiers)
|
||||
end
|
||||
else if ForceBody then
|
||||
EmptyBody;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
@ -340,7 +340,7 @@ begin
|
||||
FLineNumberWidth:=4;
|
||||
FIndentSize:=2;
|
||||
FExtraUnits:='';
|
||||
FOptions:=[woNoImplementation,woNoExternalClass,woNoExternalVar,woNoExternalFunc];
|
||||
FOptions:=[woNoImplementation,woNoExternalClass,woNoExternalVar,woNoExternalFunc,woNoAsm,woSkipPrivateExternals,woAlwaysRecordHelper];
|
||||
end;
|
||||
|
||||
destructor TStubCreator.Destroy;
|
||||
|
||||
Loading…
Reference in New Issue
Block a user