paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-08-23 12:19:06 +02:00
Code Issues Packages Projects Releases Wiki Activity

fcl-passrc: useanalyzer: fixed marking nested type

Browse Source
This commit is contained in:
mattias 2021-03-01 22:02:12 +00:00
parent e69a192fb6
commit dbb9b3b67c
3 changed files with 46 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

15
compiler/packages/fcl-passrc/src/pasuseanalyzer.pas
View File

@ -2357,11 +2357,18 @@ begin
else if IsModuleInternal(Member) then else if IsModuleInternal(Member) then
// private or strict private // private or strict private
continue continue
else if (Mode=paumAllPasUsable) and FirstTime else if (Mode=paumAllPasUsable) and FirstTime then
and ((Member.ClassType=TPasProperty) or (Member is TPasType)) then
begin begin
// non private property can be used by typeinfo by descendants in other units if Member.ClassType=TPasProperty then
UseTypeInfo(Member); begin
// non private property can be used by typeinfo by descendants in other units
UseTypeInfo(Member);
end
else if Member is TPasType then
begin
// non private type can be used by descendants in other units
UseType(TPasType(Member),Mode);
end
end end
else else
; // else: class/record is in unit interface, mark all non private members ; // else: class/record is in unit interface, mark all non private members

7
compiler/packages/fcl-passrc/tests/tcresolver.pas
View File

@ -172,7 +172,7 @@ type
ImplementationSrc: string): TTestEnginePasResolver; ImplementationSrc: string): TTestEnginePasResolver;
procedure AddSystemUnit(Parts: TSystemUnitParts = []); procedure AddSystemUnit(Parts: TSystemUnitParts = []);
procedure StartProgram(NeedSystemUnit: boolean; SystemUnitParts: TSystemUnitParts = []); procedure StartProgram(NeedSystemUnit: boolean; SystemUnitParts: TSystemUnitParts = []);
procedure StartUnit(NeedSystemUnit: boolean); procedure StartUnit(NeedSystemUnit: boolean; SystemUnitParts: TSystemUnitParts = []);
property Modules[Index: integer]: TTestEnginePasResolver read GetModules; property Modules[Index: integer]: TTestEnginePasResolver read GetModules;
property ModuleCount: integer read GetModuleCount; property ModuleCount: integer read GetModuleCount;
property Hub: TPasResolverHub read FHub; property Hub: TPasResolverHub read FHub;
@ -2336,10 +2336,11 @@ begin
Add('program '+ExtractFileUnitName(MainFilename)+';'); Add('program '+ExtractFileUnitName(MainFilename)+';');
end; end;
procedure TCustomTestResolver.StartUnit(NeedSystemUnit: boolean); procedure TCustomTestResolver.StartUnit(NeedSystemUnit: boolean;
SystemUnitParts: TSystemUnitParts);
begin begin
if NeedSystemUnit then if NeedSystemUnit then
AddSystemUnit AddSystemUnit(SystemUnitParts)
else else
Parser.ImplicitUses.Clear; Parser.ImplicitUses.Clear;
Add('unit '+ExtractFileUnitName(MainFilename)+';'); Add('unit '+ExtractFileUnitName(MainFilename)+';');

31
compiler/packages/fcl-passrc/tests/tcuseanalyzer.pas
View File

@ -85,6 +85,7 @@ type
procedure TestM_Class_PropertyInherited; procedure TestM_Class_PropertyInherited;
procedure TestM_Class_MethodOverride; procedure TestM_Class_MethodOverride;
procedure TestM_Class_MethodOverride2; procedure TestM_Class_MethodOverride2;
procedure TestM_Class_NestedClass;
procedure TestM_ClassInterface_Corba; procedure TestM_ClassInterface_Corba;
procedure TestM_ClassInterface_NoHintsForMethod; procedure TestM_ClassInterface_NoHintsForMethod;
procedure TestM_ClassInterface_NoHintsForImpl; procedure TestM_ClassInterface_NoHintsForImpl;
@ -1321,6 +1322,36 @@ begin
AnalyzeProgram; AnalyzeProgram;
end; end;
procedure TTestUseAnalyzer.TestM_Class_NestedClass;
begin
StartUnit(true,[supTObject]);
Add([
'interface',
'type',
' TBird = class',
' public type',
' TWing = class',
' private',
' function GetCurrent: TBird;',
' public',
' function MoveNext: Boolean; reintroduce;',
' property Current: TBird read GetCurrent;',
' end;',
' end;',
'implementation',
'function TBird.TWing.GetCurrent: TBird;',
'begin',
' Result:=nil;',
'end;',
'function TBird.TWing.MoveNext: Boolean; reintroduce;',
'begin',
' Result:=false;',
'end;',
'']);
AnalyzeUnit;
CheckUseAnalyzerUnexpectedHints;
end;
procedure TTestUseAnalyzer.TestM_ClassInterface_Corba; procedure TTestUseAnalyzer.TestM_ClassInterface_Corba;
begin begin
StartProgram(false); StartProgram(false);