mORMot Open Source

I played a lot with Your nice IAutoFree idea, and finally got to a different implementation, currently for test purposes, working only with a single object instance.
I really can't decide wether this is cool or fool, so I woudld be appreciated on any comment.

// TAutoFreeData - useful for simple classes that do not have constructor and destructor ie. for emulating pascal record behavior with property access syntax.

type

  // Memory signature on the heap
  PAutoFreeRec = ^TAutoFreeRec;
  TAutoFreeRec = packed record
    AutoFree: packed record
      ClassType: TClass;
      RefCount: Integer;
      Unknown: {array[0..0] of} Pointer; // TODO: What is this? Actually initialized by TAutoFreeData.InitInstance().
    end;
    Instance: packed record
      ClassType: TClass;
      // Data: array[1..Instance.ClassType.InstanceSize - SizeOf(Instance.ClassType)] of Byte;
    end;
  end;

  // Implements the reference counted interface
  TAutoFreeData = class(TInterfacedObject)
  public
    destructor Destroy; override;
  end;

  // Just for accessing RefCount
  TAutoFreeInfo = class
  private
    function getAutoFree: TAutoFreeData;
  public
    property AutoFree: TAutoFreeData read getAutoFree;
  end;

destructor TAutoFreeData.Destroy;
begin
  //* Cleanup aClassType instance
  // MUST NOT call Instance.Destroy, since
  // it is not directly allocated on the heap, and destructor finally calls System._FreeMem()
  TObject(@PAutoFreeRec(Self)^.Instance).CleanupInstance;
  //* Destroy AutoFree instance and Free allocated memory
  inherited;
end;

function TAutoFreeInfo.getAutoFree: TAutoFreeData;
begin
  Result := TAutoFreeData(@PAutoFreeRec(Integer(Self) - SizeOf(PAutoFreeRec(nil)^.AutoFree))^.AutoFree);
end;

function AutoFreeData(var aLocalVar; aClassType: TClass): IInterface;
var
  Size: integer;
begin
  //* Allocate space on heap for TAutoFreeData and aClassType instance
  Size := TAutoFreeData.InstanceSize + aClassType.InstanceSize;
  GetMem(Pointer(aLocalVar), Size);
  //* Fill only Instance.Data with zeroes
  // FillChar(Pointer(aLocalVar)^, Size, 0);
  FillChar(PAutoFreeRec(Integer(aLocalVar) + SizeOf(TAutoFreeRec))^, Size - SizeOf(TAutoFreeRec), 0);
  //* Initialize AutoFreeData instance and return interface reference
  Result := TAutoFreeData(TAutoFreeData.InitInstance(TAutoFreeData(aLocalVar)));
  //* Initialize aClass instance
  //* Not necessary to call aClassType.InitInstance on constructorless simple classes
  // aClassType.InitInstance(TObject(@PAutoFreeRec(aLocalVar)^.Instance));
  PAutoFreeRec(aLocalVar)^.Instance.ClassType := aClassType;
  //* Set aLocalVar
  Pointer(aLocalVar) := @PAutoFreeRec(aLocalVar)^.Instance;
end;

type
  // Not mandatory to inherit from TAutoFreeInfo. It is just for test.
  TTestRec28C = class(TAutoFreeInfo)
  private
    fID: Integer;
    fName: string;
  published
    property ID: Integer read fID write fID;
    property Name: string read fName write fName;
  end;

  // Inheritance and virtual functions will work
  TTestRec28VC = class(TTestRec28C)
    function getCalculated: string; virtual;
  published
    property Calculated: string read getCalculated;
  end;

function TTestRec28VC.getCalculated: string;
begin
  Result := Format('ID: %d, Name: %s', [ID, Name]);
end;

procedure Test28;
var
  d1, d2: IInterface;
  c: TTestRec28C;

  sl: TStringList;

  procedure Log(const Fmt: string; const Params: array of const);
  begin
    sl.Add(Format(Fmt, Params));
  end;

begin
  sl := TStringList.Create;

  d1 := AutoFreeData(c, TTestRec28VC);
  Log('c.ClassName: %s', [c.ClassName]);
  Log('c.AutoFree.ClassName: %s', [c.AutoFree.ClassName]);
  Log('c.AutoFree.RefCount: %d', [c.AutoFree.RefCount]);
  c.ID := 1;
  c.Name := 'First';
  Log('c.ID: %d', [c.ID]);
  Log('c.Name: %s', [c.Name]);
  Log('c.Calculated: %s', [(c as TTestRec28VC).Calculated]);
  d2 := d1;
  Log('c.AutoFree.RefCount: %d', [c.AutoFree.RefCount]);

  sl.SaveToFile(IncludeTrailingPathDelimiter(ExtractFileDir(Application.ExeName)) + 'Test28.txt');
  sl.Free;
end;