Browse Source

fcl-passrc: useanalyzer: fixed typeinfo(Result)

mattias 6 months ago
parent
commit
08f44aff2c

+ 2 - 0
packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -1308,6 +1308,8 @@ begin
     if (El is TPasFunctionType) and (TPasFunctionType(El).ResultEl<>nil) then
       UseSubEl(TPasFunctionType(El).ResultEl.ResultType);
     end
+  else if C=TPasResultElement then
+    UseSubEl(TPasResultElement(El).ResultType)
   else if C=TPasSpecializeType then
     begin
     SpecType:=TPasSpecializeType(El);

+ 37 - 0
packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -87,6 +87,7 @@ type
     procedure TestM_Class_MethodOverride;
     procedure TestM_Class_MethodOverride2;
     procedure TestM_Class_NestedClass;
+    procedure TestM_Class_Function;
     procedure TestM_ClassInterface_Corba;
     procedure TestM_ClassInterface_NoHintsForMethod;
     procedure TestM_ClassInterface_NoHintsForImpl;
@@ -1360,6 +1361,42 @@ begin
   CheckUseAnalyzerUnexpectedHints;
 end;
 
+procedure TTestUseAnalyzer.TestM_Class_Function;
+begin
+  Parser.Options:=Parser.Options+[po_CheckDirectiveRTTI];
+  StartUnit(true,[supTObject]);
+  Add([
+  '{$mode objfpc}',
+  '{$RTTI explicit methods([vcPublic])}',
+  'interface',
+  'type',
+  '  TInterfacedObject = class',
+  '  end;',
+  '  IUnknown = interface',
+  '  end;',
+  '  ITestInterface = interface',
+  '    procedure Test1;',
+  '    function Test2: word;',
+  '  end;',
+  '  TTestInterfaceClass = class(TInterfacedObject, ITestInterface)',
+  '  public',
+  '    procedure Test1;',
+  '    function Test2: word;',
+  '  end;',
+  'implementation',
+  'procedure TTestInterfaceClass.Test1;',
+  'begin',
+  'end;',
+  'function TTestInterfaceClass.Test2: word;',
+  'begin',
+  '  Result:=0;',
+  '  if typeinfo(Result)<>nil then ;',
+  'end;',
+  '']);
+  AnalyzeUnit;
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
 procedure TTestUseAnalyzer.TestM_ClassInterface_Corba;
 begin
   StartProgram(false);