瀏覽代碼

fcl-passrc: useanalyzer: fixed marking nested type

git-svn-id: trunk@48861 -
Mattias Gaertner 4 年之前
父節點
當前提交
8c38953440

+ 11 - 4
packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -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

+ 4 - 3
packages/fcl-passrc/tests/tcresolver.pas

@@ -175,7 +175,7 @@ type
     procedure AddSystemUnit(Parts: TSystemUnitParts = []);
     procedure StartProgram(NeedSystemUnit: boolean; SystemUnitParts: TSystemUnitParts = []);
     procedure StartLibrary(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;
@@ -2345,10 +2345,11 @@ begin
   Add('library '+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 - 0
packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -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);