فهرست منبع

* fix for Mantis #35982: free created attributes once the type is freed
+ added test

git-svn-id: trunk@42773 -

svenbarth 6 سال پیش
والد
کامیت
33f6adfab6
3فایلهای تغییر یافته به همراه57 افزوده شده و 0 حذف شده
  1. 1 0
      .gitattributes
  2. 10 0
      packages/rtl-objpas/src/inc/rtti.pp
  3. 46 0
      tests/webtbs/tw35982.pp

+ 1 - 0
.gitattributes

@@ -17795,6 +17795,7 @@ tests/webtbs/tw3595.pp svneol=native#text/plain
 tests/webtbs/tw35953.pp svneol=native#text/pascal
 tests/webtbs/tw35955.pp svneol=native#text/pascal
 tests/webtbs/tw35965.pp svneol=native#text/pascal
+tests/webtbs/tw35982.pp svneol=native#text/pascal
 tests/webtbs/tw3612.pp svneol=native#text/plain
 tests/webtbs/tw3617.pp svneol=native#text/plain
 tests/webtbs/tw3619.pp svneol=native#text/plain

+ 10 - 0
packages/rtl-objpas/src/inc/rtti.pp

@@ -227,6 +227,7 @@ type
     function GetBaseType: TRttiType; virtual;
   public
     constructor Create(ATypeInfo : PTypeInfo);
+    destructor Destroy; override;
     function GetAttributes: specialize TArray<TCustomAttribute>; override;
     function GetProperties: specialize TArray<TRttiProperty>; virtual;
     function GetProperty(const AName: string): TRttiProperty; virtual;
@@ -3905,6 +3906,15 @@ begin
     FTypeData:=GetTypeData(ATypeInfo);
 end;
 
+destructor TRttiType.Destroy;
+var
+  attr: TCustomAttribute;
+begin
+  for attr in FAttributes do
+    attr.Free;
+  inherited;
+end;
+
 function TRttiType.GetAttributes: specialize TArray<TCustomAttribute>;
 var
   i: Integer;

+ 46 - 0
tests/webtbs/tw35982.pp

@@ -0,0 +1,46 @@
+{ %OPT=-gh }
+
+program tw35982;
+
+{$mode Delphi}
+
+uses RTTI;
+
+type
+  TSpecialAttribute = class(TCustomAttribute)
+  public
+    FValue: String;
+    constructor Create(const AValue: String);
+  end;
+
+  constructor TSpecialAttribute.Create(const AValue: String);
+  begin
+    FValue := AValue;
+  end;
+
+type
+  [TSpecialAttribute('Hello World!')]
+  TSomeType = record
+  end;
+
+var
+  LContext: TRttiContext;
+  LType: TRttiType;
+  LAttr: TCustomAttribute;
+begin
+  HaltOnNotReleased := True;
+
+  { Create a new Rtti context }
+  LContext := TRttiContext.Create;
+
+  { Extract type information for TSomeType type }
+  LType := LContext.GetType(TypeInfo(TSomeType));
+
+  { Search for the custom attribute and do some custom processing }
+  for LAttr in LType.GetAttributes() do
+    if LAttr is TSpecialAttribute then
+      Writeln(TSpecialAttribute(LAttr).FValue);
+
+  { Destroy the context }
+  LContext.Free;
+end.