paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-01 13:30:47 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Merging revisions r46311,r46312,r46313,r46314,r46315,r46316,r46317,r46318,r46319,r46320 from trunk:

Browse Source 
------------------------------------------------------------------------
    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 2020-08-23 09:33:23 +00:00
parent 834ceb69b5
commit 89e2a493a7
2 changed files with 116 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -35,7 +35,10 @@ type
woAddLineNumber, // Prefix line with generated line numbers in comment woAddLineNumber, // Prefix line with generated line numbers in comment
woAddSourceLineNumber, // Prefix line with original source line numbers (when available) in comment woAddSourceLineNumber, // Prefix line with original source line numbers (when available) in comment
woForwardClasses, // Add forward definitions for all classes 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; TPasWriterOptions = Set of TPasWriterOption;
@ -60,6 +63,7 @@ type
procedure SetForwardClasses(AValue: TStrings); procedure SetForwardClasses(AValue: TStrings);
procedure SetIndentSize(AValue: Integer); procedure SetIndentSize(AValue: Integer);
protected protected
procedure DisableHintsWarnings;
procedure PrepareDeclSectionInStruct(const ADeclSection: string); procedure PrepareDeclSectionInStruct(const ADeclSection: string);
procedure MaybeSetLineElement(AElement: TPasElement); procedure MaybeSetLineElement(AElement: TPasElement);
function GetExpr(E: TPasExpr): String; virtual; function GetExpr(E: TPasExpr): String; virtual;
@ -82,10 +86,11 @@ type
public public
constructor Create(AStream: TStream); virtual; constructor Create(AStream: TStream); virtual;
destructor Destroy; override; destructor Destroy; override;
procedure WriteMembers(aMembers: TFPList; aDefaultVisibility: TPasMemberVisibility=visDefault); virtual;
procedure AddForwardClasses(aSection: TPasSection); virtual; procedure AddForwardClasses(aSection: TPasSection); 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);virtual; procedure WriteElement(AElement: TPasElement;SkipSection : Boolean = False);virtual;
procedure WriteType(AType: TPasType; Full : Boolean = True);virtual; procedure WriteType(AType: TPasType; Full : Boolean = True);virtual;
procedure WriteProgram(aModule : TPasProgram); virtual; procedure WriteProgram(aModule : TPasProgram); virtual;
Procedure WriteLibrary(aModule : TPasLibrary); virtual; Procedure WriteLibrary(aModule : TPasLibrary); virtual;
@ -220,10 +225,11 @@ begin
FLineElement:=AElement; FLineElement:=AElement;
end; end;
procedure TPasWriter.WriteElement(AElement: TPasElement); procedure TPasWriter.WriteElement(AElement: TPasElement;SkipSection : Boolean = False);
begin begin
MaybeSetLineElement(AElement); if not SkipSection then
MaybeSetLineElement(AElement);
if AElement.InheritsFrom(TPasModule) then if AElement.InheritsFrom(TPasModule) then
WriteModule(TPasModule(AElement)) WriteModule(TPasModule(AElement))
else if AElement.InheritsFrom(TPasSection) then else if AElement.InheritsFrom(TPasSection) then
@ -299,6 +305,16 @@ begin
AddLn(';'); AddLn(';');
end; 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); procedure TPasWriter.WriteProgram(aModule: TPasProgram);
Var Var
@ -321,13 +337,7 @@ begin
AddLn; AddLn;
end; end;
if HasOption(woNoImplementation) then if HasOption(woNoImplementation) then
begin DisableHintsWarnings;
Addln('{$HINTS OFF}');
Addln('{$WARNINGS OFF}');
Addln('{$IFDEF FPC}');
Addln('{$NOTES OFF}');
Addln('{$ENDIF FPC}');
end;
if Assigned(aModule.ProgramSection) then if Assigned(aModule.ProgramSection) then
WriteSection(aModule.ProgramSection); WriteSection(aModule.ProgramSection);
if Assigned(AModule.InitializationSection) then if Assigned(AModule.InitializationSection) then
@ -364,11 +374,7 @@ begin
AddLn; AddLn;
end; end;
if HasOption(woNoImplementation) then if HasOption(woNoImplementation) then
begin DisableHintsWarnings;
Addln('{$HINTS OFF}');
Addln('{$WARNINGS OFF}');
Addln('{$NOTES OFF}');
end;
if Assigned(AModule.InitializationSection) then if Assigned(AModule.InitializationSection) then
begin begin
PrepareDeclSection(''); PrepareDeclSection('');
@ -484,18 +490,14 @@ begin
AddLn('implementation'); AddLn('implementation');
FInImplementation:=True; FInImplementation:=True;
if HasOption(woNoImplementation) then if HasOption(woNoImplementation) then
begin DisableHintsWarnings;
Addln('{$HINTS OFF}');
Addln('{$WARNINGS OFF}');
Addln('{$NOTES OFF}');
end;
if hasOption(woNoExternalFunc) then if hasOption(woNoExternalFunc) then
WriteDummyExternalFunctions(AModule.InterfaceSection); WriteDummyExternalFunctions(AModule.InterfaceSection);
if Assigned(AModule.ImplementationSection) then if Assigned(AModule.ImplementationSection) then
begin begin
AddLn; AddLn;
WriteSection(AModule.ImplementationSection); WriteSection(AModule.ImplementationSection);
end; end;
AddLn; AddLn;
if NotOption(woNoImplementation) then if NotOption(woNoImplementation) then
begin begin
@ -564,12 +566,13 @@ begin
C:=0; C:=0;
if ASection.UsesList.Count>0 then if ASection.UsesList.Count>0 then
begin begin
For I:=1 to WordCount(ExtraUnits,UnitSeps) do if not (aSection is TImplementationSection) then
begin For I:=1 to WordCount(ExtraUnits,UnitSeps) do
u:=Trim(ExtractWord(1,ExtraUnits,UnitSeps)); begin
if (U<>'') then u:=Trim(ExtractWord(1,ExtraUnits,UnitSeps));
AddUnit(U,Nil); if (U<>'') then
end; AddUnit(U,Nil);
end;
if length(ASection.UsesClause)=ASection.UsesList.Count then if length(ASection.UsesClause)=ASection.UsesList.Count then
begin begin
for i := 0 to length(ASection.UsesClause)-1 do for i := 0 to length(ASection.UsesClause)-1 do
@ -609,17 +612,7 @@ procedure TPasWriter.WriteClass(AClass: TPasClassType);
var var
i: Integer; i: Integer;
Member, LastMember: TPasElement;
InterfacesListPrefix: string; 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 begin
PrepareDeclSection('type'); PrepareDeclSection('type');
@ -632,9 +625,22 @@ begin
okObject: Add('object'); okObject: Add('object');
okClass: Add('class'); okClass: Add('class');
okInterface: Add('interface'); okInterface: Add('interface');
okTypeHelper :
if HasOption(woAlwaysRecordHelper) then
Add('record helper')
else
Add('type helper');
okRecordHelper: Add('record helper'); okRecordHelper: Add('record helper');
okClassHelper: Add('class helper'); okClassHelper: Add('class helper');
end; 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 if AClass.IsForward then
exit; exit;
if (AClass.ObjKind=okClass) and (ACLass.ExternalName<>'') and NotOption(woNoExternalClass) then if (AClass.ObjKind=okClass) and (ACLass.ExternalName<>'') and NotOption(woNoExternalClass) then
@ -660,11 +666,35 @@ begin
AddLn('['+AClass.InterfaceGUID+']'); AddLn('['+AClass.InterfaceGUID+']');
IncIndent; IncIndent;
IncDeclSectionLevel; 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; LastMember := nil;
for i := 0 to AClass.Members.Count - 1 do for i := 0 to aMembers.Count - 1 do
begin begin
Member := TPasElement(AClass.Members[i]); Member := TPasElement(aMembers[i]);
CurVisibility := Member.Visibility; CurVisibility := Member.Visibility;
if (CurVisibility <> LastVisibility) or ForceVisibility then if (CurVisibility <> LastVisibility) or ForceVisibility then
begin begin
@ -683,9 +713,6 @@ begin
WriteElement(Member); WriteElement(Member);
LastMember := Member; LastMember := Member;
end; end;
DecDeclSectionLevel;
DecIndent;
Add('end');
end; end;
procedure TPasWriter.WriteConst(AConst: TPasConst); procedure TPasWriter.WriteConst(AConst: TPasConst);
@ -708,7 +735,7 @@ begin
// handle variables in classes/records // handle variables in classes/records
else if vmClass in aVar.VarModifiers then else if vmClass in aVar.VarModifiers then
PrepareDeclSectionInStruct('class var') PrepareDeclSectionInStruct('class var')
else if CurDeclSection<>'' then else if (CurDeclSection<>'') and not (aVar.Parent.ClassType = TPasRecordType) then
PrepareDeclSectionInStruct('var'); PrepareDeclSectionInStruct('var');
Add(aVar.SafeName + ': '); Add(aVar.SafeName + ': ');
if Not Assigned(aVar.VarType) then if Not Assigned(aVar.VarType) then
@ -720,11 +747,13 @@ begin
begin begin
if LParentIsClassOrRecord then if LParentIsClassOrRecord then
begin begin
Writeln('a');
if NotOption(woNoExternalClass) then if NotOption(woNoExternalClass) then
Add('; external name ''%s''',[aVar.ExportName.GetDeclaration(true)]); Add('; external name ''%s''',[aVar.ExportName.GetDeclaration(true)]);
end end
else if NotOption(woNoExternalVar) then else if NotOption(woNoExternalVar) then
begin begin
Writeln('b');
Add('; external '); Add('; external ');
if (aVar.LibraryName<>Nil) then if (aVar.LibraryName<>Nil) then
Add('%s ',[aVar.LibraryName.GetDeclaration(true)]); Add('%s ',[aVar.LibraryName.GetDeclaration(true)]);
@ -772,19 +801,29 @@ end;
procedure TPasWriter.WriteRecordType(AType: TPasRecordType); procedure TPasWriter.WriteRecordType(AType: TPasRecordType);
Var Var
S : TStrings;
I : Integer; I : Integer;
Temp : String;
el : TPasElement;
begin begin
S:=TStringList.Create; Temp:='record';
try If aType.IsPacked then
S.Text:=AType.GetDeclaration(true); if Atype.IsBitPacked then
For I:=0 to S.Count-2 do Temp:='bitpacked '+Temp
AddLn(S[i]); else
Add(S[S.Count-1]); Temp:='packed '+Temp;
finally If (Atype.Name<>'') then
S.Free; begin
end; 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; end;
procedure TPasWriter.WriteArrayType(AType: TPasArrayType; Full : Boolean = True); procedure TPasWriter.WriteArrayType(AType: TPasArrayType; Full : Boolean = True);
@ -803,16 +842,27 @@ end;
procedure TPasWriter.WriteProcDecl(AProc: TPasProcedure; ForceBody : Boolean = False; NamePrefix : String = ''); procedure TPasWriter.WriteProcDecl(AProc: TPasProcedure; ForceBody : Boolean = False; NamePrefix : String = '');
Procedure EmptyBody;
begin
Addln('');
Addln('begin');
AddLn('end;');
Addln('');
end;
Var Var
AddExternal : boolean; AddExternal : boolean;
IsImpl : Boolean; IsImpl : Boolean;
begin begin
IsImpl:=AProc.Parent is TPasSection; IsImpl:=AProc.Parent is TPasSection;
if IsImpl then if IsImpl then
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
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
AddProcArgs(AProc.ProcType.Args) ; AddProcArgs(AProc.ProcType.Args) ;
@ -841,7 +891,7 @@ begin
if AProc.IsStatic then if AProc.IsStatic then
Add(' static;'); Add(' static;');
end; end;
if pmAssembler in AProc.Modifiers then if (pmAssembler in AProc.Modifiers) and Not (woNoAsm in OPtions) then
Add(' assembler;'); Add(' assembler;');
if AProc.CallingConvention<>ccDefault then if AProc.CallingConvention<>ccDefault then
Add(' '+cCallingConventions[AProc.CallingConvention]+';'); Add(' '+cCallingConventions[AProc.CallingConvention]+';');
@ -863,16 +913,15 @@ begin
end; end;
AddLn; AddLn;
if Assigned(AProc.Body) then if Assigned(AProc.Body) then
WriteProcImpl(AProc.Body,pmAssembler in AProc.Modifiers)
else if ForceBody then
begin begin
Addln(''); if (pmAssembler in AProc.Modifiers) and (woNoAsm in Options) then
Addln('begin'); EmptyBody
AddLn('end;'); else
Addln(''); WriteProcImpl(AProc.Body,pmAssembler in AProc.Modifiers)
end; end
else if ForceBody then
EmptyBody;
end; end;

2
utils/pas2js/stubcreator.pp
View File

@ -340,7 +340,7 @@ begin
FLineNumberWidth:=4; FLineNumberWidth:=4;
FIndentSize:=2; FIndentSize:=2;
FExtraUnits:=''; FExtraUnits:='';
FOptions:=[woNoImplementation,woNoExternalClass,woNoExternalVar,woNoExternalFunc]; FOptions:=[woNoImplementation,woNoExternalClass,woNoExternalVar,woNoExternalFunc,woNoAsm,woSkipPrivateExternals,woAlwaysRecordHelper];
end; end;
destructor TStubCreator.Destroy; destructor TStubCreator.Destroy;