Browse Source

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

mattias 6 years ago
parent
commit
bee5c88aeb

+ 12 - 0
compiler/packages/fcl-passrc/src/pasresolver.pp

@@ -5747,7 +5747,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];

+ 23 - 0
compiler/packages/fcl-passrc/src/pastree.pp

@@ -605,6 +605,8 @@ type
   { TPasArrayType }
 
   TPasArrayType = class(TPasType)
+  protected
+    procedure SetParent(const AValue: TPasElement); override;
   public
     destructor Destroy; override;
     function ElementTypeName: string; override;
@@ -2856,6 +2858,27 @@ 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

+ 3 - 0
compiler/packages/fcl-passrc/src/pparser.pp

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

+ 9 - 0
compiler/packages/fcl-passrc/tests/tcresolver.pas

@@ -756,6 +756,7 @@ type
 
     // arrays
     Procedure TestDynArrayOfLongint;
+    Procedure TestDynArrayOfSelfFail;
     Procedure TestStaticArray;
     Procedure TestStaticArrayOfChar;
     Procedure TestStaticArrayOfCharDelphi;
@@ -13522,6 +13523,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);