浏览代码

--- Merging r40524 into '.':
U rtl/objpas/classes/bits.inc
U rtl/objpas/classes/classesh.inc
A tests/test/units/classes/ttbits.pp
--- Recording mergeinfo for merge of r40524 into '.':
U .

# revisions: 40524

git-svn-id: branches/fixes_3_2@40727 -

marco 6 年之前
父节点
当前提交
3bdf46a423
共有 4 个文件被更改,包括 61 次插入0 次删除
  1. 1 0
      .gitattributes
  2. 6 0
      rtl/objpas/classes/bits.inc
  3. 1 0
      rtl/objpas/classes/classesh.inc
  4. 53 0
      tests/test/units/classes/ttbits.pp

+ 1 - 0
.gitattributes

@@ -13980,6 +13980,7 @@ tests/test/units/classes/tbytesstreamtest.pp svneol=native#text/pascal
 tests/test/units/classes/tmakeobjinst.pp svneol=native#text/plain
 tests/test/units/classes/tsetstream.pp svneol=native#text/plain
 tests/test/units/classes/tstringlistexchange.pp svneol=native#text/pascal
+tests/test/units/classes/ttbits.pp svneol=native#text/pascal
 tests/test/units/classes/tvclcomobject.pp svneol=native#text/plain
 tests/test/units/cpu/tcpu1.pp svneol=native#text/pascal
 tests/test/units/crt/tcrt.pp svneol=native#text/plain

+ 6 - 0
rtl/objpas/classes/bits.inc

@@ -173,6 +173,12 @@ begin
       result := (FBits^[n] and (longint(1) shl (bit and MASK))) <> 0;
 end;
 
+procedure TBits.CopyBits(BitSet : TBits);
+begin
+  setSize(bitset.Size);
+  Move(bitset.FBits^,FBits^,FSize*SizeOf(cardinal));
+end;
+
 procedure TBits.andbits(bitset : TBits);
 var
    n : longint;

+ 1 - 0
rtl/objpas/classes/classesh.inc

@@ -400,6 +400,7 @@ type
       procedure SetOn(Bit : longint);
       procedure Clear(Bit : longint);
       procedure Clearall;
+      procedure CopyBits(BitSet : TBits);
       procedure AndBits(BitSet : TBits);
       procedure OrBits(BitSet : TBits);
       procedure XorBits(BitSet : TBits);

+ 53 - 0
tests/test/units/classes/ttbits.pp

@@ -0,0 +1,53 @@
+program ttbits;
+
+{$MODE objfpc}{$H+}
+
+uses
+  Classes;
+
+procedure Fail;
+begin
+  Writeln('Err!');
+  Halt(1);
+end;
+
+procedure FillWithRandom(b: TBits);
+var
+  I: Integer;
+begin
+  for I := 0 to b.Size - 1 do
+    b[I] := Random(2) <> 0;
+end;
+
+procedure TestCopyBits;
+const
+  NumTests = 100;
+  MaxBits = 200;
+var
+  b1: TBits = nil;
+  b2: TBits = nil;
+  I: Integer;
+begin
+  try
+    b1 := TBits.Create;
+    b2 := TBits.Create;
+    for I := 1 to NumTests do
+    begin
+      b1.Size := Random(MaxBits);
+      FillWithRandom(b1);
+      b2.CopyBits(b1);
+      if not b1.Equals(b2) then
+        Fail;
+      if not b2.Equals(b1) then
+        Fail;
+    end;
+  finally
+    b1.Free;
+    b2.Free;
+  end;
+end;
+
+begin
+  TestCopyBits;
+  Writeln('Ok!');
+end.