paweld/pas2js
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/pas2js.git synced 2025-04-05 21:47:47 +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
// private or strict private
continue
else if (Mode=paumAllPasUsable) and FirstTime
and ((Member.ClassType=TPasProperty) or (Member is TPasType)) then
else if (Mode=paumAllPasUsable) and FirstTime then
begin
// non private property can be used by typeinfo by descendants in other units
UseTypeInfo(Member);
if Member.ClassType=TPasProperty then
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
else
; // 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;
procedure AddSystemUnit(Parts: 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 ModuleCount: integer read GetModuleCount;
property Hub: TPasResolverHub read FHub;
@ -2336,10 +2336,11 @@ begin
Add('program '+ExtractFileUnitName(MainFilename)+';');
end;
procedure TCustomTestResolver.StartUnit(NeedSystemUnit: boolean);
procedure TCustomTestResolver.StartUnit(NeedSystemUnit: boolean;
SystemUnitParts: TSystemUnitParts);
begin
if NeedSystemUnit then
AddSystemUnit
AddSystemUnit(SystemUnitParts)
else
Parser.ImplicitUses.Clear;
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_MethodOverride;
procedure TestM_Class_MethodOverride2;
procedure TestM_Class_NestedClass;
procedure TestM_ClassInterface_Corba;
procedure TestM_ClassInterface_NoHintsForMethod;
procedure TestM_ClassInterface_NoHintsForImpl;
@ -1321,6 +1322,36 @@ begin
AnalyzeProgram;
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;
begin
StartProgram(false);