Browse Source

Update for Generics.Collections library

maciej-izak 7 years ago
parent
commit
ba8c438c9b

+ 19 - 4
Units/Utils/generics.collections.pas

@@ -54,7 +54,13 @@ uses
   OTHER: 25595, 25612, 25615, 25617, 25618, 25619
   OTHER: 25595, 25612, 25615, 25617, 25618, 25619
 }
 }
 
 
+{.$define EXTRA_WARNINGS}
+
 type
 type
+  {$ifdef VER3_0_0}
+  TArray<T> = array of T;
+  {$endif}
+
   // bug #24254 workaround
   // bug #24254 workaround
   // should be TArray = record class procedure Sort<T>(...) etc.
   // should be TArray = record class procedure Sort<T>(...) etc.
   TCustomArrayHelper<T> = class abstract
   TCustomArrayHelper<T> = class abstract
@@ -80,7 +86,7 @@ type
       out AFoundIndex: SizeInt; const AComparer: IComparer<T>): Boolean; overload;
       out AFoundIndex: SizeInt; const AComparer: IComparer<T>): Boolean; overload;
     class function BinarySearch(constref AValues: array of T; constref AItem: T;
     class function BinarySearch(constref AValues: array of T; constref AItem: T;
       out AFoundIndex: SizeInt): Boolean; overload;
       out AFoundIndex: SizeInt): Boolean; overload;
-  end experimental; // will be renamed to TCustomArray (bug #24254)
+  end {$ifdef EXTRA_WARNINGS}experimental{$endif}; // will be renamed to TCustomArray (bug #24254)
 
 
   TArrayHelper<T> = class(TCustomArrayHelper<T>)
   TArrayHelper<T> = class(TCustomArrayHelper<T>)
   protected
   protected
@@ -90,7 +96,7 @@ type
     class function BinarySearch(constref AValues: array of T; constref AItem: T;
     class function BinarySearch(constref AValues: array of T; constref AItem: T;
       out AFoundIndex: SizeInt; const AComparer: IComparer<T>;
       out AFoundIndex: SizeInt; const AComparer: IComparer<T>;
       AIndex, ACount: SizeInt): Boolean; override; overload;
       AIndex, ACount: SizeInt): Boolean; override; overload;
-  end experimental; // will be renamed to TArray (bug #24254)
+  end {$ifdef EXTRA_WARNINGS}experimental{$endif}; // will be renamed to TArray (bug #24254)
 
 
   TCollectionNotification = (cnAdded, cnRemoved, cnExtracted);
   TCollectionNotification = (cnAdded, cnRemoved, cnExtracted);
   TCollectionNotifyEvent<T> = procedure(ASender: TObject; constref AItem: T; AAction: TCollectionNotification)
   TCollectionNotifyEvent<T> = procedure(ASender: TObject; constref AItem: T; AAction: TCollectionNotification)
@@ -706,9 +712,10 @@ end;
 procedure TList<T>.SetItem(AIndex: SizeInt; const AValue: T);
 procedure TList<T>.SetItem(AIndex: SizeInt; const AValue: T);
 begin
 begin
   if (AIndex < 0) or (AIndex >= Count) then
   if (AIndex < 0) or (AIndex >= Count) then
-    raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
-
+    raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);   
+  Notify(FItems[AIndex], cnRemoved);
   FItems[AIndex] := AValue;
   FItems[AIndex] := AValue;
+  Notify(AValue, cnAdded);
 end;
 end;
 
 
 function TList<T>.GetEnumerator: TEnumerator;
 function TList<T>.GetEnumerator: TEnumerator;
@@ -1003,7 +1010,9 @@ constructor TThreadList<T>.Create;
 begin
 begin
   inherited Create;
   inherited Create;
   FDuplicates:=dupIgnore;
   FDuplicates:=dupIgnore;
+{$ifdef FPC_HAS_FEATURE_THREADING}
   InitCriticalSection(FLock);
   InitCriticalSection(FLock);
+{$endif}
   FList := TList<T>.Create;
   FList := TList<T>.Create;
 end;
 end;
 
 
@@ -1015,7 +1024,9 @@ begin
     inherited Destroy;
     inherited Destroy;
   finally
   finally
     UnlockList;
     UnlockList;
+{$ifdef FPC_HAS_FEATURE_THREADING}
     DoneCriticalSection(FLock);
     DoneCriticalSection(FLock);
+{$endif}
   end;
   end;
 end;
 end;
 
 
@@ -1055,12 +1066,16 @@ end;
 function TThreadList<T>.LockList: TList<T>;
 function TThreadList<T>.LockList: TList<T>;
 begin
 begin
   Result:=FList;
   Result:=FList;
+{$ifdef FPC_HAS_FEATURE_THREADING}
   System.EnterCriticalSection(FLock);
   System.EnterCriticalSection(FLock);
+{$endif}
 end;
 end;
 
 
 procedure TThreadList<T>.UnlockList;
 procedure TThreadList<T>.UnlockList;
 begin
 begin
+{$ifdef FPC_HAS_FEATURE_THREADING}
   System.LeaveCriticalSection(FLock);
   System.LeaveCriticalSection(FLock);
+{$endif}
 end;
 end;
 
 
 { TQueue<T>.TEnumerator }
 { TQueue<T>.TEnumerator }

+ 3 - 3
Units/Utils/generics.defaults.pas

@@ -554,7 +554,7 @@ type
     EqualityComparer_Method_VMT : THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Method ; GetHashCode: @THashFactory.Method );
     EqualityComparer_Method_VMT : THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Method ; GetHashCode: @THashFactory.Method );
     EqualityComparer_Variant_VMT: THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Variant; GetHashCode: @THashFactory.Variant);
     EqualityComparer_Variant_VMT: THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Variant; GetHashCode: @THashFactory.Variant);
     EqualityComparer_Pointer_VMT: THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Pointer; GetHashCode: @THashFactory.Pointer);
     EqualityComparer_Pointer_VMT: THashFactory.TEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Pointer; GetHashCode: @THashFactory.Pointer);
-{$WARNINGS ON}
+{.$WARNINGS ON} // do not enable warnings ever in this unit, or you will get many warnings about uninitialized TEqualityComparerVMT fields
   private class var
   private class var
     // IEqualityComparer VMT
     // IEqualityComparer VMT
     FEqualityComparer_Int8_VMT  : THashFactory.TEqualityComparerVMT;
     FEqualityComparer_Int8_VMT  : THashFactory.TEqualityComparerVMT;
@@ -673,7 +673,7 @@ type
     ExtendedEqualityComparer_Method_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Method ; GetHashCode: @THashFactory.Method ; GetHashList: @TExtendedHashFactory.Method );
     ExtendedEqualityComparer_Method_VMT : TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Method ; GetHashCode: @THashFactory.Method ; GetHashList: @TExtendedHashFactory.Method );
     ExtendedEqualityComparer_Variant_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Variant; GetHashCode: @THashFactory.Variant; GetHashList: @TExtendedHashFactory.Variant);
     ExtendedEqualityComparer_Variant_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Variant; GetHashCode: @THashFactory.Variant; GetHashList: @TExtendedHashFactory.Variant);
     ExtendedEqualityComparer_Pointer_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Pointer; GetHashCode: @THashFactory.Pointer; GetHashList: @TExtendedHashFactory.Pointer);
     ExtendedEqualityComparer_Pointer_VMT: TExtendedHashFactory.TExtendedEqualityComparerVMT = (STD_RAW_INTERFACE_METHODS; Equals: @TEquals.Pointer; GetHashCode: @THashFactory.Pointer; GetHashList: @TExtendedHashFactory.Pointer);
-{$WARNINGS ON}
+{.$WARNINGS ON} // do not enable warnings ever in this unit, or you will get many warnings about uninitialized TEqualityComparerVMT fields
   private class var
   private class var
     // IExtendedEqualityComparer VMT
     // IExtendedEqualityComparer VMT
     FExtendedEqualityComparer_Int8_VMT  : TExtendedHashFactory.TExtendedEqualityComparerVMT;
     FExtendedEqualityComparer_Int8_VMT  : TExtendedHashFactory.TExtendedEqualityComparerVMT;
@@ -2879,7 +2879,7 @@ begin
   else
   else
     raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
     raise EArgumentOutOfRangeException.CreateRes(@SArgumentOutOfRange);
   end;
   end;
-{$WARNINGS ON}
+{.$WARNINGS ON} // do not enable warnings ever in this unit, or you will get many warnings about uninitialized TEqualityComparerVMT fields
 end;
 end;
 
 
 { TDelphiQuadrupleHashFactory }
 { TDelphiQuadrupleHashFactory }

+ 1 - 12
Units/Utils/generics.memoryexpanders.pas

@@ -47,12 +47,7 @@ type
   { TQuadraticProbing }
   { TQuadraticProbing }
 
 
   TQuadraticProbing = class(TProbeSequence)
   TQuadraticProbing = class(TProbeSequence)
-  private
-    class constructor Create;
   public
   public
-    class var C1: UInt32;
-    class var C2: UInt32;
-
     class function Probe(I, Hash: UInt32): UInt32; static; inline;
     class function Probe(I, Hash: UInt32): UInt32; static; inline;
 
 
     const MAX_LOAD_FACTOR = 0.5;
     const MAX_LOAD_FACTOR = 0.5;
@@ -214,15 +209,9 @@ end;
 
 
 { TQuadraticProbing }
 { TQuadraticProbing }
 
 
-class constructor TQuadraticProbing.Create;
-begin
-  C1 := 1;
-  C2 := 1;
-end;
-
 class function TQuadraticProbing.Probe(I, Hash: UInt32): UInt32;
 class function TQuadraticProbing.Probe(I, Hash: UInt32): UInt32;
 begin
 begin
-  Result := (Hash + C1 * I {%H-}+ C2 * Sqr(I));
+  Result := (Hash + Sqr(I));
 end;
 end;
 
 
 { TDoubleHashingNoMod }
 { TDoubleHashingNoMod }