paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-11 13:09:43 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
git-svn-id: trunk@35874 -
This commit is contained in:
Mattias Gaertner 2017-04-21 13:46:09 +00:00
parent 7cb1159f13
commit 3688141236
4 changed files with 108 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
packages/fcl-passrc/src/pasresolver.pp
View File

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

10
packages/fcl-passrc/src/pasuseanalyzer.pas
View File

@ -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,7 +1009,13 @@ begin
if BuiltInProc.BuiltIn=bfTypeInfo then
begin
Params:=(El.Parent as TParamsExpr).Params;
Resolver.ComputeElement(Params[0],ParamResolved,[]);
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;

47
packages/fcl-passrc/tests/tcresolver.pas
View File

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

65
packages/fcl-passrc/tests/tcuseanalyzer.pas
View File

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