delphi – 如何使用Move测试类型是否可以安全复制

我正在写一个通用的矢量类型：

type
  TBigVector<T: record> = class
  private
    FSize: Integer;
    FEntries: TArray<T>;
    function GetEntry(Index: Integer): T; 
    procedure SetEntry(Index: Integer; const Value: T); 
    procedure SetSize(Value: Integer); 
  public
    constructor Create(ASize: Integer);
    property Size: Integer read FSize write SetSize;
    property Entry[Index: Integer]: T read GetEntry write SetEntry; default;
    procedure Zeroise;
    function ToArray: TArray<T>; 
  end;

然后我想派生这样的类：

TDoubleBigVector = class(TBigVector<Double>)
  ....
end;
TComplexBigVector = class(TBigVector<Complex>)
  ....
end;

我必须派生类,因为我无法在泛型类型中实现算术运算.这是因为通用约束不够丰富,我不能约束T来支持所需的算术运算.儿！

无论如何,够了.我的问题涉及Zeroise和ToArray的实现.出于性能原因,我想使用原始内存操作.例如,Zeroise可能是：

procedure TBigVector<T>.Zeroise;
begin
  ZeroMemory(Pointer(FEntries),Size*SizeOf(T));
end;

现在,对于像Double和我的定制复杂类型这样的类型,我很好.我知道他们没有被管理,原始内存副本没有任何困难.我想要做的是添加一个运行时检查,可能只在我的调试版本中调用,它强制执行T没有托管类型的约束.我怎样才能做到这一点？

解决方法

我会这样做：

program SO21753006;

{$APPTYPE CONSOLE}

uses
  TypInfo,Windows,SysUtils;

type
  TProblemRecord1 = record
    I : Integer;
    S : String;
  end;

  TProblemRecord2 = record
    Obj : TObject;
  end;

  TGoodRecord = record
    I : Integer;
    K : Double;
    S : Array[0..10] of Char;
  end;


  TBigVector<T: record> = class
  private
    FSize: Integer;
    FEntries: TArray<T>;
    function GetEntry(Index: Integer): T;
    procedure SetEntry(Index: Integer; const Value: T);
    procedure SetSize(Value: Integer);
  public
    constructor Create(ASize: Integer);
    property Size: Integer read FSize write SetSize;
    property Entry[Index: Integer]: T read GetEntry write SetEntry; default;
    procedure Zeroise;
    function ToArray: TArray<T>;
  end;


function RecordHasNoManagedTypes(Typ : PTypeInfo) : Boolean;

var
 TypeData : PTypeData;

begin
 Assert(Assigned(Typ));
 Result := True;
 // only check if we have a record,or else we have a value type
 if Typ.Kind = tkRecord then
  begin
   TypeData := GetTypeData(Typ);
   Result := TypeData.ManagedFldCount = 0;
  end;
end;

{ TBigVector<T> }

constructor TBigVector<T>.Create(ASize: Integer);
begin
 Size := ASize;
end;

function TBigVector<T>.GetEntry(Index: Integer): T;
begin
end;

procedure TBigVector<T>.SetEntry(Index: Integer; const Value: T);
begin
end;

procedure TBigVector<T>.SetSize(Value: Integer);
begin
 SetLength(FEntries,Value);
end;

function TBigVector<T>.ToArray: TArray<T>;
begin
end;

procedure TBigVector<T>.Zeroise;
begin
 Assert(RecordHasNoManagedTypes(TypeInfo(T)),'T must not have managed types!');
 ZeroMemory(Pointer(FEntries),Size*SizeOf(T));
end;

var
  Rec1 : TBigVector<Double>;
  Rec2 : TBigVector<TGoodRecord>;
  Rec3 : TBigVector<TProblemRecord1>;
  Rec4 : TBigVector<TProblemRecord2>;

begin
  try
    Writeln('Double type');
    Rec1 := TBigVector<Double>.Create(1);
    Rec1.Zeroise;
    Writeln('GoodRecord type');
    Rec2 := TBigVector<TGoodRecord>.Create(10);
    Rec2.Zeroise;
    try
     Writeln('Problemrecord1 type');
     Rec3 := TBigVector<TProblemRecord1>.Create(10);
     Rec3.Zeroise;
    except
     on E: Exception do
      Writeln(E.ClassName,': ',E.Message);
    end;
    try
     Writeln('Problemrecord2 type');
     Rec4 := TBigVector<TProblemRecord2>.Create(10);
     Rec4.Zeroise;
    except
     on E: Exception do
      Writeln(E.ClassName,E.Message);
    end;
  except
   on E: Exception do
    Writeln(E.ClassName,E.Message);
  end;
  Readln;
end.

不管理非ARC平台的TObject,因此使用ManagedFldCount在此处有效.

UPDATE

正如David指出的那样,在最近的Delphi版本中(阅读：来自D2010),您可以使用@L_502_0@功能.

代码看起来像这样：

procedure TBigVector<T>.Zeroise;
begin
 Assert(not RTTI.IsManaged(TypeInfo(T)),Size*SizeOf(T));
end;

更新2
从XE7开始,您可以使用内部函数System.IsManagedType(T).这将在编译时解决,导致零运行时开销.

如果IsManagedType(T)则Assert(false,’T最不是托管类型’);

不要执行Assert(不是(IsManagedType(T)),因为编译器将无法删除Assert,但如果它不适用,它将消除if.

delphi – 如何使用Move测试类型是否可以安全复制

解决方法

猜你在找的Delphi相关文章