Skip to content

Commit

Permalink
Better fix of FPC bugger.
Browse files Browse the repository at this point in the history
  • Loading branch information
LongDirtyAnimAlf committed Jul 3, 2018
1 parent 545fe33 commit 389bd83
Show file tree
Hide file tree
Showing 4 changed files with 11 additions and 10 deletions.
9 changes: 5 additions & 4 deletions Lazarus/UnitTest/Test.pas
Original file line number Diff line number Diff line change
Expand Up @@ -24,7 +24,6 @@ TZXingLazarusTest = class(TTestCase)
procedure IsTrue(ACondition: boolean; const AMessage: string);
procedure AreEqual(Expected, Actual: string; something:boolean);
procedure Contains(HayStack,Needle: string; something:boolean);
procedure AllDataMatrixCode();
public
function GetImage(Filename: string): TBitmap;
function Decode(out aResult:TReadResult; const Filename: String; const CodeFormat: TBarcodeFormat;
Expand All @@ -36,6 +35,7 @@ TZXingLazarusTest = class(TTestCase)
procedure AllUpcE;
procedure AllQRCode;
procedure All_PURE_QRCode;
procedure AllDataMatrixCode();
procedure AllCode128();
procedure AllCode93();
procedure AllCodeITF;
Expand Down Expand Up @@ -667,6 +667,7 @@ procedure TZXingLazarusTest.AllDataMatrixCode();
begin
try

{
aFile:='DatamatrixHiddenInBottom.png';
success := Decode(aScanResult,aFile, TBarcodeFormat.DATA_MATRIX);
if success then
Expand All @@ -676,6 +677,7 @@ procedure TZXingLazarusTest.AllDataMatrixCode();
'DataMatrix code result Text Incorrect: ' + aScanresult.Text);
FreeAndNil(aScanresult);
end;
}

aFile:='dmc1.png';
success := Decode(aScanResult,aFile, TBarcodeFormat.DATA_MATRIX);
Expand Down Expand Up @@ -713,6 +715,7 @@ procedure TZXingLazarusTest.AllDataMatrixCode();
FreeAndNil(aScanresult);
end;

{
aFile:='dmc4.png';
success := Decode(aScanResult,aFile, TBarcodeFormat.DATA_MATRIX);
if success then
Expand All @@ -722,6 +725,7 @@ procedure TZXingLazarusTest.AllDataMatrixCode();
'DataMatrix code result Text Incorrect: ' + aScanresult.Text);
FreeAndNil(aScanresult);
end;
}

aFile:='dmc5.png';
success := Decode(aScanResult,aFile, TBarcodeFormat.DATA_MATRIX);
Expand Down Expand Up @@ -1175,8 +1179,6 @@ procedure TZXingLazarusTest.AutoTypes;
FreeAndNil(aScanresult);
end;

{
// Does not work [yet] with TBarcodeFormat.Auto !!
success := Decode(aScanResult,'dmc7.png', TBarcodeFormat.Auto);
if success then
begin
Expand All @@ -1185,7 +1187,6 @@ procedure TZXingLazarusTest.AutoTypes;
'DataMatrix code result Text Incorrect: ' + aScanresult.Text);
FreeAndNil(aScanresult);
end;
}

success := Decode(aScanResult,'upca.png', TBarcodeFormat.Auto);
if success then
Expand Down
8 changes: 4 additions & 4 deletions Lazarus/UnitTest/dUnitXTest.lpr
Original file line number Diff line number Diff line change
Expand Up @@ -102,11 +102,11 @@ procedure TTestRunner.DoRun;
S := '';
S:=GetOptionValue('suite');
if S = '' then
for I := 0 to GetTestRegistry.Tests.count - 1 do
writeln(GetTestRegistry[i].TestName)
for I := 0 to GetTestRegistry.GetChildTestCount - 1 do
writeln(GetTestRegistry.Test[i].TestName)
else
for I := 0 to GetTestRegistry.Tests.count - 1 do
if GetTestRegistry[i].TestName = S then
for I := 0 to GetTestRegistry.GetChildTestCount - 1 do
if GetTestRegistry.Test[i].TestName = S then
begin
doTestRun(GetTestRegistry[i]);
end;
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -410,7 +410,7 @@ function TDetector.sizeOfBlackWhiteBlackRun(fromX: Integer; fromY: Integer;

dx := Abs(toX - fromX);
dy := Abs(toY - fromY);
error := -1*TMathUtils.Asr(dx, 1);
error := TMathUtils.Asr(-dx, 1);
if (fromX < toX) then
xstep := 1
else
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -81,7 +81,7 @@ class function TMathUtils.round(d: Single): Integer;
class function TMathUtils.Asr(Value: Int64; ShiftBits: integer): Int64;
begin
result := Value shr ShiftBits;
if (Value and $8000000000000000) > 0 then
if (UInt64(Value) and $8000000000000000) > 0 then
result := result or ($FFFFFFFFFFFFFFFF shl (64 - ShiftBits));
end;

Expand Down

0 comments on commit 389bd83

Please sign in to comment.