diff --git a/packages/fcl-passrc/src/pasresolver.pp b/packages/fcl-passrc/src/pasresolver.pp index 65bf7deff9..bf44b7668c 100644 --- a/packages/fcl-passrc/src/pasresolver.pp +++ b/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} diff --git a/packages/fcl-passrc/src/pasuseanalyzer.pas b/packages/fcl-passrc/src/pasuseanalyzer.pas index dbe30ef6d6..561cb7f45c 100644 --- a/packages/fcl-passrc/src/pasuseanalyzer.pas +++ b/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; diff --git a/packages/fcl-passrc/tests/tcresolver.pas b/packages/fcl-passrc/tests/tcresolver.pas index c5f9bd20e2..d14e315443 100644 --- a/packages/fcl-passrc/tests/tcresolver.pas +++ b/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; diff --git a/packages/fcl-passrc/tests/tcuseanalyzer.pas b/packages/fcl-passrc/tests/tcuseanalyzer.pas index 0ed4a64c40..e2a267de87 100644 --- a/packages/fcl-passrc/tests/tcuseanalyzer.pas +++ b/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]);