fcl-passrc: resolver: mark unary expression operand access, analyzer: typeinfo(function) publish only result type, not function

git-svn-id: trunk@35874 -

packages/fcl-passrc/src/pasresolver.pp

@@ -4683,7 +4683,7 @@ var
   ElClass: TClass;
 begin
   {$IFDEF VerbosePasResolver}
-  writeln('TPasResolver.ResolveExpr ',GetObjName(El));
+  writeln('TPasResolver.ResolveExpr ',GetObjName(El),' ',Access);
   {$ENDIF}
   if El=nil then
     RaiseNotYetImplemented(20160922163453,El);
@@ -5504,9 +5504,10 @@ begin
   else if (Access=rraRead)
       and ((C=TPrimitiveExpr)
         or (C=TNilExpr)
-        or (C=TBoolConstExpr)
-        or (C=TUnaryExpr)) then
+        or (C=TBoolConstExpr)) then
     // ok
+  else if C=TUnaryExpr then
+    AccessExpr(TUnaryExpr(Expr).Operand,Access)
   else
     begin
     {$IFDEF VerbosePasResolver}

packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -623,7 +623,7 @@ begin
 end;
 
 procedure TPasAnalyzer.UsePublished(El: TPasElement);
-// mark typeinfo, do not
+// mark typeinfo, do not mark code
 var
   C: TClass;
   Members: TFPList;
@@ -1009,8 +1009,14 @@ begin
         if BuiltInProc.BuiltIn=bfTypeInfo then
           begin
           Params:=(El.Parent as TParamsExpr).Params;
-          Resolver.ComputeElement(Params[0],ParamResolved,[]);
-          UsePublished(ParamResolved.IdentEl);
+          Resolver.ComputeElement(Params[0],ParamResolved,[rcNoImplicitProc]);
+          {$IFDEF VerbosePasAnalyzer}
+          writeln('TPasAnalyzer.UseExpr typeinfo ',GetResolverResultDbg(ParamResolved));
+          {$ENDIF}
+          if ParamResolved.IdentEl is TPasFunction then
+            UsePublished(TPasFunction(ParamResolved.IdentEl).FuncType.ResultEl.ResultType)
+          else
+            UsePublished(ParamResolved.IdentEl);
           end;
         end;
       end;

packages/fcl-passrc/tests/tcresolver.pas

@@ -3159,23 +3159,36 @@ end;
 procedure TTestResolver.TestTypeInfo;
 begin
   StartProgram(false);
-  Add('type');
-  Add('  integer = longint;');
-  Add('  TRec = record');
-  Add('    v: integer;');
-  Add('  end;');
-  Add('var');
-  Add('  i: integer;');
-  Add('  s: string;');
-  Add('  p: pointer;');
-  Add('  r: TRec;');
-  Add('begin');
-  Add('  p:=typeinfo(integer);');
-  Add('  p:=typeinfo(longint);');
-  Add('  p:=typeinfo(i);');
-  Add('  p:=typeinfo(s);');
-  Add('  p:=typeinfo(p);');
-  Add('  p:=typeinfo(r.v);');
+  Add([
+  'type',
+  '  integer = longint;',
+  '  TRec = record',
+  '    v: integer;',
+  '  end;',
+  '  TClass = class of TObject;',
+  '  TObject = class',
+  '    class function ClassType: TClass; virtual; abstract;',
+  '  end;',
+  'var',
+  '  i: integer;',
+  '  s: string;',
+  '  p: pointer;',
+  '  r: TRec;',
+  '  o: TObject;',
+  '  c: TClass;',
+  'begin',
+  '  p:=typeinfo(integer);',
+  '  p:=typeinfo(longint);',
+  '  p:=typeinfo(i);',
+  '  p:=typeinfo(s);',
+  '  p:=typeinfo(p);',
+  '  p:=typeinfo(r.v);',
+  '  p:=typeinfo(TObject.ClassType);',
+  '  p:=typeinfo(o.ClassType);',
+  '  p:=typeinfo(o);',
+  '  p:=typeinfo(c);',
+  '  p:=typeinfo(c.ClassType);',
+  '']);
   ParseProgram;
 end;
 

packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -100,6 +100,7 @@ type
     procedure TestM_Hint_FunctionResultRecord;
     procedure TestM_Hint_FunctionResultPassRecordElement;
     procedure TestM_Hint_OutParam_No_AssignedButNeverUsed;
+    procedure TestM_Hint_ArgPassed_No_ParameterNotUsed;
 
     // whole program optimization
     procedure TestWP_LocalVar;
@@ -118,6 +119,7 @@ type
     procedure TestWP_PublishedProcType;
     procedure TestWP_PublishedProperty;
     procedure TestWP_BuiltInFunctions;
+    procedure TestWP_TypeInfo;
   end;
 
 implementation
@@ -1336,6 +1338,25 @@ begin
   CheckUseAnalyzerUnexpectedHints;
 end;
 
+procedure TTestUseAnalyzer.TestM_Hint_ArgPassed_No_ParameterNotUsed;
+begin
+  StartProgram(false);
+  Add([
+  'procedure AssertTrue(b: boolean);',
+  'begin',
+  '  if b then ;',
+  'end;',
+  'procedure AssertFalse(b: boolean);',
+  'begin',
+  '  AssertTrue(not b);',
+  'end;',
+  'begin',
+  '  AssertFalse(true);',
+  '']);
+  AnalyzeProgram;
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
 procedure TTestUseAnalyzer.TestWP_LocalVar;
 begin
   StartProgram(false);
@@ -1647,6 +1668,50 @@ begin
   AnalyzeWholeProgram;
 end;
 
+procedure TTestUseAnalyzer.TestWP_TypeInfo;
+begin
+  StartProgram(false);
+  Add([
+  'type',
+  '  {#integer_used}integer = longint;',
+  '  {#trec_used}TRec = record',
+  '    {#trecv_used}v: integer;',
+  '  end;',
+  '  {#tclass_used}TClass = class of TObject;',
+  '  {#tobject_used}TObject = class',
+  '    class function {#tobject_classtype_used}ClassType: TClass; virtual; abstract;',
+  '  end;',
+  '  {#tbirds_used}TBirds = class of TBird;',
+  '  {#tbird_used}TBird = class',
+  '  end;',
+  'function {#getbirdclass_used}GetBirdClass: TBirds;',
+  'begin',
+  '  Result:=nil;',
+  'end;',
+  'var',
+  '  {#i_used}i: integer;',
+  '  {#s_used}s: string;',
+  '  {#p_used}p: pointer;',
+  '  {#r_used}r: TRec;',
+  '  {#o_used}o: TObject;',
+  '  {#c_used}c: TClass;',
+  'begin',
+  '  p:=typeinfo(integer);',
+  '  p:=typeinfo(longint);',
+  '  p:=typeinfo(i);',
+  '  p:=typeinfo(s);',
+  '  p:=typeinfo(p);',
+  '  p:=typeinfo(r.v);',
+  '  p:=typeinfo(TObject.ClassType);',
+  '  p:=typeinfo(o.ClassType);',
+  '  p:=typeinfo(o);',
+  '  p:=typeinfo(c);',
+  '  p:=typeinfo(c.ClassType);',
+  '  p:=typeinfo(GetBirdClass);',
+  '']);
+  AnalyzeWholeProgram;
+end;
+
 initialization
   RegisterTests([TTestUseAnalyzer]);