[fpc-devel] Re: TBits problem
Andrea Mauri
andrea.mauri.75 at gmail.com
Wed Nov 6 15:04:47 CET 2013
>
>
> If you send a minimal test-case and actual results you might have a
> better chance at getting a reply...
Below a sample test project.
I create a TBits (b1) and then I set 16 bits as 1. Then I create 2 TBits
(b2 and b3) with size 164, I use .OrBits to OR b1 with b2 and b3. I
expect that b2 and b3 will result in a TBits with size 164 but with only
first 16 bits as 1. What I got is different. A lot of bits between
bits[16] and bits[163] are set to 1.
You can easily check it using the following test project.
Tested on windows fpc 2.6.2.
program Project1;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Classes, SysUtils, CustApp
{ you can add units after this };
type
{ TMyApplication }
TMyApplication = class(TCustomApplication)
protected
procedure DoRun; override;
public
constructor Create(TheOwner: TComponent); override;
destructor Destroy; override;
procedure WriteHelp; virtual;
function bitstostring(b: TBits): string;
end;
{ TMyApplication }
procedure TMyApplication.DoRun;
var
ErrorMsg: String;
i, bsize1, bsize2: integer;
b1, b2, b3: TBits;
s1, s2, s3: string;
begin
// quick check parameters
ErrorMsg:=CheckOptions('h','help');
if ErrorMsg<>'' then begin
ShowException(Exception.Create(ErrorMsg));
Terminate;
Exit;
end;
// parse parameters
if HasOption('h','help') then begin
WriteHelp;
Terminate;
Exit;
end;
{ add your program here }
bsize1:= 16;
bsize2:= 164;
b1:= TBits.Create;
b2:= TBits.Create(bsize2);
b3:= TBits.Create(bsize2);
for i:= 0 to bsize1 - 1 do
b1[i]:= True;
b2.OrBits(b1);
b3.OrBits(b1);
for i:= b1.Size to bsize2 - 1 do
b3[i]:= False;
if not b2.Equals(b3) then
begin
writeln(bitstostring(b1));
writeln(bitstostring(b2));
writeln(bitstostring(b3));
end;
b1.Free;
b2.Free;
b3.Free;
// stop program loop
Terminate;
end;
constructor TMyApplication.Create(TheOwner: TComponent);
begin
inherited Create(TheOwner);
StopOnException:=True;
end;
destructor TMyApplication.Destroy;
begin
inherited Destroy;
end;
procedure TMyApplication.WriteHelp;
begin
{ add your help code here }
writeln('Usage: ',ExeName,' -h');
end;
function TMyApplication.bitstostring(b: TBits): string;
var
i: integer;
bs: string;
begin
bs:= '';
for i:= 0 to b.Size - 1 do
if b[i] then
bs:= bs + '1'
else
bs:= bs + '0';
Result:= bs;
end;
var
Application: TMyApplication;
begin
Application:=TMyApplication.Create(nil);
Application.Title:='My Application';
Application.Run;
Application.Free;
end.
More information about the fpc-devel
mailing list