カスタム属性でクラス定数っぽいものの振る舞いを継承先で変えたりしてみる。

事の発端

http://pc12.2ch.net/test/read.cgi/tech/1259667697/312-315n
312 ：デフォルトの名無しさん：2010/02/26(金) 13:16:25
    TBase = class
    public
      class const Value: Integer; abstract;
    end;
    TBaseClass = class of TBase;

    TExtend1 = class(TBase)
    public
      class const Value: Integer = 1;
    end;

    TExtend2 = class(TBase)
    public
      class const Value: Integer = 2;
    end;

    var
      cls: TBaseClass;

    cls := TExtend1;
    a := cls.Value; //1が入って欲しい


    もちろんこんなコードは書けないんですけど、
    上記のようなクラス定数（もしくはクラス変数）の継承みたいなことって何かで代用できますかね

カスタム属性を使ってみる

type
  UserValueAttribute = class(TCustomAttribute) // ちなみにカスタム属性は××Attributeという名前にしておくと、
  public
    constructor Create(AValue: Integer);
    var Value: Integer; // 手抜き
  end;

  [UserValue(0)] // このようにAttributeを抜いた省略形が使える。C#っぽい
  TBase = class
  public
    class function Value: Integer; virtual;
  end;
  TBaseClass = class of TBase;

  [UserValue(1)]
  TExtend1 = class(TBase);

  [UserValue(2)]
  TExtend2 = class(TBase);

  TExtend3 = class(TBase);

constructor UserValueAttribute.Create(AValue: Integer);
begin
  Value := AValue;
end;

function GetCustomAttribute(BaseCls, AttrCls: TClass): TCustomAttribute;
var
  c: TRttiContext;
  t: TRttiType;
  a: TCustomAttribute;
begin
  while BaseCls <> nil do
  begin
    c := TRttiContext.Create;
    t := c.GetType(BaseCls);
    for a in t.GetAttributes do
      if a is AttrCls then Exit(a);
    BaseCls := BaseCls.ClassParent; // 属性が定義されてない時は親クラスの属性を調べることで属性の継承を実現
  end;
  Result := nil;
end;

class function TBase.Value: Integer;
begin
  Result := UserValueAttribute(GetCustomAttribute(Self, UserValueAttribute)).Value; // ここを含めエラー処理は全然してない
end;

var
  base: TBaseClass;
begin
  Writeln(TBase.Value);
  Writeln(TExtend1.Value);
  Writeln(TExtend2.Value);
  Writeln(TExtend3.Value);
  base := TExtend1;
  Writeln(base.Value);
  base := TExtend2;
  Writeln(base.Value);
  base := TExtend3;
  Writeln(base.Value);
end.

結果

0
1
2
0
1
2
0

カスタム属性を使う利点

• 基底のクラスに実装を書いとけば、あとは継承先で属性定義するだけで振る舞いが変えられる
• クラス参照型から参照してもちゃんと異なる値が返ってくる

とか？

カスタム属性って意外と使える

最近ちょうど似たようなことをやっていたので書いてみたけど、カスタム属性って最初知った時はシリアライズの際にどうの、みたいな漠然とした使い道しか知らなかったんだよね。プログラミングC#読んでも「使い方はこうだよ」みたいなことしか書いてなかったし。でもよくよく考えるとこうやって色んな属性を持たせられるというのはとても便利だなーと思った。

追記(10/03/01)

よく考えたらカスタム属性のインスタンスはTRttiContextが持ってるから、GetCustomAttributeを抜けた時点で解放されちゃってた…。となると、GetCustomAttributeに外部からTRttiContextを渡すか、無名メソッド渡して値を返してもらうかしないとなぁ。

// TRttiContextを渡すバージョン
function GetCustomAttrinute(const C: TRttiContext; BaseCls, AttrCls: TClass): TCustomAttribute;
var
  t: TRttiType;
  a: TCustomAttribute;
begin
  while BaseCls <> nil do
  begin
    t := c.GetType(BaseCls);
    for a in t.GetAttributes do
      if a is AttrCls then Exit(a);
    BaseCls := BaseCls.ClassParent;
  end;
  Result := nil;
end;

class function TBase.Value: Integer;
begin
  // 使うとき
  Result := UserValueAttribute(GetCustomAttribute(TRttiContext.Create, Self, UserValueAttribute)).Value;
end;

// 無名メソッドを渡すバージョン
type
  TAttributeProc = reference to procedure(Attr: TCustomAttribute);
procedure GetCustomAttrinute(BaseCls, AttrCls: TClass; const Proc: TAttributeProc);
var
  c: TRttiContext;
  t: TRttiType;
  a: TCustomAttribute;
begin
  c := TRttiContext.Create;
  while BaseCls <> nil do
  begin
    t := c.GetType(BaseCls);
    for a in t.GetAttributes do
      if a is AttrCls then
      begin
        Proc(a);
        Exit;
      end;
    BaseCls := BaseCls.ClassParent;
  end;
end;

class function TBase.Value: Integer;
begin
  // 使うとき
  GetCustomAttribute(Self, UserValueAttribute, 
    procedure(Attr: TCustomAttribute)
    begin
      Result := UserValueAttribute(Attr).Value;
    end);
end;

うーん、間に合わせで書いたせいか、どうも改善の余地しかない感じに…。後者は叙述関数渡せばカスタム属性のクラス参照いらねーな…まぁいいか。