From 9dcd897ce630bf5d3e9b94f9e47b5c9c26726db8 Mon Sep 17 00:00:00 2001
From: svenbarth <pascaldragon@googlemail.com>
Date: Mon, 21 Oct 2019 19:42:19 +0000
Subject: [PATCH] * fix for Mantis #36196: free a property's attributes when
 the property is destroyed + added test

git-svn-id: trunk@43299 -
---
 .gitattributes                      |   1 +
 packages/rtl-objpas/src/inc/rtti.pp |  10 ++
 tests/webtbs/tw36196.pp             | 159 ++++++++++++++++++++++++++++
 3 files changed, 170 insertions(+)
 create mode 100644 tests/webtbs/tw36196.pp

diff --git a/.gitattributes b/.gitattributes
index e163f7a1ba..da45960939 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -17846,6 +17846,7 @@ tests/webtbs/tw36156.pp svneol=native#text/plain
 tests/webtbs/tw36157.pp svneol=native#text/plain
 tests/webtbs/tw3617.pp svneol=native#text/plain
 tests/webtbs/tw3619.pp svneol=native#text/plain
+tests/webtbs/tw36196.pp svneol=native#text/pascal
 tests/webtbs/tw3621.pp svneol=native#text/plain
 tests/webtbs/tw3628.pp svneol=native#text/plain
 tests/webtbs/tw3634.pp svneol=native#text/plain
diff --git a/packages/rtl-objpas/src/inc/rtti.pp b/packages/rtl-objpas/src/inc/rtti.pp
index 32eb0a9676..9572060fd7 100644
--- a/packages/rtl-objpas/src/inc/rtti.pp
+++ b/packages/rtl-objpas/src/inc/rtti.pp
@@ -331,6 +331,7 @@ type
     function GetHandle: Pointer; override;
   public
     constructor Create(AParent: TRttiType; APropInfo: PPropInfo);
+    destructor Destroy; override;
     function GetAttributes: specialize TArray<TCustomAttribute>; override;
     function GetValue(Instance: pointer): TValue;
     procedure SetValue(Instance: pointer; const AValue: TValue);
@@ -3749,6 +3750,15 @@ begin
   FPropInfo := APropInfo;
 end;
 
+destructor TRttiProperty.Destroy;
+var
+  attr: TCustomAttribute;
+begin
+  for attr in FAttributes do
+    attr.Free;
+  inherited Destroy;
+end;
+
 function TRttiProperty.GetAttributes: specialize TArray<TCustomAttribute>;
 var
   i: SizeInt;
diff --git a/tests/webtbs/tw36196.pp b/tests/webtbs/tw36196.pp
new file mode 100644
index 0000000000..0c1139ce10
--- /dev/null
+++ b/tests/webtbs/tw36196.pp
@@ -0,0 +1,159 @@
+{ %OPT=-gh }
+
+program tw36196;
+
+{$mode objfpc}{$H+}
+{$modeswitch prefixedattributes}
+
+uses
+  {heaptrc, }SysUtils, typinfo, {%H-}rtti;
+
+type
+
+  IntRangeAttribute = class(TCustomAttribute)
+  private
+    FMinValue,
+    FMaxValue: Integer;
+  public
+    constructor Create(aMin, aMax: Integer);
+    property MinValue: Integer read FMinValue;
+    property MaxValue: Integer read FMaxValue;
+  end;
+
+  DefaultStrAttribute = class(TCustomAttribute)
+  private
+    FValue: string;
+  public
+    constructor Create;
+    constructor Create(const aValue: string);
+    property Value: string read FValue;
+  end;
+
+  CheckAttribute = class(TCustomAttribute)
+  private
+    FChecked: Boolean;
+  public
+    constructor Create;
+    constructor Create(aValue: Boolean);
+    property Checked: Boolean read FChecked;
+  end;
+
+  [Check(True)]
+  TMyClass = class
+  private
+    FName,
+    FDescr: string;
+    FId: Integer;
+  published
+    [DefaultStr]
+    property Name: string read FName write FName;
+    [DefaultStr('nice description')]
+    property Description: string read FDescr write FDescr;
+    [IntRange(100, 10000)]
+    property Id: Integer read FId write FId;
+  end;
+
+  [DefaultStr('this is TMyRec')][IntRange(0, 100)]
+  TMyRec = record
+    Name: string;
+    Value: Integer;
+  end;
+
+  [Check][IntRange(-10000, 10000)]
+  TMyInt = type Integer;
+
+{ CheckAttribute }
+
+constructor CheckAttribute.Create;
+begin
+  FChecked := False;
+end;
+
+constructor CheckAttribute.Create(aValue: Boolean);
+begin
+  FChecked := aValue;
+end;
+
+{ DefaultStrAttribute }
+
+constructor DefaultStrAttribute.Create;
+begin
+  FValue := 'Unassigned';
+end;
+
+constructor DefaultStrAttribute.Create(const aValue: string);
+begin
+  FValue := aValue;
+end;
+
+{ TIntRangeAttribute }
+
+constructor IntRangeAttribute.Create(aMin, aMax: Integer);
+begin
+  FMinValue := aMin;
+  FMaxValue := aMax;
+end;
+
+procedure PrintAttribute(Attr: TCustomAttribute);
+begin
+  if not Assigned(Attr) then
+    exit;
+  WriteLn('  Found attribute ', Attr.ClassName, ':');
+  if Attr is DefaultStrAttribute then
+    WriteLn('    property Value has value "', DefaultStrAttribute(Attr).Value, '"')
+  else
+    if Attr is IntRangeAttribute then
+      begin
+        WriteLn('    property MinValue has value ', IntRangeAttribute(Attr).MinValue);
+        WriteLn('    property MaxValue has value ', IntRangeAttribute(Attr).MaxValue);
+      end
+    else
+      if Attr is CheckAttribute then
+        WriteLn('    property Checked has value ', CheckAttribute(Attr).Checked);
+end;
+
+procedure PrintClassAttributes(aClass: TClass);
+var
+ RCtx: TRttiContext;
+ RType: TRttiType;
+ Prop: TRttiProperty;
+ Attr: TCustomAttribute;
+begin
+  RCtx := TRttiContext.Create;
+  try
+    RType := RCtx.GetType(aClass);
+    WriteLn(RType.Name, ' attributes:');
+    for Attr in RType.GetAttributes do
+      PrintAttribute(Attr);
+    for Prop in RType.GetProperties do
+      for Attr in Prop.GetAttributes do
+        PrintAttribute(Attr);
+  finally
+    RCtx.Free;
+  end;
+end;
+
+procedure PrintTypeAttributes(aInfo: PTypeInfo);
+var
+ RCtx: TRttiContext;
+ RType: TRttiType;
+ Attr: TCustomAttribute;
+begin
+  RCtx := TRttiContext.Create;
+  try
+    RType := RCtx.GetType(aInfo);
+    WriteLn(RType.Name, ' attributes:');
+    for Attr in RType.GetAttributes do
+      PrintAttribute(Attr);
+  finally
+    RCtx.Free;
+  end;
+end;
+
+begin
+  HaltOnNotReleased:=True;
+  //SetHeapTraceOutput('heap.log');
+  PrintClassAttributes(TMyClass);
+  PrintTypeAttributes(TypeInfo(TMyRec));
+  PrintTypeAttributes(TypeInfo(TMyInt));
+end.