mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-12 22:14:25 +02:00
* fix for Mantis #35982: free created attributes once the type is freed
+ added test git-svn-id: trunk@42773 -
This commit is contained in:
parent
8e8ffa0511
commit
33f6adfab6
1
.gitattributes
vendored
1
.gitattributes
vendored
@ -17795,6 +17795,7 @@ tests/webtbs/tw3595.pp svneol=native#text/plain
|
|||||||
tests/webtbs/tw35953.pp svneol=native#text/pascal
|
tests/webtbs/tw35953.pp svneol=native#text/pascal
|
||||||
tests/webtbs/tw35955.pp svneol=native#text/pascal
|
tests/webtbs/tw35955.pp svneol=native#text/pascal
|
||||||
tests/webtbs/tw35965.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/tw3612.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw3617.pp svneol=native#text/plain
|
tests/webtbs/tw3617.pp svneol=native#text/plain
|
||||||
tests/webtbs/tw3619.pp svneol=native#text/plain
|
tests/webtbs/tw3619.pp svneol=native#text/plain
|
||||||
|
@ -227,6 +227,7 @@ type
|
|||||||
function GetBaseType: TRttiType; virtual;
|
function GetBaseType: TRttiType; virtual;
|
||||||
public
|
public
|
||||||
constructor Create(ATypeInfo : PTypeInfo);
|
constructor Create(ATypeInfo : PTypeInfo);
|
||||||
|
destructor Destroy; override;
|
||||||
function GetAttributes: specialize TArray<TCustomAttribute>; override;
|
function GetAttributes: specialize TArray<TCustomAttribute>; override;
|
||||||
function GetProperties: specialize TArray<TRttiProperty>; virtual;
|
function GetProperties: specialize TArray<TRttiProperty>; virtual;
|
||||||
function GetProperty(const AName: string): TRttiProperty; virtual;
|
function GetProperty(const AName: string): TRttiProperty; virtual;
|
||||||
@ -3905,6 +3906,15 @@ begin
|
|||||||
FTypeData:=GetTypeData(ATypeInfo);
|
FTypeData:=GetTypeData(ATypeInfo);
|
||||||
end;
|
end;
|
||||||
|
|
||||||
|
destructor TRttiType.Destroy;
|
||||||
|
var
|
||||||
|
attr: TCustomAttribute;
|
||||||
|
begin
|
||||||
|
for attr in FAttributes do
|
||||||
|
attr.Free;
|
||||||
|
inherited;
|
||||||
|
end;
|
||||||
|
|
||||||
function TRttiType.GetAttributes: specialize TArray<TCustomAttribute>;
|
function TRttiType.GetAttributes: specialize TArray<TCustomAttribute>;
|
||||||
var
|
var
|
||||||
i: Integer;
|
i: Integer;
|
||||||
|
46
tests/webtbs/tw35982.pp
Normal file
46
tests/webtbs/tw35982.pp
Normal file
@ -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.
|
Loading…
Reference in New Issue
Block a user