From 89e2a493a71b6636bc446f1accef18192b980013 Mon Sep 17 00:00:00 2001 From: michael Date: Sun, 23 Aug 2020 09:33:23 +0000 Subject: [PATCH] * 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 - --- packages/fcl-passrc/src/paswrite.pp | 181 ++++++++++++++++++---------- utils/pas2js/stubcreator.pp | 2 +- 2 files changed, 116 insertions(+), 67 deletions(-) diff --git a/packages/fcl-passrc/src/paswrite.pp b/packages/fcl-passrc/src/paswrite.pp index 218ed24490..77d9e4b401 100644 --- a/packages/fcl-passrc/src/paswrite.pp +++ b/packages/fcl-passrc/src/paswrite.pp @@ -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; diff --git a/utils/pas2js/stubcreator.pp b/utils/pas2js/stubcreator.pp index bfe5935d6a..f6721b695c 100644 --- a/utils/pas2js/stubcreator.pp +++ b/utils/pas2js/stubcreator.pp @@ -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;