Как правильно объявить структуру?

[Alek_Aaz]

День добрый.

Подскажите пжлста как по фэн-шую объявить структуры данных, а то я совсем что-то запутался, в объектах, классах, свойствах, дженериках и пр.

Хочу чтобы было так приблизительно:

ELEMENT=????? какой-то тип, а в нем поля
ELEMENT.Name =string имя, тут все просто
ELEMENT.Data = ???? а вот тут Data может быть Int64 или WideStrings или Currency или array of byte

Нужно чтобы шустро работало, и без заморочек в коде, типа указателя на данные в куче.
Например если А и В оба типа TElement можно было бы сделать красиво A:=B при этом данные из экземпляра В скопировались в экземпляр А;

Хелп плиз

[t-ea]

Record Types

[Alek_Aaz]

Record Types

Спасибо.
Но как это будет выглядеть в жизни?

Type
TMyElem = record
name:string;
Case tipdata:byte of
1:(data:int64);
2:(data:WideString);
3:(data:array of byte);
end;

Так?
А как присвоить значение?
MyElem<тут что-то должно быть>.data:='error';

Может пример есть где?

[olegy123]

http://www.delphisources.ru/pages/faq/f ... e.php.html

[Снег Север]

Код: Выделить всё

var MyElem1,  MyElem2 :TMyElem;
...
MyElem1.name := 'abc';
MyElem1.tipdata := 1;
MyElem1.data := 1234567890;

MyElem2.name := 'def';
MyElem2.tipdata := 2;
MyElem2.data := 'ererererer';


и т.д.

[iskander]

Если речь идёт о вариантных записях, то это могло бы выглядеть так:

Код: Выделить всё

procedure Proc;
type
  TMyElem = record
    Name: string;
    Data: record
      case byte of
        1: (i64: Int64);
        2: (Str16: string[16]);
        3: (Guid: TGuid);
        4: (Byte16: array[1..16] of Byte);
      end;
  end;
var
  Elem: TMyElem;
  g: TGuid;
  b: array[1..16] of Byte;
begin
  Elem.Name := 'empty';
  Elem.Data.i64 := 500000000055;

  g := Elem.Data.Guid;

  Elem.Data.Str16 := 'abcdefghijklmnop';
  b := Elem.Data.Byte16;
end;


Но тут есть есть большой облом: поля вариантной записи не могут иметь managed тип.

Upd, если хочется большей питонообразности, почему бы не объявить поле Data как Variant?

[sign]

Record Types

Спасибо.
Но как это будет выглядеть в жизни?

Код: Выделить всё

Type
TMyElem = record
    name: String;
    case tipdata: Byte of
        1: (data: Int64);
        2:(data: WideString);
        3:(data: array of Byte);
   end;


Так?
А как присвоить значение?

Код: Выделить всё

unit Unit2;

{$mode objfpc}{$H+}
{$ModeSwitch advancedrecords}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs;

type

  { TMyElem }

  AByte = array of Byte;
  PAByte = ^AByte;

  TMyElem = record
      name: String;
      procedure Assign(const Val: TMyElem);
      procedure Clear;
      case tipdata: Byte of
          1:(DInt:  Int64);
          2:(DStr:  PWideString);
          3:(DByte: PAByte);
     end;

implementation


{ TMyElem }

procedure TMyElem.Assign(const Val: TMyElem);
begin
  if Val.tipdata < 1 then Exit;
  Clear;
  name := Val.name;
  tipdata := Val.tipdata;
  case Val.tipdata of
    1: DInt  := Val.DInt;
    2: begin
         New(DByte);
         SetLength(DByte^, SizeOf(Val.DByte^));
         DByte^ := Copy(Val.DByte^, 0, SizeOf(Val.DByte^));
       end;
    3: begin
         New(DStr);
         SetLength(DStr^, SizeOf(Val.DStr));
         DStr^ := Copy(Val.DStr^, 1, SizeOf(Val.DStr^));
       end;
  end;
end;

procedure TMyElem.Clear;
begin
  name := '';
  case tipdata of
    2: Dispose(DByte);
    3: begin
         SetLength(DStr^, 0);
         Dispose(DStr);
       end;
  end;
end;


end.


Проверка:

Код: Выделить всё

unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Buttons,
  Unit2;

type

  { TForm1 }

  TForm1 = class(TForm)
    bStr: TButton;
    bArray: TButton;
    bDigit: TButton;
    bAssign: TButton;
    eStr: TEdit;
    eArray: TEdit;
    eDigit: TEdit;
    stShow: TStaticText;
    procedure bStrClick(Sender: TObject);
    procedure bArrayClick(Sender: TObject);
    procedure bDigitClick(Sender: TObject);
    procedure bAssignClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private

  public
    procedure ShowData(const D: TMyElem; TS: String);
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}


{ TForm1 }
var D1, D2: TMyElem;
procedure TForm1.bStrClick(Sender: TObject);
begin
  D1.Clear;
  D1.name := 'Текст';
  New(D1.DStr);
  D1.tipdata := 3;
  SetLength(D1.DStr^, Length(eStr.Text));
  D1.DStr^ := eStr.Text;
  ShowData(D1, 'Инициализация');
end;

procedure TForm1.bArrayClick(Sender: TObject);
var i: Integer;
begin
  D1.Clear;
  D1.name := 'Числа';
  D1.tipdata := 2;
  New(D1.DByte);
  SetLength(D1.DByte^, Length(eArray.Text));
  for i := 0 to Length(eArray.Text)-1 do
    D1.DByte^[i] := Byte(eArray.Text[i]);
  ShowData(D1, 'Инициализация');
end;

procedure TForm1.bDigitClick(Sender: TObject);
begin
  D1.Clear;
  D1.tipdata := 1;
  D1.DInt := StrToInt64(eDigit.Text);
  ShowData(D1, 'Инициализация');
end;

procedure TForm1.bAssignClick(Sender: TObject);
begin
  D2.Assign(D1);
  ShowData(D2, 'Присвоение');
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  D1.Clear;
  D2.Clear;
end;

procedure TForm1.ShowData(const D: TMyElem; TS: String);
var i: DWord;
  S: String;
begin
  Caption := TS;
  case D.tipdata of
    1: stShow.Caption := IntToStr(D.DInt);
    2: begin
         S := '';
         for i := Low(D.DByte^) to High(D.DByte^) do
           S := S + IntToStr(D.DByte^[i]) + ' ';
           stShow.Caption := S;
       end;
    3: begin
         stShow.Caption := D.DStr^;
       end;
  end;
end;

end.



[serbod]

Рекомендую сделать Data: Variant
Оно умеет и в числа, и в строки, и в байты, и в копирование. Только с массивами в вариантах есть некоторая сложность, их нужно через VarArrayCreate() определять.

[iskander]

sign, имхо несколько тяжеловесно, не?
ТС хотел

...Нужно чтобы шустро работало, и без заморочек в коде, типа указателя на данные в куче.
Например если А и В оба типа TElement можно было бы сделать красиво A:=B при этом данные из экземпляра В скопировались в экземпляр А;

а тут ручное выделение/освобождение памяти, полное копирование строк?

serbod, +1, я как-то упустил массив из внимания.
VarArrayCreate, хмм, правильно ли я понимаю, даже если массив динамический, его все равно придется в структуру полностью копировать?

Добавлено спустя 2 часа 57 минут 34 секунды:
Во, наваял ,
правда ценой оверхеда в два указателя и требует версии компилятора не меньше 3.2.0:

Код: Выделить всё

unit vdata;

{$mode objfpc}{$H+}
{$modeswitch advancedrecords}

interface

uses
  SysUtils;

type

  TMyData = record
  public
  type
    TKind = (knEmpty, knInt64, knCurrency, knWideString, knBytes);

  strict private
    FKind: TKind;
    FBuffer: record
      case Boolean of
        False: (Int: Int64);
        True:  (Cur: Currency);
      end;
    FStr: widestring;
    FBytes: TBytes;
    procedure Release(aNewKind: TKind);
    procedure CheckMismatch(aReqKind: TKind);
    class operator Initialize(var d: TMyData);
  public
    class operator := (aValue: Int64): TMyData;
    class operator := (aValue: Currency): TMyData;
    class operator := (const aValue: widestring): TMyData;
    class operator := (const aValue: TBytes): TMyData;
    class operator := (constref aData: TMyData): Int64;
    class operator := (constref aData: TMyData): Currency;
    class operator := (constref aData: TMyData): widestring;
    class operator := (constref aData: TMyData): TBytes;
    property Kind: TKind read FKind;
  end;

implementation

procedure TMyData.Release(aNewKind: TKind);
begin
  if aNewKind <> Kind then
    begin
      case Kind of
        knWideString: FStr := '';
        knBytes: FBytes := nil;
      else
      end;
      FKind := aNewKind;
    end;
end;

procedure TMyData.CheckMismatch(aReqKind: TKind);
begin
  if (Kind <> knEmpty) and (aReqKind <> Kind) then
    raise EInvalidCast.Create('Data type mismatch');
end;

class operator TMyData.Initialize(var d: TMyData);
begin
  d.FKind := knEmpty;
end;

class operator TMyData.:=(aValue: Int64): TMyData;
begin
  Result.Release(knInt64);
  Result.FBuffer.Int := aValue;
end;

class operator TMyData.:=(aValue: Currency): TMyData;
begin
  Result.Release(knCurrency);
  Result.FBuffer.Cur := aValue;
end;

class operator TMyData.:=(const aValue: widestring): TMyData;
begin
  Result.Release(knWideString);
  Result.FStr := aValue;
end;

class operator TMyData.:=(const aValue: TBytes): TMyData;
begin
  Result.Release(knBytes);
  Result.FBytes := aValue;
end;

class operator TMyData.:=(constref aData: TMyData): Int64;
begin
  if aData.Kind = knEmpty then
    exit(0);
  aData.CheckMismatch(knInt64);
  Result := aData.FBuffer.Int;
end;

class operator TMyData.:=(constref aData: TMyData): Currency;
begin
  if aData.Kind = knEmpty then
    exit(0);
  aData.CheckMismatch(knCurrency);
  Result := aData.FBuffer.Cur;
end;

class operator TMyData.:=(constref aData: TMyData): widestring;
begin
  if aData.Kind = knEmpty then
    exit('');
  aData.CheckMismatch(knWideString);
  Result := aData.FStr;
end;

class operator TMyData.:=(constref aData: TMyData): TBytes;
begin
  if aData.Kind = knEmpty then
    exit(nil);
  aData.CheckMismatch(knBytes);
  Result := aData.FBytes;
end;

end.


тест:

Код: Выделить всё

program vr_test;

{$mode objfpc}{$H+}

uses
  heaptrc, SysUtils, typinfo, vdata;

type
  TMyElem = record
    Name: string;
    Data: TMyData;
  end;

var
  Elem1, Elem2: TMyElem;

procedure Test;
var
  LocElem: TMyElem;
  WStr: widestring = '';
  b: TBytes = nil;
begin
  LocElem.Name := 'My element cool name';
  WriteLn('LocElem.Name = ', LocElem.Name);

  WriteLn('test assign Int64:');
//-------------------------------------------------
  LocElem.Data := 1234567890157;
//-------------------------------------------------
  WriteLn('  LocElem.Kind = ', GetEnumName(TypeInfo(TMyData.TKind), Ord(LocElem.Data.Kind)));
  WriteLn('  LocElem.Data = ', Int64(LocElem.Data));

  WriteLn('test assign Currency:');
//-------------------------------------------------
  LocElem.Data := 12345678901.0175;
//-------------------------------------------------
  WriteLn('  LocElem.Kind = ', GetEnumName(TypeInfo(TMyData.TKind), Ord(LocElem.Data.Kind)));
  WriteLn('  LocElem.Data = ', CurrToStr(LocElem.Data));

  Elem1 := LocElem;

  LocElem.Name := 'Another cool name';

  WriteLn('test assign widestring:');
//-------------------------------------------------
  LocElem.Data := Copy(ParamStr(0), 1, Length(ParamStr(0)));
//-------------------------------------------------
  WriteLn('  LocElem.Kind = ', GetEnumName(TypeInfo(TMyData.TKind), Ord(LocElem.Data.Kind)));
  WriteLn('  LocElem.Data = ', widestring(LocElem.Data));

  WriteLn('test record copy:');
//-------------------------------------------------
  Elem2 := LocElem;
//-------------------------------------------------
  WriteLn('  Elem2.Name = ', Elem2.Name);
  WriteLn('  Elem2.Kind = ', GetEnumName(TypeInfo(TMyData.TKind), Ord(Elem2.Data.Kind)));
  WriteLn('  Elem2.Data = ', widestring(Elem2.Data));

  WriteLn('test assign bytes:');
//-------------------------------------------------
  LocElem.Data := [1, 2, 3, 5, 157, 211];
//-------------------------------------------------
  WriteLn('  LocElem.Kind = ', GetEnumName(TypeInfo(TMyData.TKind), Ord(LocElem.Data.Kind)));
  WriteLn('  LocElem.Data.Length = ', Length(TBytes(LocElem.Data)));

  WriteLn('test assign to bytes:');
//-------------------------------------------------
  b := LocElem.Data;
//-------------------------------------------------
  WriteLn('  b.Length = ', Length(b));
  WriteLn('  b[High(b)] = ', b[High(b)]);

  WriteLn('test type mismatch:');
  try
    WStr := LocElem.Data;
    WriteLn('  WStr = ', WStr);
  except
    on e: Exception do
      WriteLn('  raised exception ', e.ClassName, ' with message "', e.Message,'"');
  end;
end;

begin
  SetHeapTraceOutput('heap.log');

  Elem1.Name := 'Unnamed';
  Elem1.Data := 'test string';

  WriteLn('global Elem1 is:');
  WriteLn('  Name = ', Elem1.Name);
  WriteLn('  Kind = ', GetEnumName(TypeInfo(TMyData.TKind), Ord(Elem1.Data.Kind)));
  WriteLn('  Data = ', widestring(Elem1.Data));

  WriteLn('global Elem2 is:');
  WriteLn('  Name = ', Elem2.Name);
  WriteLn('  Kind = ', GetEnumName(TypeInfo(TMyData.TKind), Ord(Elem2.Data.Kind)));
  WriteLn('  Data = ', CurrToStr(Elem2.Data));

  Test;

  WriteLn('global Elem1 is:');
  WriteLn('  Name = ', Elem1.Name);
  WriteLn('  Kind = ', GetEnumName(TypeInfo(TMyData.TKind), Ord(Elem1.Data.Kind)));
  WriteLn('  Data = ', CurrToStr(Elem1.Data));

  WriteLn('global Elem2 is:');
  WriteLn('  Name = ', Elem2.Name);
  WriteLn('  Kind = ', GetEnumName(TypeInfo(TMyData.TKind), Ord(Elem2.Data.Kind)));
  WriteLn('  Data = ', widestring(Elem2.Data));

  ReadLn;
end.


[Alek_Aaz]

Оно умеет и в числа, и в строки, и в байты, и в копирование. Только с массивами в вариантах есть некоторая сложность, их нужно через VarArrayCreate() определять.

Да, с ними нормально получается. Только наверное не VarArrayCreate, а лучше через DynArrayToVariant и DynArrayFromVariant

правда ценой оверхеда в два указателя и требует версии компилятора не меньше 3.2.0:

Блин, попытался сделать красиво для DynArrayToVarian компилятор ругается. Это версия не та походу 3.0.4. Вообще конструкция правильная?

Код: Выделить всё

TECSDataType=(ecsByte,ecsInteger,ecsReal,ecsString,ecsArray);

TECSElement = record
          name:string;
      dataType:TECSDataType;
          data:variant;
   class operator Initialize(var d: TECSElement);  //   <--- матерится вот на этой строке
   class operator := (const aValue: array of byte): TECSElement;
   class operator := (constref aData: TECSElement): array of byte;
end;   


....
class operator TECSElement.:=(const aValue: array of byte): TECSElement;
begin
  Result.dataType:=ecsArray;
  DynArrayToVariant(Result.data,Pointer(aValue),TypeInfo(aValue));
end;

class operator TECSElement.:=(constref aData: TECSElement): array of byte;
begin
  If adata.dataType=ecsArray then
  DynArrayFromVariant(Pointer(Result),aData.data,TypeInfo(Result));
end;


Добавлено спустя 43 минуты 16 секунд:
Не понял, как версия 3.2 компилятора когда только 3.1.х в разработке а 3.0.4 релиз последней???
Ты из будущего???

[runewalsh]

iskander
Можно уменьшить оверхед, спрятав managed-поля за указателем:

Код: Выделить всё

unit vdata;

{$mode objfpc}{$H+}
{$modeswitch advancedrecords}

interface

uses
   SysUtils;

type
   TMyData = record
   public
   type
      TKind = (knEmpty, knInt64, knCurrency, knWideString, knBytes);

   strict private
      FKind: TKind;
      FBuffer: record
         case TKind of
            0: (Int: Int64);
            1: (Cur: Currency);
            2: (Managed: pointer);
         end;
      procedure Release(aNewKind: TKind);
      procedure CheckMismatch(aReqKind: TKind);
      class operator Initialize(var d: TMyData);
      class operator Finalize(var d: TMyData);
   public
      class operator := (aValue: Int64): TMyData;
      class operator := (aValue: Currency): TMyData;
      class operator := (const aValue: widestring): TMyData;
      class operator := (const aValue: TBytes): TMyData;
      class operator := (constref aData: TMyData): Int64;
      class operator := (constref aData: TMyData): Currency;
      class operator := (constref aData: TMyData): widestring;
      class operator := (constref aData: TMyData): TBytes;
      property Kind: TKind read FKind;
   end;

implementation

   procedure TMyData.Release(aNewKind: TKind);
   begin
      if aNewKind <> Kind then
      begin
         case Kind of
            knWideString: widestring(FBuffer.Managed) := '';
            knBytes: TBytes(FBuffer.Managed) := nil;
         end;
         FKind := aNewKind;
      end;
   end;

   procedure TMyData.CheckMismatch(aReqKind: TKind);
   begin
      if (Kind <> knEmpty) and (aReqKind <> Kind) then
         raise EInvalidCast.Create('Data type mismatch');
   end;

   class operator TMyData.Initialize(var d: TMyData);
   begin
      d.FKind := knEmpty;
      d.FBuffer.Managed := nil;
   end;

   class operator TMyData.Finalize(var d: TMyData);
   begin
      d.Release(knEmpty);
   end;

   class operator TMyData.:=(aValue: Int64): TMyData;
   begin
      Result.Release(knInt64);
      Result.FBuffer.Int := aValue;
   end;

   class operator TMyData.:=(aValue: Currency): TMyData;
   begin
      Result.Release(knCurrency);
      Result.FBuffer.Cur := aValue;
   end;

   class operator TMyData.:=(const aValue: widestring): TMyData;
   begin
      Result.Release(knWideString);
      widestring(Result.FBuffer.Managed) := aValue;
   end;

   class operator TMyData.:=(const aValue: TBytes): TMyData;
   begin
      Result.Release(knBytes);
      TBytes(Result.FBuffer.Managed) := aValue;
   end;

   class operator TMyData.:=(constref aData: TMyData): Int64;
   begin
      if aData.Kind = knEmpty then
         exit(0);
      aData.CheckMismatch(knInt64);
      Result := aData.FBuffer.Int;
   end;

   class operator TMyData.:=(constref aData: TMyData): Currency;
   begin
      if aData.Kind = knEmpty then
         exit(0);
      aData.CheckMismatch(knCurrency);
      Result := aData.FBuffer.Cur;
   end;

   class operator TMyData.:=(constref aData: TMyData): widestring;
   begin
      if aData.Kind = knEmpty then
         exit('');
      aData.CheckMismatch(knWideString);
      Result := widestring(aData.FBuffer.Managed);
   end;

   class operator TMyData.:=(constref aData: TMyData): TBytes;
   begin
      if aData.Kind = knEmpty then
         exit(nil);
      aData.CheckMismatch(knBytes);
      Result := TBytes(aData.FBuffer.Managed);
   end;

end.

Единственное существенное отличие — явные зануление в Initialize и освобождение в Finalize. В твоём «безопасном» варианте, ладно размер структуры, но компилятор ещё и будет тратить время CPU на автоматические инициализацию и освобождение всех managed-полей, хотя на деле это нужно максимум одному из них.

Вариант с ещё несколькими косметическими изменениями на мой вкус :3:

Код: Выделить всё

unit vdata;

{$mode objfpc}{$H+}
{$modeswitch advancedrecords}

interface

uses
   typinfo, SysUtils;

type
   TMyData = record
   public
   type
      TKind = (knEmpty, knInt64, knCurrency, knWideString, knBytes);

   strict private
      FKind: TKind;
      FBuffer: record
         case TKind of
            0: (Int: Int64);
            1: (Cur: Currency);
            2: (Managed: pointer);
         end;
      procedure Reset(aNewKind: TKind);
      function Mismatch(const aTargetName: string): Exception;
      class operator Initialize(var d: TMyData);
      class operator Finalize(var d: TMyData);
   public
      class operator := (aValue: Int64): TMyData;
      class operator := (aValue: Currency): TMyData;
      class operator := (const aValue: widestring): TMyData;
      class operator := (const aValue: TBytes): TMyData;
      class operator := (const aData: TMyData): Int64;
      class operator := (const aData: TMyData): Currency;
      class operator := (const aData: TMyData): widestring;
      class operator := (const aData: TMyData): TBytes;
      property Kind: TKind read FKind;
   end;

implementation

   procedure TMyData.Reset(aNewKind: TKind);
   begin
      if aNewKind <> Kind then
      begin
         case Kind of
            knWideString: widestring(FBuffer.Managed) := '';
            knBytes: TBytes(FBuffer.Managed) := nil;
         end;
         FKind := aNewKind;
      end;
   end;

   function TMyData.Mismatch(const aTargetName: string): Exception;
   begin
      result := EInvalidCast.CreateFmt('Data type mismatch: %s -> %s.',
         [GetEnumName(TypeInfo(FKind), Ord(FKind)), aTargetName]);
   end;

   class operator TMyData.Initialize(var d: TMyData);
   begin
      d.FKind := knEmpty;
      d.FBuffer.Managed := nil;
   end;

   class operator TMyData.Finalize(var d: TMyData);
   begin
      d.Reset(knEmpty);
   end;

   class operator TMyData.:=(aValue: Int64): TMyData;
   begin
      Result.Reset(knInt64);
      Result.FBuffer.Int := aValue;
   end;

   class operator TMyData.:=(aValue: Currency): TMyData;
   begin
      Result.Reset(knCurrency);
      Result.FBuffer.Cur := aValue;
   end;

   class operator TMyData.:=(const aValue: widestring): TMyData;
   begin
      Result.Reset(knWideString);
      widestring(Result.FBuffer.Managed) := aValue;
   end;

   class operator TMyData.:=(const aValue: TBytes): TMyData;
   begin
      Result.Reset(knBytes);
      TBytes(Result.FBuffer.Managed) := aValue;
   end;

   class operator TMyData.:=(const aData: TMyData): Int64;
   begin
      case aData.Kind of
         knEmpty: Result := 0;
         knInt64: Result := aData.FBuffer.Int;
         else raise aData.Mismatch('Int64');
      end;
   end;

   class operator TMyData.:=(const aData: TMyData): Currency;
   begin
      case aData.Kind of
         knEmpty: Result := 0;
         knCurrency: Result := aData.FBuffer.Cur;
         else raise aData.Mismatch('Currency');
      end;
   end;

   class operator TMyData.:=(const aData: TMyData): widestring;
   begin
      case aData.Kind of
         knEmpty: Result := '';
         knWideString: Result := widestring(aData.FBuffer.Managed);
         else raise aData.Mismatch('widestring');
      end;
   end;

   class operator TMyData.:=(const aData: TMyData): TBytes;
   begin
      case aData.Kind of
         knEmpty: Result := nil;
         knBytes: Result := TBytes(aData.FBuffer.Managed);
         else raise aData.Mismatch('TBytes');
      end;
   end;

end.

Более подробное сообщение об ошибке, более локальные проверки и более точечный контроль за преобразованиями (если к результату приводимы данные нескольких TKind'ов, в operator := и так уже будет бранч по Kind, и CheckMismatch станет избыточной и неудобной — отчасти это уже так и есть с проверками на knEmpty), и constref вроде бы не нужен.

[iskander]

Не понял, как версия 3.2 компилятора когда только 3.1.х в разработке а 3.0.4 релиз последней???
Ты из будущего???

В разработке 3.3.1, 3.2.0 вот-вот выйдет, fpc-3.2.0-beta доступен уже сейчас.

runewalsh, спасибо, посмотрю попозже.

Добавлено спустя 2 часа 52 минуты 14 секунд:
runewalsh, кажется, то что доктор прописал, особенно второй вариант. Красота.
А constref это просто гарантия передачи по ссылке, const этого не гарантирует.

[runewalsh]

А constref это просто гарантия передачи по ссылке

Так передача неизменяемого параметра по ссылке и по значению неотличимы в чистом Pascal-коде, это нужно только для бинарной совместимости с C API или ассемблером. Мотивация введения constref заключалась в том, что если у тебя есть C-функция

Код: Выделить всё

__declspec(dllexport) void SetBodyVelocity(Body* body, const Vec3* velocity);

— то раньше, чтобы соблюсти бинарную совместимость, приходилось импортировать её с var (ну или с явным PVec3, будет всё то же самое):

Код: Выделить всё

procedure SetBodyVelocity(body: PBody; var velocity: Vec3); external ...

И такую функцию нельзя напрямую вызвать с Vec3, сконструированным на месте: SetBodyVelocity(body, MakeVec3(1, 0, 0)) не скомпилируется из-за ограничения var на lvalue — объявленные переменные. constref указывает компилятору, что допустимо передать под капотом указатель на rvalue — невидимую временную переменную с результатом MakeVec3.

В случае операторов constref нужен только в class operator Copy (иначе компилятор его не узнает), и то это багофича, обусловленная внутренней реализацией managed operators (они записываются в RTTI, откуда могут быть вызваны над заранее неизвестным типом функциями вроде CopyArray). Его использование без повода может сгенерировать менее оптимальный код, т. к. той самой «временной переменной» на стеке могло вообще не быть.

[iskander]

runewalsh, ну да, я для себя так и представляю constref как const *. Почему бы его не использовать, когда это очевидно уместно, заодно избавив оптимизатор от необязательных проблем?

Блин, попытался сделать красиво для DynArrayToVarian компилятор ругается. Это версия не та походу 3.0.4. Вообще конструкция правильная?

Если непременно нужно, чтобы Data: Variant торчал наружу, то может быть так?

Код: Выделить всё

....
type
  TECSDataType=(ecsUnknown, ecsByte, ecsInteger, ecsDouble, ecsString, ecsArray);

  TECSElement = record
  private
    function  GetDataBytes: TBytes;
    procedure SetDataBytes(const aValue: TBytes);
  public
    Name: string;
    Data: Variant;
    function DataType: TECSDataType;
    property DataAsBytes: TBytes read GetDataBytes write SetDataBytes;
  end;

implementation

function TECSElement.GetDataBytes: TBytes;
begin
  DynArrayFromVariant(Pointer(Result), Data, TypeInfo(Result));
end;

procedure TECSElement.SetDataBytes(const aValue: TBytes);
begin
  DynArrayToVariant(Data, Pointer(aValue), TypeInfo(aValue))
end;

function TECSElement.DataType: TECSDataType;
begin
  case VarType(Data) of
    VarByte:     Result := ecsByte;
    VarInteger:  Result := ecsInteger;
    VarDouble:   Result := ecsDouble;
    VarString:   Result := ecsString;
    VarArray:    Result := ecsArray;
  else
    Result := ecsUnknown;
  end;
end;
....


Но имхо "шустро" с использованием Variant не будет.

[runewalsh]

заодно избавив оптимизатор от необязательных проблем?

Скорее «помешав оптимизатору». Например, единственный параметр const x: integer будет передан через регистр, а с constref x: integer вызывающему придётся записать значение в стек, чтобы вызываемый его оттуда прочитал, это лишние телодвижения.

Код: Выделить всё

var
   _sum: integer;

   procedure DoConst(const x: integer);
   begin
      _sum += x;
   end;

   procedure DoConstref(constref x: integer);
   begin
      _sum += x;
   end;

begin
   DoConst(5);
   DoConstref(5);
end.

В ассемблерном листинге (в Lazarus — брейкпоинт + запуск + Ctrl-Alt-D) видно, что constref порождает лишнее обращение к памяти как в месте вызова (запись пятёрки в стек), так и в самой функции (чтение её же в регистр), а с const эта пятёрка ни разу не покидает регистр. constref по умолчанию не нужен, ну или с тем же успехом можешь вообще по значению всё передавать, избавив оптимизатор от лишних проблем, и к тому же читателя кода от лишней когнитивной нагрузки со всеми этими квалификаторами.