Browse Source

* Fix memory leaks

Michaël Van Canneyt 1 year ago
parent
commit
9247957477
1 changed files with 119 additions and 60 deletions
  1. 119 60
      packages/rtl-objpas/src/inc/rtti.pp

+ 119 - 60
packages/rtl-objpas/src/inc/rtti.pp

@@ -548,14 +548,18 @@ type
     FOffset: Integer;
     FOffset: Integer;
     FName : String;
     FName : String;
     FHandle : PExtendedFieldEntry;
     FHandle : PExtendedFieldEntry;
+    FAttributes: TCustomAttributeArray;
+    FAttributesResolved : Boolean;
     function GetName: string; override;
     function GetName: string; override;
     function GetDataType: TRttiType; override;
     function GetDataType: TRttiType; override;
     function GetIsReadable: Boolean; override;
     function GetIsReadable: Boolean; override;
     function GetIsWritable: Boolean; override;
     function GetIsWritable: Boolean; override;
     function GetHandle: Pointer; override;
     function GetHandle: Pointer; override;
     Function GetAttributes: TCustomAttributeArray; override;
     Function GetAttributes: TCustomAttributeArray; override;
+    procedure ResolveAttributes;
 //    constructor Create(AParent: TRttiObject; var P: PByte); override;
 //    constructor Create(AParent: TRttiObject; var P: PByte); override;
   public
   public
+    destructor destroy; override;
     function GetValue(aInstance: Pointer): TValue; override;
     function GetValue(aInstance: Pointer): TValue; override;
     procedure SetValue(aInstance: Pointer; const aValue: TValue); override;
     procedure SetValue(aInstance: Pointer; const aValue: TValue); override;
     function ToString: string; override;
     function ToString: string; override;
@@ -1205,12 +1209,12 @@ type
   TRttiInstanceMethod = class(TRttiMethod)
   TRttiInstanceMethod = class(TRttiMethod)
   private
   private
     FHandle: PVmtMethodExEntry;
     FHandle: PVmtMethodExEntry;
-    FIndex : integer;
     // False: without hidden, true: with hidden
     // False: without hidden, true: with hidden
     FParams : Array [Boolean] of TRttiParameterArray;
     FParams : Array [Boolean] of TRttiParameterArray;
     FAttributesResolved: boolean;
     FAttributesResolved: boolean;
     FAttributes: TCustomAttributeArray;
     FAttributes: TCustomAttributeArray;
     procedure ResolveParams;
     procedure ResolveParams;
+    procedure ResolveAttributes;
   protected
   protected
     function GetHandle: Pointer; override;
     function GetHandle: Pointer; override;
     function GetName: String; override;
     function GetName: String; override;
@@ -1826,7 +1830,7 @@ begin
   Result:=FHandle^.VmtIndex;
   Result:=FHandle^.VmtIndex;
 end;
 end;
 
 
-Procedure TRttiInstanceMethod.ResolveParams;
+procedure TRttiInstanceMethod.ResolveParams;
 
 
 var
 var
   param: PVmtMethodParam;
   param: PVmtMethodParam;
@@ -1851,7 +1855,7 @@ begin
       else
       else
         begin
         begin
         prtti := TRttiVmtMethodParameter.Create(param);
         prtti := TRttiVmtMethodParameter.Create(param);
-        context.AddObject(FParams[True][total]);
+        context.AddObject(prtti);
         end;
         end;
       FParams[True][total]:=prtti;
       FParams[True][total]:=prtti;
       if not (pfHidden in param^.Flags) then
       if not (pfHidden in param^.Flags) then
@@ -1859,11 +1863,9 @@ begin
         FParams[False][visible] := prtti;
         FParams[False][visible] := prtti;
         Inc(visible);
         Inc(visible);
       end;
       end;
-
       param := param^.Next;
       param := param^.Next;
       Inc(total);
       Inc(total);
     end;
     end;
-
     if visible <> total then
     if visible <> total then
       SetLength(FParams[False], visible);
       SetLength(FParams[False], visible);
   finally
   finally
@@ -1871,6 +1873,12 @@ begin
   end;
   end;
 end;
 end;
 
 
+procedure TRttiInstanceMethod.ResolveAttributes;
+begin
+  FAttributesResolved:=True;
+  // Todo !!
+end;
+
 function TRttiInstanceMethod.GetParameters(aWithHidden: Boolean): TRttiParameterArray;
 function TRttiInstanceMethod.GetParameters(aWithHidden: Boolean): TRttiParameterArray;
 begin
 begin
   if  (Length(FParams[aWithHidden]) > 0) then
   if  (Length(FParams[aWithHidden]) > 0) then
@@ -1889,7 +1897,9 @@ end;
 
 
 function TRttiInstanceMethod.GetAttributes: TCustomAttributeArray;
 function TRttiInstanceMethod.GetAttributes: TCustomAttributeArray;
 begin
 begin
-  Result:=Nil;
+  if not FAttributesResolved then
+    ResolveAttributes;
+  Result:=FAttributes;
 end;
 end;
 
 
 { TRttiPool }
 { TRttiPool }
@@ -5829,37 +5839,43 @@ var
 begin
 begin
   NameIndexes:=[];
   NameIndexes:=[];
   IdxCount:=0;
   IdxCount:=0;
+  List:=Nil;
   aCount:=GetPropListEx(FTypeinfo,List);
   aCount:=GetPropListEx(FTypeinfo,List);
-  SetLength(FProperties,aCount);
-  SetLength(NameIndexes,aCount);
-  For I:=0 to aCount-1 do
-    begin
-    Info:=List^[I];
-    TP:=Info^.Info;
-    // Don't overwrite properties with the same name
-    // We cannot use NameIndex directly, because there may be classes in
-    // the hierarchy which do not have RTTI for properties, but they are
-    // still used for the NameIndex, so nameindex can be bigger than property count.
-    Idx:=IndexOfNameIndex(TP^.NameIndex);
-    if Idx<>-1 then
-      Prop:=FProperties[Idx]
-    else
+  try
+    SetLength(FProperties,aCount);
+    SetLength(NameIndexes,aCount);
+    For I:=0 to aCount-1 do
       begin
       begin
-      NameIndexes[IdxCount]:=TP^.NameIndex;
-      Inc(IdxCount);
-      obj := GRttiPool[FUsePublishedOnly].GetByHandle(TP);
-      if Assigned(obj) then
-        FProperties[I]:=obj as TRttiProperty
+      Info:=List^[I];
+      TP:=Info^.Info;
+      // Don't overwrite properties with the same name
+      // We cannot use NameIndex directly, because there may be classes in
+      // the hierarchy which do not have RTTI for properties, but they are
+      // still used for the NameIndex, so nameindex can be bigger than property count.
+      Idx:=IndexOfNameIndex(TP^.NameIndex);
+      if Idx<>-1 then
+        Prop:=FProperties[Idx]
       else
       else
         begin
         begin
-        Prop:=TRttiProperty.Create(Self, TP);
-        FProperties[I]:=Prop;
-        GRttiPool[FUsePublishedOnly].AddObject(Prop);
+        NameIndexes[IdxCount]:=TP^.NameIndex;
+        Inc(IdxCount);
+        obj := GRttiPool[FUsePublishedOnly].GetByHandle(TP);
+        if Assigned(obj) then
+          FProperties[I]:=obj as TRttiProperty
+        else
+          begin
+          Prop:=TRttiProperty.Create(Self, TP);
+          FProperties[I]:=Prop;
+          GRttiPool[FUsePublishedOnly].AddObject(Prop);
+          end;
         end;
         end;
+      Prop.FVisibility:=MemberVisibilities[Info^.Visibility];
+      Prop.FStrictVisibility:=Info^.StrictVisibility;
       end;
       end;
-    Prop.FVisibility:=MemberVisibilities[Info^.Visibility];
-    Prop.FStrictVisibility:=Info^.StrictVisibility;
-    end;
+  finally
+    if Assigned(List) then
+      FreeMem(List);
+  end;
 end;
 end;
 
 
 Procedure TRttiInstanceType.ResolveClassicProperties;
 Procedure TRttiInstanceType.ResolveClassicProperties;
@@ -5933,6 +5949,7 @@ Var
   Ctx : TRttiContext;
   Ctx : TRttiContext;
 
 
 begin
 begin
+  Tbl:=Nil;
   Len:=GetFieldList(FTypeInfo,Tbl);
   Len:=GetFieldList(FTypeInfo,Tbl);
   SetLength(FFields,Len);
   SetLength(FFields,Len);
   FFieldsResolved:=True;
   FFieldsResolved:=True;
@@ -5956,6 +5973,8 @@ begin
       Ctx.AddObject(Fld);
       Ctx.AddObject(Fld);
       end;
       end;
   finally
   finally
+    if Assigned(Tbl) then
+      FreeMem(Tbl);
     Ctx.Free;
     Ctx.Free;
   end;
   end;
 end;
 end;
@@ -5970,6 +5989,7 @@ Var
   Ctx : TRttiContext;
   Ctx : TRttiContext;
 
 
 begin
 begin
+  tbl:=Nil;
   Ctx:=TRttiContext.Create;
   Ctx:=TRttiContext.Create;
   try
   try
     Ctx.UsePublishedOnly:=False;
     Ctx.UsePublishedOnly:=False;
@@ -5998,12 +6018,15 @@ begin
           Meth.FUsePublishedOnly:=Self.FUsePublishedOnly;
           Meth.FUsePublishedOnly:=Self.FUsePublishedOnly;
           Meth.FVisibility:=MemberVisibilities[aData^.MethodVisibility];
           Meth.FVisibility:=MemberVisibilities[aData^.MethodVisibility];
           Meth.FStrictVisibility:=aData^.StrictVisibility;
           Meth.FStrictVisibility:=aData^.StrictVisibility;
+          Ctx.AddObject(Meth);
           end;
           end;
         FDeclaredMethods[Idx]:=Meth;
         FDeclaredMethods[Idx]:=Meth;
         Inc(Idx);
         Inc(Idx);
         end;
         end;
       end;
       end;
   finally
   finally
+    if assigned(Tbl) then
+      FreeMem(Tbl);
     Ctx.Free;
     Ctx.Free;
   end;
   end;
 end;
 end;
@@ -6033,6 +6056,7 @@ Var
   Ctx : TRttiContext;
   Ctx : TRttiContext;
 
 
 begin
 begin
+  Tbl:=Nil;
   Len:=GetFieldList(FTypeInfo,Tbl);
   Len:=GetFieldList(FTypeInfo,Tbl);
   SetLength(FFields,Len);
   SetLength(FFields,Len);
   FFieldsResolved:=True;
   FFieldsResolved:=True;
@@ -6044,18 +6068,23 @@ begin
     For I:=0 to Len-1 do
     For I:=0 to Len-1 do
       begin
       begin
       aData:=Tbl^[i];
       aData:=Tbl^[i];
-      Fld:=TRttiField.Create(Self);
+      Fld:=TRttiField(Ctx.GetByHandle(aData));
+      if Fld=Nil then
+        begin
+        Fld:=TRttiField.Create(Self);
+        Fld.FName:=aData^.Name^;
+        Fld.FOffset:=aData^.FieldOffset;
+        Fld.FFieldType:=Ctx.GetType(aData^.FieldType^);
+        Fld.FVisibility:=MemberVisibilities[aData^.FieldVisibility];
+        Fld.FStrictVisibility:=aData^.StrictVisibility;
+        Fld.FHandle:=aData;
+        Ctx.AddObject(Fld);
+        end;
       FFields[I]:=Fld;
       FFields[I]:=Fld;
-      Fld.FName:=aData^.Name^;
-      Fld.FOffset:=aData^.FieldOffset;
-      Fld.FFieldType:=Ctx.GetType(aData^.FieldType^);
-      Fld.FVisibility:=MemberVisibilities[aData^.FieldVisibility];
-      Fld.FStrictVisibility:=aData^.StrictVisibility;
-      Fld.FHandle:=aData;
-      // Some way to set the attributes is needed.
-      Ctx.AddObject(Fld);
       end;
       end;
   finally
   finally
+    if assigned(Tbl) then
+      FreeMem(Tbl);
     Ctx.Free;
     Ctx.Free;
   end;
   end;
 end;
 end;
@@ -6098,12 +6127,15 @@ begin
           Meth.FUsePublishedOnly:=Self.FUsePublishedOnly;
           Meth.FUsePublishedOnly:=Self.FUsePublishedOnly;
           Meth.FVisibility:=MemberVisibilities[aData^.MethodVisibility];
           Meth.FVisibility:=MemberVisibilities[aData^.MethodVisibility];
           Meth.FStrictVisibility:=aData^.StrictVisibility;
           Meth.FStrictVisibility:=aData^.StrictVisibility;
+          Ctx.AddObject(Meth)
           end;
           end;
         FDeclaredMethods[Idx]:=Meth;
         FDeclaredMethods[Idx]:=Meth;
         Inc(Idx);
         Inc(Idx);
         end;
         end;
       end;
       end;
   finally
   finally
+    if assigned(Tbl) then
+      FreeMem(Tbl);
     Ctx.Free;
     Ctx.Free;
   end;
   end;
 end;
 end;
@@ -6119,24 +6151,30 @@ var
   obj: TRttiObject;
   obj: TRttiObject;
 
 
 begin
 begin
+  List:=Nil;
   aCount:=GetPropListEx(FTypeinfo,List);
   aCount:=GetPropListEx(FTypeinfo,List);
-  SetLength(FProperties,aCount);
-  For I:=0 to aCount-1 do
-    begin
-    Info:=List^[I];
-    TP:=Info^.Info;
-    obj:=GRttiPool[FUsePublishedOnly].GetByHandle(TP);
-    if Assigned(obj) then
-      FProperties[I]:=obj as TRttiProperty
-    else
+  try
+    SetLength(FProperties,aCount);
+    For I:=0 to aCount-1 do
       begin
       begin
-      Prop:=TRttiProperty.Create(Self, TP);
-      FProperties[I]:=Prop;
-      GRttiPool[FUsePublishedOnly].AddObject(Prop);
+      Info:=List^[I];
+      TP:=Info^.Info;
+      obj:=GRttiPool[FUsePublishedOnly].GetByHandle(TP);
+      if Assigned(obj) then
+        FProperties[I]:=obj as TRttiProperty
+      else
+        begin
+        Prop:=TRttiProperty.Create(Self, TP);
+        FProperties[I]:=Prop;
+        GRttiPool[FUsePublishedOnly].AddObject(Prop);
+        end;
+      Prop.FVisibility:=MemberVisibilities[Info^.Visibility];
+      Prop.FStrictVisibility:=Info^.StrictVisibility;
       end;
       end;
-    Prop.FVisibility:=MemberVisibilities[Info^.Visibility];
-    Prop.FStrictVisibility:=Info^.StrictVisibility;
-    end;
+  finally
+    if assigned(List) then
+      FreeMem(List);
+  end;
 end;
 end;
 
 
 function TRttiRecordType.GetTypeSize: Integer;
 function TRttiRecordType.GetTypeSize: Integer;
@@ -6523,20 +6561,41 @@ begin
   Result:=FHandle;
   Result:=FHandle;
 end;
 end;
 
 
-function TRttiField.GetAttributes: TCustomAttributeArray;
+destructor TRttiField.destroy;
+
+var
+  Attr : TCustomAttribute;
+  I : Integer;
+
+begin
+  For I:=0 to Length(FAttributes)-1 do
+    FAttributes[i].Free;
+  Inherited;
+end;
+
+Procedure TRttiField.ResolveAttributes;
 
 
 var
 var
   tbl : PAttributeTable;
   tbl : PAttributeTable;
   i : Integer;
   i : Integer;
 
 
 begin
 begin
-  Result:=[];
+  FAttributesResolved:=True;
+  Fattributes:=[];
   tbl:=FHandle^.AttributeTable;
   tbl:=FHandle^.AttributeTable;
   if not (assigned(Tbl) and (Tbl^.AttributeCount>0)) then
   if not (assigned(Tbl) and (Tbl^.AttributeCount>0)) then
     exit;
     exit;
-  SetLength(Result,Tbl^.AttributeCount);
-  For I:=0 to Length(Result)-1 do
-    Result[I]:={$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}TypInfo.GetAttribute(Tbl,I);
+  SetLength(FAttributes,Tbl^.AttributeCount);
+  For I:=0 to Length(FAttributes)-1 do
+    FAttributes[I]:={$IFDEF FPC_DOTTEDUNITS}System.{$ENDIF}TypInfo.GetAttribute(Tbl,I);
+end;
+
+function TRttiField.GetAttributes: TCustomAttributeArray;
+
+begin
+  if not FAttributesResolved then
+    ResolveAttributes;
+  Result:=FAttributes;
 end;
 end;
 
 
 function TRttiField.GetValue(aInstance: Pointer): TValue;
 function TRttiField.GetValue(aInstance: Pointer): TValue;