Browse Source

+ Capitalization of TBits interface fixed; CheckBitIndex now checks for
size (merged)

peter 25 years ago
parent
commit
b3e96b9239
2 changed files with 41 additions and 27 deletions
  1. 17 9
      fcl/inc/bits.inc
  2. 24 18
      fcl/inc/classesh.inc

+ 17 - 9
fcl/inc/bits.inc

@@ -18,25 +18,28 @@
 ResourceString
   SErrInvalidBitIndex = 'Invalid bit index : %d';
   SErrindexTooLarge   = 'Bit index exceeds array limit: %d';
+  SErrOutOfMemory     = 'Out of memory';
 
 Procedure BitsError (Msg : string);
 
 begin
   Raise EBitsError.Create(Msg);
 end;
+
 Procedure BitsErrorFmt (Msg : string; Args : array of const);
 
 begin
   Raise EBitsError.CreateFmt(Msg,args);
 end;
 
-procedure CheckBitIndex (Bit : longint);
+procedure TBits.CheckBitIndex (Bit : longint;CurrentSize : Boolean);
 
 begin
- if (bit<0) then
+ if (bit<0) or (CurrentSize and (Bit>Size)) then
    BitsErrorFmt(SErrInvalidBitIndex,[bit]);
  if (bit>=MaxBitFlags) then
    BitsErrorFmt(SErrIndexTooLarge,[bit])
+
 end;
 
 { ************* functions to match TBits class ************* }
@@ -113,7 +116,7 @@ var
    newSize : longint;
    loop : longint;
 begin
-   CheckBitindex(nbit);
+   CheckBitindex(nbit,false);
 
    newSize :=  (nbit shr BITSHIFT) + 1;
 
@@ -121,13 +124,14 @@ begin
    begin
       ReAllocMem(FBits, newSize * SizeOf(longint));
       if FBits <> nil then
-      begin
+        begin
          if newSize > FSize then
             for loop := FSize to newSize - 1 do
                FBits^[loop] := 0;
-
          FSize := newSize;
-      end;
+       end
+      else
+        BitsError(SErrOutOfMemory);
    end;
 end;
 
@@ -149,7 +153,7 @@ procedure TBits.clear(bit : longint);
 var
    n : longint;
 begin
-   CheckBitIndex(bit);
+   CheckBitIndex(bit,false);
    n := bit shr BITSHIFT;
    grow(bit);
    FBits^[n] := FBits^[n] and not(longint(1) shl (bit and MASK));
@@ -167,7 +171,7 @@ function TBits.get(bit : longint) : Boolean;
 var
    n : longint;
 begin
-   CheckBitIndex(bit);
+   CheckBitIndex(bit,true);
    result := False;
    n := bit shr BITSHIFT;
    if (n < FSize) then
@@ -368,7 +372,11 @@ end;
 
 {
   $Log$
-  Revision 1.3  2000-10-15 09:27:48  peter
+  Revision 1.4  2000-10-15 10:04:39  peter
+    + Capitalization of TBits interface fixed; CheckBitIndex now checks for
+      size (merged)
+
+  Revision 1.3  2000/10/15 09:27:48  peter
     + Added some index checking. Centralized error handling (merged)
 
   Revision 1.2  2000/07/13 11:32:58  michael

+ 24 - 18
fcl/inc/classesh.inc

@@ -202,31 +202,33 @@ type
 
       { functions and properties to match TBits class }
       procedure SetBit(bit : longint; value : Boolean);
-      function getSize : longint;
-      procedure setSize(value : longint);
+      function GetSize : longint;
+      procedure SetSize(value : longint);
+      procedure CheckBitIndex (Bit : longint;CurrentSize : Boolean);
+
    public
       { Public declarations }
-      constructor Create(theSize : longint); virtual;
+      constructor Create(TheSize : longint); virtual;
       destructor Destroy; override;
-      function  getFSize : longint;
-      procedure seton(bit : longint);
-      procedure clear(bit : longint);
-      procedure clearall;
-      procedure andbits(bitset : TBits);
-      procedure orbits(bitset : TBits);
-      procedure xorbits(bitset : TBits);
-      procedure notbits(bitset : TBits);
-      function  get(bit : longint) : boolean;
-      procedure grow(nbit : longint);
-      function  equals(bitset : TBits) : Boolean;
-      procedure SetIndex(index : longint);
-      function  FindFirstBit(state : boolean) : longint;
+      function  GetFSize : longint;
+      procedure SetOn(Bit : longint);
+      procedure Clear(Bit : longint);
+      procedure Clearall;
+      procedure AndBits(BitSet : TBits);
+      procedure OrBits(BitSet : TBits);
+      procedure XorBits(BitSet : TBits);
+      procedure NotBits(BitSet : TBits);
+      function  Get(Bit : longint) : boolean;
+      procedure Grow(NBit : longint);
+      function  Equals(BitSet : TBits) : Boolean;
+      procedure SetIndex(Index : longint);
+      function  FindFirstBit(State : boolean) : longint;
       function  FindNextBit : longint;
       function  FindPrevBit : longint;
 
       { functions and properties to match TBits class }
       function OpenBit: longint;
-      property Bits[bit: longint]: Boolean read get write SetBit; default;
+      property Bits[Bit: longint]: Boolean read get write SetBit; default;
       property Size: longint read getSize write setSize;
    end;
 
@@ -1234,7 +1236,11 @@ function LineStart(Buffer, BufPos: PChar): PChar;
 
 {
   $Log$
-  Revision 1.3  2000-08-15 04:10:38  peter
+  Revision 1.4  2000-10-15 10:04:39  peter
+    + Capitalization of TBits interface fixed; CheckBitIndex now checks for
+      size (merged)
+
+  Revision 1.3  2000/08/15 04:10:38  peter
     * delphi compatibility fix
 
   Revision 1.2  2000/07/13 11:32:59  michael