L’ereditarietà degli attributi in Delphi

Quando ci si documenta circa l’ereditarietà degli attributi in Delphi, si legge che non sono ereditati dai discendenti della classe in cui sono definiti. Ciò è perfettamente ragionevole, perché gli attributi servono per decorare una specifica classe; tuttavia, a volte, potrebbe essere limitante e far perdere alcuni dei vantaggi offerti dagli attributi.

Riflettevo su questo aspetto mentre cercavo il modo migliore per dotare BindAPI di un supporto minimo dell’ereditarietà; per lo meno, di quel tanto che basta a gestire una buona uniformità di comportamento laddove l’inclusione non sia una strada praticabile. Le strade migliori, alla fine, mi sono sembrate due:

• Fare una ricerca a ritroso nella gerarchia delle classi per trovare eventuali decorazioni;
• Inserire le decorazioni in un’interfaccia, che sarà interrogata dal binder.

Per capire quale fosse la strada più pratica, ho scritto una piccola applicazione, iniziando a definire qualche attributo, interfaccia e classe di prova:

  TDefaultStringAttribute = class(TCustomAttribute)
    procedure SetValue(aValue: String);
  private
    FValue: String;
  public
    property Value: String read FValue write SetValue;
    constructor Create(const aValue: String);
  end;

  [TDefaultString('IAncestorInterface class attribute found.')]
  IAncestorInterface = interface(IInvokable)
    ['{F2A5626F-223C-4EB7-BA0E-CDAA468EE729}']
    [TDefaultString('IAncestorInterface Test method attribute found.')]
    procedure Test(const AString: string);
  end;

  [TDefaultStringAttribute('TTestAncestor class attribute found.')]
  TTestAncestor = class(TObject)
  private
    FText: string;
    FEnabled: boolean;
  public
    [TDefaultStringAttribute('TTestAncestor FClassField field attribute found.')]
    FClassField: string;
    [TDefaultStringAttribute('TTestAncestor Text property attribute found.')]
    property Text: string read FText write FText;
    [TDefaultStringAttribute('TTestAncestor Enabled property attribute found.')]
    property Enabled: boolean read FEnabled write FEnabled;
    [TDefaultStringAttribute('TTestAncestor Test method attribute found.')]
    procedure Test(const AString: string); virtual; abstract;
  end;

  TTestChild = class(TTestAncestor)
  public
    [TDefaultStringAttribute('TTestChild Text property attribute found.')]
    property Text;
    [TDefaultStringAttribute('TTestChild Test method attribute found.')]
    procedure Test(const AString: string); override;
  end;

Le implementazioni dei metodi sono banali e le trovate nell’applicazione rilasciata su GitHub. In seguito, ho preparato una form con tre TButton e un TMemo per vedere i risultati dei test che mi servivano. La form è definita come

TfrmTest = class(TForm, IAncestorInterface)

e implementa il metodo Test (che non fa nulla, perché non rientra nei nostri scopi). I test sono tre: nel primo verifichiamo che la decorazione dell’interfaccia non sia visibile interrogando le proprietà RTTI della classe. Il codice è

procedure TfrmTest.btnTestFormClick(Sender: TObject);
begin
  ScanClass(Self.ClassType);
end;

procedure TfrmTest.ScanClass(const AClass: TClass);
var
  lAttr: TCustomAttribute;
  lContext: TRttiContext;
  lClass: TClass;
  lField: TRttiField;
  lMethod: TRttiMethod;
  lProp: TRttiProperty;
  lType: TRttiType;
begin
  memOutput.Lines.Clear;
  lClass := AClass;
  lContext := TRttiContext.Create;
  try
    while lClass <> nil do
      begin
        memOutput.Lines.Add('Class: ' + lClass.ClassName);
        lType := lContext.GetType(lClass);
        for lAttr in lType.GetAttributes() do
            if lAttr is TDefaultStringAttribute then
              memOutput.Lines.Add('Class Attribute ' + lAttr.ClassName + ' = '
                + TDefaultStringAttribute(lAttr).Value);
        for lField in lType.GetFields do
          for lAttr in lField.GetAttributes do
            if lAttr is TDefaultStringAttribute then
              memOutput.Lines.Add('Field Attribute ' + lAttr.ClassName + ' = '
                + TDefaultStringAttribute(lAttr).Value);
        for lProp in lType.GetProperties do
          for lAttr in lProp.GetAttributes do
            if lAttr is TDefaultStringAttribute then
              memOutput.Lines.Add('Property Attribute ' + lAttr.ClassName + ' = '
                + TDefaultStringAttribute(lAttr).Value);
        for lMethod in lType.GetMethods do
          for lAttr in lMethod.GetAttributes do
            if lAttr is TDefaultStringAttribute then
              memOutput.Lines.Add('Method Attribute ' + lAttr.ClassName + ' = '
                + TDefaultStringAttribute(lAttr).Value);
        memOutput.Lines.Add('------------------------------');
        lClass := lClass.ClassParent;
      end;
  finally
    lContext.Free;
  end;
end;

Il risultato è quello che ci aspettiamo: la presenza degli attributi nell’interfaccia non è rilevata:

Il secondo test riguarda la possibilità di leggere gli attributi dall’interfaccia. Per simulare il comportamento che sarà implementato in BindAPI, dove non si conoscono a priori le classi e le interfacce da gestire, ho scritto una procedura per estrarre gli attributi cercati a partire da un parametro di tipo TClass:

procedure TfrmTest.btnInterfaceTestClick(Sender: TObject);
begin
  ScanInterfaces(Self.ClassType);
end;
procedure TfrmTest.ScanInterfaces(const AClass: TClass);
var
  i: integer;
  interfaceTable: PInterfaceTable;
  interfaceEntry: PInterfaceEntry;
  lAttr: TCustomAttribute;
  lClass: TClass;
  lContext: TRttiContext;
  lMethod: TRttiMethod;
  lType: TRttiType;
  pinfo: PTypeInfo;
begin
  memOutput.Lines.Clear;
  lClass := AClass;
  lContext := TRttiContext.Create;
  try
  while Assigned(lClass) do
  begin
    interfaceTable := lClass.GetInterfaceTable;
    if Assigned(interfaceTable) then
    begin
      memOutput.Lines.Add('Implemented interfaces in ' + lClass.ClassName);
      for i := 0 to interfaceTable.EntryCount - 1 do
      begin
        interfaceEntry := @interfaceTable.Entries[i];
        begin
          for lType in lContext.GetTypes do
          begin
            if lType is TRTTIInterfaceType then
            begin
              if TRTTIInterfaceType(lType).GUID = interfaceEntry.IID then
              begin
                pinfo := TRTTIInterfaceType(lType).Handle;
                memOutput.Lines.Add(Format('%d. %s, GUID = %s',
                  [i, pinfo.Name, GUIDToString(interfaceEntry.IID)]));
                for lAttr in lType.GetAttributes() do
                begin
                  memOutput.Lines.Add('Attributo: ' + lAttr.ClassName);
                  if lAttr is TDefaultStringAttribute then
                    memOutput.Lines.Add(TDefaultStringAttribute(lAttr).Value);
                end;
                for lMethod in lType.GetMethods do
                begin
                  for lAttr in lMethod.GetAttributes do
                  begin
                    memOutput.Lines.Add('Attribute ' + lAttr.ClassName);
                    if lAttr.ClassType = TDefaultStringAttribute then
                      memOutput.Lines.Add
                        ('  value ' + TDefaultStringAttribute(lAttr).Value);
                  end;
                end;
                break;
              end;
            end
          end;
        end;
      end;
      memOutput.Lines.Add('------------------------------');
    end;
    lClass := lClass.ClassParent;
  end;
  finally
    lContext.Free;
  end;
end;

E’ un po lunga, ma non presenta particolari difficoltà. I risultati sono, ancora una volta, quelli attesi:

Infatti, IInvokable è l’interfaccia che nella compilazione include le informazioni RTTI; se avessimo usato un’interfaccia generica, avremmo rilevato solo l’attributo della classe e non quello del metodo. Quindi, data una classe che implementa un’interfaccia decorata, è possibile estrarre da quest’ultima le informazioni sugli attributi dei metodi.

BindApi, però, opera su tutti i membri di una classe, compresi campi e proprietà. Per questo, ho aggiunto un ultimo test, che riguarda la lettura degli attributi nelle classi derivate; per implementarlo, è stato sufficiente richiamare il metodo ScanClass passando come parametro la classe appositamente implementata per questo scopo:

procedure TfrmTest.btnTestClassClick(Sender: TObject);
begin
  ScanClass(TTestChild);
end;

Il risultato è potrebbe sorprendere:

La procedura che esamina TTestChild, correttamente, non rileva attributi di classe perché TTestChild non è stato decorato; a livello di membri, però, legge sia quelli presenti in TTestChild, sia quelli che in TTestAncestor. Questo non è il comportamento che ci si potrebbe aspettare: quando si legge che gli attributi di una classe non sono ereditabili, ci si potrebbe aspettare che lo stesso valga per gli attributi in una classe, ossia quelli dei suoi membri.

Riassumendo, sia nelle classi sia nelle interfacce l’ereditarietà degli attributi in Delphi sembra avere questo comportamento:

• Non sono ereditati gli attributi che decorano una classe o un’interfaccia
• Sono ereditati gli attributi che decorano i membri della classe o dell’interfaccia

Il codice è stato complato con Delphi 10.1 e con Delphi 10.4.2; potrete adattarlo alla vostra versione per verificare se anch’essa segue la stessa regola.

L'autore