fcl-passrc: resolver: fixed type TArr = array of TArr

git-svn-id: trunk@42598 -

packages/fcl-passrc/src/pasresolver.pp

@@ -5973,7 +5973,19 @@ var
   Expr: TPasExpr;
   RangeResolved: TPasResolverResult;
   TypeEl: TPasType;
+  Parent: TPasArrayType;
 begin
+  // check cycles
+  Parent:=El;
+  repeat
+    if Parent=El.ElType then
+      RaiseMsg(20190807104630,nIllegalExpression,sIllegalExpression,[],El);
+    if Parent.Parent is TPasArrayType then
+      Parent:=TPasArrayType(Parent.Parent)
+    else
+      break;
+  until false;
+
   for i:=0 to length(El.Ranges)-1 do
     begin
     Expr:=El.Ranges[i];

packages/fcl-passrc/src/pastree.pp

@@ -636,6 +636,8 @@ type
   { TPasArrayType }
 
   TPasArrayType = class(TPasGenericType)
+  protected
+    procedure SetParent(const AValue: TPasElement); override;
   public
     destructor Destroy; override;
     function ElementTypeName: string; override;
@@ -3132,6 +3134,28 @@ begin
   inherited Destroy;
 end;
 
+procedure TPasArrayType.SetParent(const AValue: TPasElement);
+var
+  CurArr: TPasArrayType;
+begin
+  if (AValue=nil) and (Parent<>nil) then
+    begin
+    // parent is cleared
+    // -> clear all references to this array (releasing loops)
+    CurArr:=Self;
+    while CurArr.ElType is TPasArrayType do
+      begin
+      if CurArr.ElType=Self then
+        begin
+        ReleaseAndNil(TPasElement(CurArr.ElType){$IFDEF CheckPasTreeRefCount},'TPasClassType.AncestorType'{$ENDIF});
+        break;
+        end;
+      CurArr:=TPasArrayType(CurArr.ElType);
+      end;
+    end;
+  inherited SetParent(AValue);
+end;
+
 destructor TPasArrayType.Destroy;
 var
   i: Integer;

packages/fcl-passrc/src/pparser.pp

@@ -1991,7 +1991,10 @@ begin
     ok:=true;
   finally
     if not ok then
+      begin
+      Result.Parent:=nil;
       Result.Release{$IFDEF CheckPasTreeRefCount}('CreateElement'){$ENDIF};
+      end;
   end;
 end;
 

packages/fcl-passrc/tests/tcresolvegenerics.pas

@@ -330,7 +330,8 @@ begin
   '  l:=p;',
   '  p:=l;',
   '  Result:=p;',
-  //'  Result:=l;',
+  '  Result:=l;',
+  '  l:=Result;',
   'end;',
   'var',
   '  b: specialize TBird<word>;',

packages/fcl-passrc/tests/tcresolver.pas

@@ -763,6 +763,7 @@ type
 
     // arrays
     Procedure TestDynArrayOfLongint;
+    Procedure TestDynArrayOfSelfFail;
     Procedure TestStaticArray;
     Procedure TestStaticArrayOfChar;
     Procedure TestStaticArrayOfCharDelphi;
@@ -13756,6 +13757,14 @@ begin
   ParseProgram;
 end;
 
+procedure TTestResolver.TestDynArrayOfSelfFail;
+begin
+  StartProgram(false);
+  Add('type TIntArray = array of TIntArray;');
+  Add('begin');
+  CheckResolverException(sIllegalExpression,nIllegalExpression);
+end;
+
 procedure TTestResolver.TestStaticArray;
 begin
   StartProgram(false);