ソースを参照

fcl-passrc: fixed specialize while-do and with-do

git-svn-id: trunk@45535 -
Mattias Gaertner 5 年 前
コミット
9c8fc6bcf5

+ 5 - 1
packages/fcl-passrc/src/pasresolver.pp

@@ -17746,6 +17746,10 @@ var
   GenExpr, SpecExpr: TPasExpr;
   GenExpr, SpecExpr: TPasExpr;
   NewClass: TPTreeElement;
   NewClass: TPTreeElement;
 begin
 begin
+  if SpecEl.CustomData<>nil then
+    RaiseNotYetImplemented(20200530201007,GenEl,GetObjName(SpecEl.CustomData));
+  PushScope(SpecEl,TPasWithScope);
+
   for i:=0 to GenEl.Expressions.Count-1 do
   for i:=0 to GenEl.Expressions.Count-1 do
     begin
     begin
     GenExpr:=TPasExpr(GenEl.Expressions[i]);
     GenExpr:=TPasExpr(GenEl.Expressions[i]);
@@ -17754,8 +17758,8 @@ begin
     NewClass:=TPTreeElement(GenExpr.ClassType);
     NewClass:=TPTreeElement(GenExpr.ClassType);
     SpecExpr:=TPasExpr(NewClass.Create(GenExpr.Name,SpecEl));
     SpecExpr:=TPasExpr(NewClass.Create(GenExpr.Name,SpecEl));
     SpecEl.Expressions.Add(SpecExpr);
     SpecEl.Expressions.Add(SpecExpr);
-    BeginScope(stWithExpr,SpecExpr);
     SpecializeElement(GenExpr,SpecExpr);
     SpecializeElement(GenExpr,SpecExpr);
+    BeginScope(stWithExpr,SpecExpr);
     end;
     end;
   SpecializeElImplEl(GenEl,SpecEl,GenEl.Body,SpecEl.Body);
   SpecializeElImplEl(GenEl,SpecEl,GenEl.Body,SpecEl.Body);
 
 

+ 2 - 2
packages/fcl-passrc/src/pasuseanalyzer.pas

@@ -1558,7 +1558,7 @@ begin
     begin
     begin
     // while-do
     // while-do
     UseExpr(TPasImplWhileDo(El).ConditionExpr);
     UseExpr(TPasImplWhileDo(El).ConditionExpr);
-    UseImplBlock(TPasImplWhileDo(El),false);
+    UseImplElement(TPasImplWhileDo(El).Body);
     end
     end
   else if C=TPasImplWithDo then
   else if C=TPasImplWithDo then
     begin
     begin
@@ -1566,7 +1566,7 @@ begin
     WithDo:=TPasImplWithDo(El);
     WithDo:=TPasImplWithDo(El);
     for i:=0 to WithDo.Expressions.Count-1 do
     for i:=0 to WithDo.Expressions.Count-1 do
       UseExpr(TObject(WithDo.Expressions[i]) as TPasExpr);
       UseExpr(TObject(WithDo.Expressions[i]) as TPasExpr);
-    UseImplBlock(WithDo,false);
+    UseImplElement(WithDo.Body);
     end
     end
   else if C=TPasImplExceptOn then
   else if C=TPasImplExceptOn then
     begin
     begin

+ 44 - 0
packages/fcl-passrc/tests/tcuseanalyzer.pas

@@ -135,6 +135,7 @@ type
     procedure TestM_Hint_FunctionResultExit;
     procedure TestM_Hint_FunctionResultExit;
     procedure TestM_Hint_AbsoluteVar;
     procedure TestM_Hint_AbsoluteVar;
     procedure TestM_Hint_GenFunctionResultArgNotUsed;
     procedure TestM_Hint_GenFunctionResultArgNotUsed;
+    procedure TestM_Hint_GenFunc_LocalInsideImplUsed;
 
 
     // whole program optimization
     // whole program optimization
     procedure TestWP_LocalVar;
     procedure TestWP_LocalVar;
@@ -2306,6 +2307,49 @@ begin
   CheckUseAnalyzerUnexpectedHints;
   CheckUseAnalyzerUnexpectedHints;
 end;
 end;
 
 
+procedure TTestUseAnalyzer.TestM_Hint_GenFunc_LocalInsideImplUsed;
+begin
+  StartProgram(true,[supTObject]);
+  Add([
+  '{$mode delphi}',
+  'procedure Run<T>;',
+  'var',
+  '  WhileV: T;',
+  '  RepeatV: T;',
+  '  ForR, ForV: T;',
+  '  IfCond: boolean;',
+  '  IfThenV,IfElseV: T;',
+  '  CaseV, CaseSt, CaseElse: T;',
+  '  TryFinallyV, TryFinallyX: T;',
+  '  TryExceptV, TryExceptOn, TryExceptElse: T;',
+  '  WithExpr: TObject;',
+  '  WithV: T;',
+  'begin',
+  '  while true do WhileV:=WhileV+1;',
+  '  repeat RepeatV:=RepeatV+1; until false;',
+  '  for ForR:=1 to 3 do ForV:=ForV+1;',
+  '  if IfCond then IfThenV:=IfThenV+1 else IfElseV:=IfElseV+1;',
+  '  case CaseV of',
+  '  1: CaseSt:=CaseSt+1;',
+  '  else',
+  '    CaseElse:=CaseElse+1;',
+  '  end;',
+  '  try TryFinallyV:=TryFinallyV+1; finally TryFinallyX:=TryFinallyX+1; end;',
+  '  try',
+  '    TryExceptV:=TryExceptV+1;',
+  '  except',
+  '  on TryExceptE: TObject do TryExceptOn:=TryExceptOn+1;',
+  '  else',
+  '    TryExceptElse:=TryExceptElse+1;',
+  '  end;',
+  '  with WithExpr do WithV:=WithV+1',
+  'end;',
+  'begin',
+  '  Run<word>();']);
+  AnalyzeProgram;
+  CheckUseAnalyzerUnexpectedHints;
+end;
+
 procedure TTestUseAnalyzer.TestWP_LocalVar;
 procedure TTestUseAnalyzer.TestWP_LocalVar;
 begin
 begin
   StartProgram(false);
   StartProgram(false);