From 93ce148b734c1fe02fda60bfcb16e3c3684e4800 Mon Sep 17 00:00:00 2001 From: Mattias Gaertner Date: Fri, 6 Apr 2018 18:20:11 +0000 Subject: [PATCH] fcl-passrc: useanalyzer: typeinfo for interfaces git-svn-id: trunk@38704 - --- packages/fcl-passrc/src/pasresolver.pp | 2 + packages/fcl-passrc/src/pasuseanalyzer.pas | 99 ++++++++++++++------- packages/fcl-passrc/tests/tcuseanalyzer.pas | 71 ++++++++++++--- packages/pastojs/tests/tcfiler.pas | 1 + 4 files changed, 130 insertions(+), 43 deletions(-) diff --git a/packages/fcl-passrc/src/pasresolver.pp b/packages/fcl-passrc/src/pasresolver.pp index 9922fe5543..3755174dde 100644 --- a/packages/fcl-passrc/src/pasresolver.pp +++ b/packages/fcl-passrc/src/pasresolver.pp @@ -6711,9 +6711,11 @@ begin if not EnumeratorFound then begin {$IFDEF VerbosePasResolver} + {AllowWriteln} writeln('TPasResolver.ResolveImplForLoop StartResolved=',GetResolverResultDbg(StartResolved)); if VarRange<>nil then writeln('TPasResolver.ResolveImplForLoop VarRange=',VarRange.AsDebugString); + {AllowWriteln-} {$ENDIF} RaiseMsg(20171108223818,nCannotFindEnumeratorForType,sCannotFindEnumeratorForType, [GetBaseDescription(OrigStartResolved)],Loop.StartExpr); diff --git a/packages/fcl-passrc/src/pasuseanalyzer.pas b/packages/fcl-passrc/src/pasuseanalyzer.pas index 5863c4104a..e6d58a3f95 100644 --- a/packages/fcl-passrc/src/pasuseanalyzer.pas +++ b/packages/fcl-passrc/src/pasuseanalyzer.pas @@ -154,7 +154,7 @@ type paumElement, // Mark element. Do not descend into children. paumAllPublic, // Mark element and descend into children and mark public identifiers paumAllExports, // Do not mark element. Descend into children and mark exports. - paumPublished // Mark element and its type and descend into children and mark published identifiers + paumTypeInfo // Mark element and its type and descend into children and mark published identifiers ); TPAUseModes = set of TPAUseMode; const @@ -200,7 +200,7 @@ type procedure MarkImplScopeRef(El, RefEl: TPasElement; Access: TPSRefAccess); procedure UseElement(El: TPasElement; Access: TResolvedRefAccess; UseFull: boolean); virtual; - procedure UsePublished(El: TPasElement); virtual; + procedure UseTypeInfo(El: TPasElement); virtual; procedure UseModule(aModule: TPasModule; Mode: TPAUseMode); virtual; procedure UseSection(Section: TPasSection; Mode: TPAUseMode); virtual; procedure UseImplBlock(Block: TPasImplBlock; Mark: boolean); virtual; @@ -552,7 +552,7 @@ begin UseElement(Ref.Element,rraAssign,false); UseElement(Ref.Element,rraRead,false); end; - psraTypeInfo: UsePublished(Ref.Element); + psraTypeInfo: UseTypeInfo(Ref.Element); else RaiseNotSupported(20180228191928,Ref.Element,dbgs(Ref.Access)); end; @@ -768,14 +768,14 @@ begin RaiseNotSupported(20170307090947,El); end; -procedure TPasAnalyzer.UsePublished(El: TPasElement); +procedure TPasAnalyzer.UseTypeInfo(El: TPasElement); // mark typeinfo, do not mark code procedure UseSubEl(SubEl: TPasElement); inline; begin if SubEl=nil then exit; MarkImplScopeRef(El,SubEl,psraTypeInfo); - UsePublished(SubEl); + UseTypeInfo(SubEl); end; var @@ -786,11 +786,12 @@ var MemberResolved: TPasResolverResult; Prop: TPasProperty; ProcType: TPasProcedureType; + ClassEl: TPasClassType; begin {$IFDEF VerbosePasAnalyzer} writeln('TPasAnalyzer.UsePublished START ',GetObjName(El)); {$ENDIF} - if ElementVisited(El,paumPublished) then exit; + if ElementVisited(El,paumTypeInfo) then exit; C:=El.ClassType; if C=TPasUnresolvedSymbolRef then @@ -805,10 +806,11 @@ begin for i:=0 to Prop.Args.Count-1 do UseSubEl(TPasArgument(Prop.Args[i]).ArgType); UseSubEl(Prop.VarType); - // Note: read, write and index don't need extra typeinfo - + UseElement(Resolver.GetPasPropertyGetter(Prop),rraRead,false); + UseElement(Resolver.GetPasPropertySetter(Prop),rraRead,false); + UseElement(Resolver.GetPasPropertyIndex(Prop),rraRead,false); // stored and defaultvalue are only used when published -> mark as used - UseElement(Prop.StoredAccessor,rraRead,false); + UseElement(Resolver.GetPasPropertyStoredExpr(Prop),rraRead,false); UseElement(Prop.DefaultExpr,rraRead,false); end else if (C=TPasAliasType) or (C=TPasTypeAliasType) then @@ -830,6 +832,20 @@ begin else if C=TPasPointerType then UseSubEl(TPasPointerType(El).DestType) else if C=TPasClassType then + begin + ClassEl:=TPasClassType(El); + if ClassEl.ObjKind=okInterface then + begin + // mark all used members + Members:=ClassEl.Members; + for i:=0 to Members.Count-1 do + begin + Member:=TPasElement(Members[i]); + if IsUsed(Member) then + UseTypeInfo(Member); + end; + end; + end else if C=TPasClassOfType then else if C=TPasRecordType then begin @@ -1214,13 +1230,13 @@ begin begin SubEl:=TPasFunction(ParamResolved.IdentEl).FuncType.ResultEl.ResultType; MarkImplScopeRef(El,SubEl,psraTypeInfo); - UsePublished(SubEl); + UseTypeInfo(SubEl); end else begin SubEl:=ParamResolved.IdentEl; MarkImplScopeRef(El,SubEl,psraTypeInfo); - UsePublished(SubEl); + UseTypeInfo(SubEl); end; // the parameter is not used otherwise exit; @@ -1400,6 +1416,7 @@ var Name: String; Identifier: TPasIdentifier; El: TPasElement; + ClassEl: TPasClassType; begin if Proc=nil then exit; // use declaration, not implementation @@ -1430,28 +1447,33 @@ begin and (TPasClassType(Proc.Parent).ObjKind=okInterface)) then UseOverrides(Proc); - if ((Proc.ClassType=TPasConstructor) or (Proc.ClassType=TPasDestructor)) - and (Proc.Parent is TPasClassType) then + if Proc.Parent is TPasClassType then begin - ClassScope:=Proc.Parent.CustomData as TPasClassScope; - if ClassScope.AncestorScope=nil then + ClassScope:=TPasClassScope(Proc.Parent.CustomData); + ClassEl:=TPasClassType(ClassScope.Element); + if (ClassEl.ObjKind=okInterface) and IsTypeInfoUsed(ClassEl) then + UseTypeInfo(Proc); + if (Proc.ClassType=TPasConstructor) or (Proc.ClassType=TPasDestructor) then begin - // root class constructor -> mark AfterConstruction - if Proc.ClassType=TPasConstructor then - Name:='AfterConstruction' - else - Name:='BeforeDestruction'; - Identifier:=ClassScope.FindLocalIdentifier(Name); - while Identifier<>nil do + if ClassScope.AncestorScope=nil then begin - El:=Identifier.Element; - if (El.ClassType=TPasProcedure) - and (TPasProcedure(El).ProcType.Args.Count=0) then + // root class constructor -> mark AfterConstruction + if Proc.ClassType=TPasConstructor then + Name:='AfterConstruction' + else + Name:='BeforeDestruction'; + Identifier:=ClassScope.FindLocalIdentifier(Name); + while Identifier<>nil do begin - UseProcedure(TPasProcedure(El)); - break; + El:=Identifier.Element; + if (El.ClassType=TPasProcedure) + and (TPasProcedure(El).ProcType.Args.Count=0) then + begin + UseProcedure(TPasProcedure(El)); + break; + end; + Identifier:=Identifier.NextSameIdentifier; end; - Identifier:=Identifier.NextSameIdentifier; end; end; end; @@ -1729,7 +1751,7 @@ begin begin // include published if not FirstTime then continue; - UsePublished(Member); + UseTypeInfo(Member); end else if Mode=paumElement then continue @@ -1811,6 +1833,7 @@ var Prop: TPasProperty; i: Integer; IsRead, IsWrite, CanRead, CanWrite: Boolean; + ClassEl: TPasClassType; begin if El=nil then exit; {$IFDEF VerbosePasAnalyzer} @@ -1818,7 +1841,18 @@ begin {$ENDIF} if El.ClassType=TPasProperty then - Prop:=TPasProperty(El) + begin + Prop:=TPasProperty(El); + if Prop.Parent is TPasClassType then + begin + ClassEl:=TPasClassType(Prop.Parent); + if (ClassEl.ObjKind=okInterface) and IsTypeInfoUsed(ClassEl) then + begin + UseFull:=true; + UseTypeInfo(Prop); + end; + end; + end else Prop:=nil; @@ -1879,7 +1913,7 @@ begin UseExpr(Prop.IndexExpr); // ToDo: Prop.Implements // ToDo: UseExpr(Prop.DispIDExpr); - // see UsePublished: Prop.StoredAccessor, Prop.DefaultExpr + // see UseTypeInfo: Prop.StoredAccessor, Prop.DefaultExpr end; end else @@ -2362,7 +2396,7 @@ end; function TPasAnalyzer.IsTypeInfoUsed(El: TPasElement): boolean; begin - Result:=FChecked[paumPublished].Find(El)<>nil; + Result:=FChecked[paumTypeInfo].Find(El)<>nil; end; function TPasAnalyzer.IsModuleInternal(El: TPasElement): boolean; @@ -2398,6 +2432,7 @@ begin or C.InheritsFrom(TPasVariable) or C.InheritsFrom(TPasProcedure) or C.InheritsFrom(TPasModule) + or (C=TPasArgument) or (C=TPasResString); end; diff --git a/packages/fcl-passrc/tests/tcuseanalyzer.pas b/packages/fcl-passrc/tests/tcuseanalyzer.pas index 3042473ee8..6b34e23243 100644 --- a/packages/fcl-passrc/tests/tcuseanalyzer.pas +++ b/packages/fcl-passrc/tests/tcuseanalyzer.pas @@ -150,6 +150,7 @@ type procedure TestWP_ClassInterface; procedure TestWP_ClassInterface_Delegation; procedure TestWP_ClassInterface_COM; + procedure TestWP_ClassInterface_Typeinfo; // scope references procedure TestSR_Proc_UnitVar; @@ -229,15 +230,21 @@ begin end; procedure TCustomTestUseAnalyzer.CheckUsedMarkers; +type + TUsed = ( + uUsed, + uNotUsed, + uTypeInfo, + uNoTypeinfo + ); var aMarker: PSrcMarker; p: SizeInt; Postfix: String; Elements: TFPList; i: Integer; - El: TPasElement; - ExpectedUsed: Boolean; - FoundEl: TPAElement; + El, FoundEl: TPasElement; + ExpectedUsed: TUsed; begin aMarker:=FirstSrcMarker; while aMarker<>nil do @@ -249,9 +256,13 @@ begin Postfix:=copy(aMarker^.Identifier,p+1); if Postfix='used' then - ExpectedUsed:=true + ExpectedUsed:=uUsed else if Postfix='notused' then - ExpectedUsed:=false + ExpectedUsed:=uNotUsed + else if Postfix='typeinfo' then + ExpectedUsed:=uTypeInfo + else if Postfix='notypeinfo' then + ExpectedUsed:=uNoTypeInfo else RaiseErrorAtSrcMarker('TCustomTestUseAnalyzer.CheckUsedMarkers unknown postfix "'+Postfix+'"',aMarker); @@ -262,18 +273,34 @@ begin begin El:=TPasElement(Elements[i]); writeln('TCustomTestUseAnalyzer.CheckUsedMarkers ',aMarker^.Identifier,' ',i,'/',Elements.Count,' El=',GetObjName(El),' ',GetObjName(El.CustomData)); - FoundEl:=Analyzer.FindElement(El); - if FoundEl<>nil then break; + case ExpectedUsed of + uUsed,uNotUsed: + if Analyzer.IsUsed(El) then + begin + FoundEl:=El; + break; + end; + uTypeInfo,uNoTypeinfo: + if Analyzer.IsTypeInfoUsed(El) then + begin + FoundEl:=El; + break; + end; + end; end; if FoundEl<>nil then - begin - if not ExpectedUsed then + case ExpectedUsed of + uNotUsed: RaiseErrorAtSrcMarker('expected element to be *not* used, but it is marked',aMarker); + uNoTypeinfo: + RaiseErrorAtSrcMarker('expected element to have *no* typeinfo, but it is marked',aMarker); end else - begin - if ExpectedUsed then + case ExpectedUsed of + uUsed: RaiseErrorAtSrcMarker('expected element to be used, but it is not marked',aMarker); + uTypeInfo: + RaiseErrorAtSrcMarker('expected element to have typeinfo, but it is not marked',aMarker); end; finally Elements.Free; @@ -2631,6 +2658,28 @@ begin AnalyzeWholeProgram; end; +procedure TTestUseAnalyzer.TestWP_ClassInterface_Typeinfo; +begin + StartProgram(false); + Add([ + '{$interfaces corba}', + 'type', + ' {#iunknown_typeinfo}IUnknown = interface', + ' function {#iunknown_getflag_typeinfo}GetFlag: boolean;', + ' procedure {#iunknown_setflag_typeinfo}SetFlag(Value: boolean);', + ' procedure {#iunknown_doit_notypeinfo}DoIt;', + ' property {#iunknown_flag_typeinfo}Flag: boolean read GetFlag write SetFlag;', + ' end;', + 'var', + ' t: pointer;', + ' i: IUnknown;', + 'begin', + ' t:=typeinfo(IUnknown);', + ' if i.Flag then ;', + '']); + AnalyzeWholeProgram; +end; + procedure TTestUseAnalyzer.TestSR_Proc_UnitVar; begin StartUnit(false); diff --git a/packages/pastojs/tests/tcfiler.pas b/packages/pastojs/tests/tcfiler.pas index bf9d642f9f..92edb07484 100644 --- a/packages/pastojs/tests/tcfiler.pas +++ b/packages/pastojs/tests/tcfiler.pas @@ -1002,6 +1002,7 @@ var begin //writeln('TCustomTestPrecompile.CheckRestoredAnalyzerElement ',GetObjName(RestAnalyzer)); if RestAnalyzer=nil then exit; + if Orig.ClassType=TPasArgument then exit; OrigUsed:=Analyzer.FindUsedElement(Orig); //writeln('TCustomTestPrecompile.CheckRestoredAnalyzerElement ',GetObjName(Orig),'=',OrigUsed<>nil,' ',GetObjName(Rest),'=',RestAnalyzer.FindUsedElement(Rest)<>nil); if OrigUsed<>nil then