Another Generics / RTTI bug. Attributes are ignored in parametrized types.

The output from the code below, shows that you cannot enumerate attributes for properties of a parametrized type such as TOpenClass.

If you close the class as a TDecidedClass = TOpenClass, any attributes declared in TDecidedClass may have enumerable attributes, but the attributes declared for properties in TOpenClass are still not enumerable.

Output from the code:

Properties for TBaseClass
Normal
Blinged [Bling]

Properties for TBaseParam
BlingTFails <- Note the lack of a [Bling] attribute here 
BlingIntFails <- Note the lack of a [Bling] attribute here 
Normal 
Blinged [Bling] 


Properties for TBaseInt 
BlingInt [Bling] 
BlingTFails <- Note the lack of a [Bling] attribute here 
BlingIntFails <- Note the lack of a [Bling] attribute here 
Normal 
Blinged [Bling]

program AttributeFailsForParametricGenericType;

{$APPTYPE CONSOLE}

uses
  ExceptionLog,
  Classes,
  Generics.Defaults,
  RTTI;

type
  Bling = class(TCustomAttribute);

  TBaseClass = class
  private
    function GetBling: Integer;
    function GetNormal: Integer;
    procedure SetBling(const Value: Integer);
    procedure SetNormal(const Value: Integer);
  public
    procedure Inspect;
    property Normal:Integer read GetNormal write SetNormal;
    [bling] property Blinged:Integer read GetBling write SetBling;
  end;

  TBaseParam = class(TBaseClass)
  private
    function GetBlingTFails: T;
    procedure SetBlingTFails(const Value: T);
    function GetBlingIntFails: Integer;
    procedure SetBlingIntFails(const Value: Integer);
  public
    [bling] property BlingTFails:T read GetBlingTFails write SetBlingTFails;
    [bling] property BlingIntFails:Integer read GetBlingIntFails write SetBlingIntFails;
  end;

  TBaseInt = class(TBaseParam)
  private
    function GetBlingInt: Integer;
    procedure SetBlingInt(const Value: Integer);
  public
    [bling] property BlingInt:Integer read GetBlingInt write SetBlingInt;
  end;


{ TBaseClass }

function TBaseClass.GetBling: Integer; begin end;
function TBaseClass.GetNormal: Integer; begin end;

procedure TBaseClass.Inspect;
var
  Context : TRttiContext;
  SourceType : TRttiType;
  SourceProp : TRttiProperty;
  SourceAttribute : TCustomAttribute;
  s : String;
begin
  Context := TRttiContext.Create;
  try
    SourceType := Context.GetType(Self.ClassType);
    Writeln('');
    Writeln(ClassName);

    for SourceProp in SourceType.GetProperties
    do begin
      s := SourceProp.Name;

      for SourceAttribute in SourceProp.GetAttributes
      do begin
        s := s + ' [' + SourceAttribute.ClassName + ']';
      end;
      Writeln(s);
    end;
  finally
    Context.Free;
  end;
end;

procedure TBaseClass.SetBling(const Value: Integer); begin end;
procedure TBaseClass.SetNormal(const Value: Integer); begin end;

{ TBaseParam }
function TBaseParam.GetBlingTFails: T; begin end;
function TBaseParam.GetBlingIntFails: Integer; begin end;
procedure TBaseParam.SetBlingTFails(const Value: T); begin end;
procedure TBaseParam.SetBlingIntFails(const Value: Integer); begin end;

{ TBaseInt }
function TBaseInt.GetBlingInt: Integer; begin end;
procedure TBaseInt.SetBlingInt(const Value: Integer); begin end;


var
  Base : TBaseClass;
  BaseT : TBaseParam;
  BaseInt : TBaseInt;
begin
  Base := TBaseClass.Create;
  Base.Inspect;

  BaseT := TBaseParam.Create;
  BaseT.Inspect;

  BaseInt := TBaseInt.Create;
  BaseInt.Inspect;

  Readln;
end.