[fpc-devel] [] property overloads

[Ben Grasset]

On Mon, Jul 8, 2019 at 12:04 PM Ryan Joseph <genericptr at gmail.com> wrote:

> There actually is a need to distinguish between getters/setters but the
> way property syntax works we’re forced for the return type to be the same
> as the input for the setter. This is a problem I faced before where I want
> the getter to return a pointer but I want the setter to take a direct value.
>

One thing I might point out as a general tip is that you don't really
necessarily *need* an array-style index for the kind of access you seem to
be going for, especially if using something like TValue which has a lot of
assignment operator overloads in place by default.

Here's a little example I threw together:

program Example;

{$Mode ObjFPC}{$H+}
{$ModeSwitch AdvancedRecords}
{$ImplicitExceptions Off}
{$Assertions On}

uses RTTI;

  operator :=(const RHS: TValue): TObject; inline;
  begin
    if RHS.IsObject() then
      Result := RHS.AsObject()
    else
      Result := nil;
  end;

type
  TMyClass = class end;

  TMyRecord = record
  strict private
    FValue: TValue;
  public
    procedure FreeIfNecessary; inline;
  private
    function GetValue: TValue; inline;
    procedure SetValue(const V: TValue); inline;
  public
    property Value: TValue read GetValue write SetValue;
  end;

  procedure TMyRecord.FreeIfNecessary;
  var O: TObject = nil;
  begin
    // Unfortunate misnomer.. IsObject() really returns true if
    // the value is a class instance, while IsClass()
    // returns true if the value is a class reference.
    // Ironically, there is no function for actual TP-style objects.
    if FValue.IsObject() then
    begin
      O := FValue.AsObject();
      if O <> nil then
        O.Free();
    end;
  end;

  function TMyRecord.GetValue: TValue;
  begin
    case FValue.Kind of
      tkSString: Result := FValue.AsString();
      tkAString: Result := FValue.AsAnsiString();
      tkUString: Result := FValue.AsUnicodeString();
      tkFloat: Result := FValue.AsExtended();
      tkInteger, tkInt64: Result := FValue.AsOrdinal();
      tkQWord: Result := FValue.AsUInt64();
      tkBool: Result := FValue.AsBoolean();
      tkClass: Result := FValue.AsObject();
      else
        Assert(False, 'Unsupported data type!');
    end;
  end;

  procedure TMyRecord.SetValue(const V: TValue);
  begin
    FValue := V;
  end;

var
  V: TMyRecord;
  C: TObject = nil;

begin
  V.Value := 2;
  V.Value := 'Hey';
  V.Value := 14.567;
  V.Value := False;
  V.Value := TObject.Create();
  V.FreeIfNecessary();
  V.Value := TMyClass.Create();
  C := V.Value;
  WriteLn(C.ClassName());
  V.FreeIfNecessary();
end.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.freepascal.org/pipermail/fpc-devel/attachments/20190708/2d5695ba/attachment-0001.html>