fcl-passrc: useanalyzer: mark typeinfo elements as normal used too

git-svn-id: trunk@39334 -

packages/fcl-passrc/src/pasresolver.pp

@@ -234,6 +234,20 @@ ToDo:
 - TPasFileType
 - labels
 - $zerobasedstrings on|off
+- FOR_LOOP_VAR_VARPAR  passing a loop var to a var parameter gives a warning
+- FOR_VARIABLE  warning if using a global var as loop var
+- COMPARISON_FALSE COMPARISON_TRUE Comparison always evaluates to False
+- USE_BEFORE_DEF Variable '%s' might not have been initialized
+- FOR_LOOP_VAR_UNDEF FOR-Loop variable '%s' may be undefined after loop
+- TYPEINFO_IMPLICITLY_ADDED Published caused RTTI ($M+) to be added to type '%s'
+- IMPLICIT_STRING_CAST Implicit string cast from '%s' to '%s'
+- IMPLICIT_STRING_CAST_LOSS Implicit string cast with potential data loss from '%s' to '%s'
+- off by default: EXPLICIT_STRING_CAST Explicit string cast from '%s' to '%s'
+- off by default: EXPLICIT_STRING_CAST_LOSS Explicit string cast with potential data loss from '%s' to '%s'
+- IMPLICIT_INTEGER_CAST_LOSS Implicit integer cast with potential data loss from '%s' to '%s'
+- IMPLICIT_CONVERSION_LOSS Implicit conversion may lose significant digits from '%s' to '%s'
+- COMBINING_SIGNED_UNSIGNED64 Combining signed type and unsigned 64-bit type - treated as an unsigned type
+-
 
 Debug flags: -d<x>
   VerbosePasResolver
@@ -15317,6 +15331,15 @@ class function TPasResolver.GetWarnIdentifierNumbers(Identifier: string; out
     {$ENDIF}
   end;
 
+  procedure SetNumbers(Numbers: array of integer);
+  var
+    i: Integer;
+  begin
+    Setlength(MsgNumbers,length(Numbers));
+    for i:=0 to high(Numbers) do
+      MsgNumbers[i]:=Numbers[i];
+  end;
+
 begin
   if Identifier='' then exit(false);
   if Identifier[1] in ['0'..'9'] then exit(false);
@@ -15346,6 +15369,12 @@ begin
 
   // Delphi:
   'HIDDEN_VIRTUAL': SetNumber(nMethodHidesMethodOfBaseType); // method hides virtual method of ancestor
+  'GARBAGE': SetNumber(nTextAfterFinalIgnored); // text after final end.
+  'BOUNDS_ERROR': SetNumbers([nRangeCheckError,
+      nHighRangeLimitLTLowRangeLimit,
+      nRangeCheckEvaluatingConstantsVMinMax,
+      nRangeCheckInSetConstructor]);
+  'MESSAGE_DIRECTIVE': SetNumber(nUserDefined); // $message directive
   else
     Result:=false;
   end;

packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -865,7 +865,6 @@ begin
       begin
       Member:=TPasElement(Members[i]);
       UseSubEl(Member);
-      UseElement(Member,rraNone,true);
       end;
     end
   else if C.InheritsFrom(TPasProcedure) then
@@ -885,6 +884,8 @@ begin
     {$ENDIF}
     RaiseNotSupported(20170414153904,El);
     end;
+
+  UseElement(El,rraNone,true);
 end;
 
 procedure TPasAnalyzer.UseModule(aModule: TPasModule; Mode: TPAUseMode);
@@ -1236,6 +1237,8 @@ begin
           {$IFDEF VerbosePasAnalyzer}
           writeln('TPasAnalyzer.UseExpr typeinfo ',GetResolverResultDbg(ParamResolved));
           {$ENDIF}
+          if ParamResolved.IdentEl=nil then
+            RaiseNotSupported(20180628155107,Params[0]);
           if ParamResolved.IdentEl is TPasFunction then
             begin
             SubEl:=TPasFunction(ParamResolved.IdentEl).FuncType.ResultEl.ResultType;
@@ -1548,6 +1551,8 @@ begin
       begin
       if not MarkElementAsUsed(El) then exit;
       UseElType(El,TPasAliasType(El).DestType,Mode);
+      if C=TPasTypeAliasType then
+        UseExpr(TPasTypeAliasType(El).Expr);
       end
     else if C=TPasArrayType then
       begin
@@ -1585,6 +1590,9 @@ begin
       UseProcedureType(TPasProcedureType(El),true)
     else
       RaiseNotSupported(20170306170315,El);
+
+    if Mode=paumAllPasUsable then
+      UseTypeInfo(El);
     end;
 end;
 
@@ -1772,7 +1780,8 @@ begin
     else if IsModuleInternal(Member) then
       // private or strict private
       continue
-    else if (Mode=paumAllPasUsable) and FirstTime and (Member.ClassType=TPasProperty) then
+    else if (Mode=paumAllPasUsable) and FirstTime
+        and ((Member.ClassType=TPasProperty) or (Member is TPasType)) then
       begin
       // non private property can be used by typeinfo by descendants in other units
       UseTypeInfo(Member);

packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -61,6 +61,7 @@ type
     procedure TestM_RepeatUntilStatement;
     procedure TestM_TryFinallyStatement;
     procedure TestM_TypeAlias;
+    procedure TestM_TypeAliasTypeInfo;
     procedure TestM_RangeType;
     procedure TestM_Unary;
     procedure TestM_Const;
@@ -149,6 +150,7 @@ type
     procedure TestWP_BuiltInFunctions;
     procedure TestWP_TypeInfo;
     procedure TestWP_TypeInfo_PropertyEnumType;
+    procedure TestWP_TypeInfo_Alias;
     procedure TestWP_ForInClass;
     procedure TestWP_AssertSysUtils;
     procedure TestWP_RangeErrorSysUtils;
@@ -744,6 +746,24 @@ begin
   AnalyzeProgram;
 end;
 
+procedure TTestUseAnalyzer.TestM_TypeAliasTypeInfo;
+begin
+  StartUnit(false);
+  Add([
+  'interface',
+  'type',
+  '  {#integer_typeinfo}integer = type longint;',
+  '  {tobject_used}TObject = class',
+  '  private',
+  '    type {#tcolor_notypeinfo}tcolor = type longint;',
+  '  protected',
+  '    type {#tsize_typeinfo}tsize = type longint;',
+  '  end;',
+  'implementation',
+  '']);
+  AnalyzeUnit;
+end;
+
 procedure TTestUseAnalyzer.TestM_RangeType;
 begin
   StartProgram(false);
@@ -2562,6 +2582,52 @@ begin
   AnalyzeWholeProgram;
 end;
 
+procedure TTestUseAnalyzer.TestWP_TypeInfo_Alias;
+begin
+  AddModuleWithIntfImplSrc('mysystem.pp',
+    LinesToStr([
+    'type',
+    '  integer = longint;',
+    '  PTypeInfo = pointer;',
+    '  {#tdatetime_typeinfo}TDateTime = type double;',
+    '']),
+    '');
+  AddModuleWithIntfImplSrc('unit1.pp',
+    LinesToStr([
+    'uses mysystem;',
+    'type',
+    '  {#ttime_typeinfo}TTime = type TDateTime;',
+    '  TDate = TDateTime;',
+    'var',
+    '  dt: TDateTime;',
+    '  t: TTime;',
+    '  d: TDate;',
+    '  TI: PTypeInfo;',
+    '']),'');
+  AddModuleWithIntfImplSrc('unit2.pp',
+    LinesToStr([
+    'uses unit1;',
+    '']),
+    LinesToStr([
+    'initialization',
+    '  dt:=1.0;',
+    '  t:=2.0;',
+    '  d:=3.0;',
+    '  ti:=typeinfo(dt);',
+    '  ti:=typeinfo(t);',
+    '  ti:=typeinfo(d);',
+    '']));
+  StartProgram(true);
+  Add([
+    'uses mysystem, unit2;',
+    'var',
+    '  PInfo: PTypeInfo;',
+    'begin',
+    '  PInfo:=typeinfo(TDateTime);',
+    'end.']);
+  AnalyzeWholeProgram;
+end;
+
 procedure TTestUseAnalyzer.TestWP_ForInClass;
 begin
   StartProgram(false);