воскресенье, апреля 13, 2014

Эмуляция перегружаемых дефолтных свойств во FreePascal 2.7.1

В настоящий момент FreePascal не поддерживает перегружаемые дефолтные свойства (на что есть соответствующий запрос), поддержка которых появилась в Delphi после седьмой версии. Нельзя сказать, что это киллер-фича, но иногда она бывает очень полезной. Однако, с появлением поддержки улучшенных записей (advanced records) и перегрузки операторов появилась возможность немного сгладить этот досадный недостаток. От слов к коду:

program project1;

{$IFNDEF FPC}

{$APPTYPE CONSOLE}
{$DEFINE HAS_OVERLOADABLE_DEFAULT_PROPERTIES}

{$ELSE}

{$MODE DELPHI}

{$ENDIF}

Type

//
TContainer = Record

{$IFNDEF HAS_OVERLOADABLE_DEFAULT_PROPERTIES}

Strict Private

Type

//
StringNameOrIntegerId = Record

FKind : (ikName, ikId);
FName : String;
FId : Integer;

Class Operator Implicit(Const AName : String) : StringNameOrIntegerId;
Class Operator Implicit(Const AId : Integer) : StringNameOrIntegerId;

End;
//

{$ENDIF}

Private

Function GetItemByName(Const AName : String) : TObject;
Function GetItemById(Const AId : Integer) : TObject;

{$IFNDEF HAS_OVERLOADABLE_DEFAULT_PROPERTIES}

Function GetItem(Const ANameOrId : StringNameOrIntegerId) : TObject;

{$ENDIF}

Public

{$IFDEF HAS_OVERLOADABLE_DEFAULT_PROPERTIES}

Property Items[Const AName : String] : TObject Read GetItemByName; Default;
Property Items[Const AId : Integer] : TObject Read GetItemById; Default;

{$ELSE}

Property Items[Const ANameOrId : StringNameOrIntegerId] : TObject Read GetItem; Default;

{$ENDIF}

End;

{$IFNDEF HAS_OVERLOADABLE_DEFAULT_PROPERTIES}

{ TContainer.StringNameOrIntegerId }

//
Class Operator TContainer.StringNameOrIntegerId.Implicit(Const AName : String) : StringNameOrIntegerId;
Begin

Result.FKind := ikName;
Result.FName := AName;

End;
//

//
Class Operator TContainer.StringNameOrIntegerId.Implicit(Const AId : Integer) : StringNameOrIntegerId;
Begin

Result.FKind := ikId;
Result.FId := AId;

End;
//

{$ENDIF}

{ TContainer }

//
Function TContainer.GetItemByName(Const AName : String) : TObject;
Begin

Result := TObject(1); // stub

End;
//

//
Function TContainer.GetItemById(Const AId : Integer) : TObject;
Begin

Result := TObject(2); // stub

End;
//

{$IFNDEF HAS_OVERLOADABLE_DEFAULT_PROPERTIES}

//
Function TContainer.GetItem(Const ANameOrId : StringNameOrIntegerId) : TObject;
Begin

Case ANameOrId.FKind Of

ikName : Result := GetItemByName(ANameOrId.FName);
ikId : Result := GetItemById(ANameOrId.FId);

End;

End;
//

{$ENDIF}

Var

cnt : TContainer;

begin

Assert(cnt['name'] = TObject(1));
Assert(cnt[1024] = TObject(2));

WriteLn('Overloadable default properties works fine!');
ReadLn;

end.


 



Это готовый пример который можно собрать в Delphi и FreePascal 2.7.1. Из кода видно, что проблему решает новый тип – улучшеная запись выступающий в качестве типа индекса дефолтного свойства и инкапсулирующий реальный тип индекса. Прикладной код, при этом, остается полностью совместимым с Delphi и возможной поддержкой перегружаемых дефолтных свойств во FreePascal в будущем.



Данный метод также может пригодится в случае, когда некое свойство (не обязательно перегружаемое и дефолтное) должно принимать значения ограниченного числа типов, т.е. это может быть полезно не только для FreePascal, но и для Delphi.