Browse Source

* Adding new generic Extract and Swap function to RTL

These allow to move data from one variable to another without triggering
the copy operation. Extract makes use of the newly introduced move
semantic for function results and Swap uses System.Move to not trigger
the copy mechanism.
Frederic Kehrein 8 months ago
parent
commit
64c27a86a8
3 changed files with 57 additions and 0 deletions
  1. 2 0
      rtl/objpas/sysutils/sysutilh.inc
  2. 15 0
      rtl/objpas/sysutils/sysutils.inc
  3. 40 0
      tests/test/tmoperator13.pp

+ 2 - 0
rtl/objpas/sysutils/sysutilh.inc

@@ -290,6 +290,8 @@ type
 
 generic function IfThen<T>(val:boolean;const iftrue:T; const iffalse:T) :T; inline; overload;
 generic function Exchange<T>(var target:T; const newvalue:T) :T; inline;
+generic function Extract<T>(var from: T) :T;inline;overload;
+generic procedure Swap<T>(var lhs,rhs: T);inline;overload;
 
 Var
    OnShowException : Procedure (Msg : ShortString);

+ 15 - 0
rtl/objpas/sysutils/sysutils.inc

@@ -913,6 +913,21 @@ begin
   target := newvalue;
 end;
 
+generic function Extract<T>(var from: T) :T;
+begin
+  Finalize(Result);
+  Move(from,Result,SizeOf(T));
+  Initialize(from);
+end;
+
+generic procedure Swap<T>(var lhs,rhs: T);
+var
+  tmp:array[0..sizeof(T)-1] of Byte;
+begin
+  Move(lhs,tmp,sizeof(T));
+  Move(rhs,lhs,sizeof(T));
+  Move(tmp,rhs,sizeof(T));
+end;
 
 Function ArrayOfConstToStrArray(const Args: array of const) : TUTF8StringDynArray;
 

+ 40 - 0
tests/test/tmoperator13.pp

@@ -0,0 +1,40 @@
+{$Mode ObjFpc}{$H+}
+{$ModeSwitch AdvancedRecords}
+
+uses SysUtils;
+
+type
+  TMyRec = record
+    i: Integer;
+    class operator :=(const rhs: Integer): TMyRec;
+    class operator Copy(constref src: TMyRec; var dst: TMyRec);
+  end;
+
+class operator TMyRec.:=(const rhs: Integer): TMyRec;
+begin
+  Result.i:=rhs;
+end;
+
+var
+  CopyCount: Integer = 0;
+class operator TMyRec.Copy(constref src: TMyRec; var dst: TMyRec);
+begin
+  Inc(CopyCount);
+  dst.i:=src.i;
+end;
+
+var
+  r1, r2, r3: TMyRec;
+begin
+  r1 := 42;
+  r2 := 32;
+  specialize Swap<TMyRec>(r1,r2);
+  if (r1.i<>32) or (r2.i<>42) then
+    Halt(1);
+  r3 := specialize Extract<TMyRec>(r1);
+  if (r3.i<>32) then
+    Halt(2);
+  if CopyCount <> 0 then
+    Halt(3);
+  WriteLn('Ok');
+end.