paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 18:09:27 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Copy function for array helper

Browse Source
This commit is contained in:
Michaël Van Canneyt 2024-07-05 15:56:11 +02:00
parent 680c096ac5
commit e1a34d3410
2 changed files with 78 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

77
packages/rtl-generics/src/generics.collections.pas
View File

@ -121,6 +121,9 @@ type
class function BinarySearch(const AValues: array of T; const AItem: T;
out AFoundIndex: SizeInt; const AComparer: IComparer<T>;
AIndex, ACount: SizeInt): Boolean; override; overload;
class function Concat(const Args: array of TArray<T>): TArray<T>; static;
class procedure Copy(const aSource: array of T; var aDestination: array of T; aCount: NativeInt); overload;
class procedure Copy(const aSource: array of T; var aDestination: array of T; aSourceIndex, aDestIndex, aCount: SizeInt); overload;
end {$ifdef EXTRA_WARNINGS}experimental{$endif}; // will be renamed to TArray (bug #24254)
TCollectionNotification = (cnAdding, cnAdded, cnDeleting, cnRemoved, cnExtracting, cnExtracted);
@ -961,12 +964,34 @@ type
end;
function InCircularRange(ABottom, AItem, ATop: SizeInt): Boolean;
procedure ErrorArgumentOutOfRange; overload;
procedure ErrorArgumentOutOfRange(aIndex, aMaxIndex: SizeInt; aListObj: TObject); overload;
procedure ErrorArgumentOutOfRange(aIndex, aMaxIndex: SizeInt); overload;
var
EmptyRecord: TEmptyRecord;
implementation
procedure ErrorArgumentOutOfRange;
begin
raise EArgumentOutOfRangeException.Create(SArgumentOutOfRange);
end;
procedure ErrorArgumentOutOfRange(aIndex, aMaxIndex: SizeInt; aListObj: TObject); overload;
begin
raise EArgumentOutOfRangeException.Create(ListIndexErrorMsg(aIndex,aMaxIndex,aListObj));
end;
procedure ErrorArgumentOutOfRange(aIndex, aMaxIndex: SizeInt); overload;
begin
raise EArgumentOutOfRangeException.Create(ListIndexErrorMsg(aIndex,aMaxIndex,''));
end;
function InCircularRange(ABottom, AItem, ATop: SizeInt): Boolean;
begin
Result :=
@ -1211,6 +1236,58 @@ begin
end;
end;
class procedure TArrayHelper<T>.Copy(const aSource: array of T; var aDestination: array of T; aCount: NativeInt);
begin
Copy(aSource,aDestination,0,0,aCount);
end;
class procedure TArrayHelper<T>.Copy(const aSource: array of T; var aDestination: array of T; aSourceIndex, aDestIndex, aCount: SizeInt);
var
I : Integer;
begin
if (Length(aSource)>0) and (Length(aDestination)>0) and ((@aSource[0]) = (@aDestination[0])) then
raise EArgumentException.Create(SErrSameArrays);
if (aCount<0) or
(aCount>(Length(aSource)-aSourceIndex)) or
(aCount>(Length(aDestination)-aDestIndex)) then
ErrorArgumentOutOfRange;
if IsManagedType(T) then
begin
// maybe this can be optimized too ?
For I:=0 to aCount-1 do
aDestination[aDestIndex+i]:=aSource[aSourceIndex+i];
end
else
Move(Pointer(@aSource[aSourceIndex])^, Pointer(@aDestination[aDestIndex])^, SizeOf(T)*aCount);
end;
class function TArrayHelper<T>.Concat(const Args: array of TArray<T>): TArray<T>;
var
TotalLen: SizeInt;
CurLen,Dest,i: SizeInt;
begin
TotalLen:=0;
for i:=0 to Length(Args)-1 do
Inc(TotalLen,Length(Args[i]));
SetLength(Result,TotalLen);
Dest:=0;
for i:=0 to Length(Args)-1 do
begin
CurLen:=Length(Args[i]);
if CurLen>0 then
begin
Copy(Args[i],Result,0,Dest,CurLen);
Inc(Dest,CurLen);
end;
end;
end;
class function TArrayHelper<T>.BinarySearch(const AValues: array of T; const AItem: T;
out AFoundIndex: SizeInt; const AComparer: IComparer<T>;
AIndex, ACount: SizeInt): Boolean;

1
packages/rtl-generics/src/generics.strings.pas
View File

@ -33,6 +33,7 @@ resourcestring
SDictionaryKeyDoesNotExist = 'Dictionary key does not exist';
SDictionaryKeyNNNDoesNotExist = 'Dictionary key "%s" does not exist';
SItemNotFound = 'Item not found';
SErrSameArrays = 'Cannot copy between same arrays';
implementation