View Issue Details

IDProjectCategoryView StatusLast Update
0039261FPCPackagespublic2021-07-21 15:10
ReporterZdravko Gabrovski Assigned ToMichael Van Canneyt  
PrioritynormalSeverityminorReproducibilityalways
Status resolvedResolutionfixed 
PlatformallOSAll 
Product Version3.3.1 
Fixed in Version3.3.1 
Summary0039261: Unable to set value to FmtBCDField because of wrong Min/Max value check
DescriptionA simple TBufdataset component with one field "f1" with type "TFmtBCDField". Size=6, Precision=18.
Although MinValue=0 and MaxValue=0, when I try to add a new value '1' to the field with code

BufDataset1.FieldByName('F1').AsFloat:=1;

I received:

Field "f1" error: 1.00 is not between 0.00 and 0.00.

Press OK to ignore and risk data corruption.
Press Abort to kill the program.

The problem comes from method TFMTBCDField.CheckRange in fields.inc:

Function TFMTBCDField.CheckRange(AValue: TBCD) : Boolean;
begin
  If (FMinValue<>0) or (FMaxValue<>0) then <--------- This check failed
    Result:=(AValue>=FMinValue) and (AValue<=FMaxValue)
  else
    Result:=True;
end;

SomeHow TBCD FMinValue and FMaxValue are <> than '0'

if I modify like this:

Function TFMTBCDField.CheckRange(AValue: TBCD) : Boolean;
var Z : TBcd
begin
  Z := 0;
  If (FMinValue<>Z)) or (FMaxValue<>Z) then
    Result:=(AValue>=FMinValue) and (AValue<=FMaxValue)
  else
    Result:=True;
end;

It works fine.

Steps To Reproducejust open attached sample lazarus project and click MakeTest button.
TagsFmtBCD
Fixed in Revision49623
FPCOldBugId
FPCTarget4.0.0
Attached Files

Relationships

related to 0030853 resolvedMarco van de Voort VarToBcd for value 0 issue 

Activities

Zdravko Gabrovski

2021-07-19 13:32

reporter   ~0131938

Please find attached test project
1.7z (103,539 bytes)

Michael Van Canneyt

2021-07-19 13:43

administrator   ~0131939

This sounds like a compiler problem.

The MinValue and MaxValue properties are of type currency,
so a comparison with 0 must work without the need for conversion to some other type.

So this 'solution' should not be applied, the real problem must be fixed.

Zdravko Gabrovski

2021-07-19 16:49

reporter   ~0131941

Please, find attached simplest test program:
Just compile it.

program bcdtest;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}
  cthreads,
  {$ENDIF}
  Classes,
  FmtBCD
  { you can add units after this };
var B1 : TBCD;
    D : Double;
begin

B1 := 0;
D := 0;
if B1 <> D then
  writeln ('Failed!');
readln();

end.

Zdravko Gabrovski

2021-07-19 17:39

reporter   ~0131942

The same with currency type:

program bcdtest;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}
  cthreads,
  {$ENDIF}
  Classes,
  FmtBCD
  { you can add units after this };
var B1 : TBCD;
    C : Currency;
begin

B1 := 0;
C := 0;
if B1 <> C then
  writeln ('Failed!');
readln();

end.

LacaK

2021-07-20 06:21

developer   ~0131945

Last edited: 2021-07-20 06:53

View 5 revisions

I can not reproduce with FPC 3.2.0 + FmtBCD unit from TRUNK <--- correction: with TRUNK I can reproduce
(both double and also currency and also constant 0 works as expected in "if bcd<>...")

Btw. for TFmtBCDField.FMinValue and FMaxValue are of type TBCD.
So Function TFMTBCDField.CheckRange compares TBCD against constant 0 in:
  If (FMinValue<>0) or (FMaxValue<>0) then

Problem was introduced by my patch in rev. 48876 (ZeroBCD)
One BCD value has precision 1 and other has precision 0 so they are not binary equal.
But it should not cause problems. I must investigate it further ...

LacaK

2021-07-20 07:53

developer   ~0131947

Last edited: 2021-07-21 05:19

View 2 revisions

I see two ways:
1. either repace ZeroBCD with NullBCD in IntegerToBCD() (as it was before rev.48876)
(it seems that FmtBCD unit expects that BCD values are "fully" packed. And calling pack_BCD(with ZeroBCD) leads to NullBCD)
In that case there must be investigated root of problem in bug report 0030853 (but as far as VladimirK does not gave feedback it will be hard)
2. imporove BCDCompare() to correctly compare "same" BCD values with different internal representation ... (fully packed versus "unpacked" etc.) But it will consume some processing time and will make thing more complicated ...

LacaK

2021-07-20 11:26

developer   ~0131953

Patches for alternative 1 and 2 + test
fmtbcd.pp.1.diff (342 bytes)   
--- fmtbcd.pp.ori	Tue Jul 20 08:33:48 2021
+++ fmtbcd.pp	Tue Jul 20 11:47:17 2021
@@ -1591,7 +1591,7 @@
     begin
       _SELECT
         _WHEN aValue = 0
-          _THEN result := ZeroBCD;
+          _THEN result := NullBCD;
         _WHEN aValue = 1
           _THEN result := OneBCD;
         _WHEN aValue = low ( myInttype )
fmtbcd.pp.1.diff (342 bytes)   
fmtbcd.pp.2.diff (1,263 bytes)   
--- fmtbcd.pp.ori	Tue Jul 20 08:33:48 2021
+++ fmtbcd.pp	Tue Jul 20 13:23:47 2021
@@ -1278,6 +1278,25 @@
       neg1,
       neg2 : Boolean;
 
+      // real/reduced precision if there are on left side insignificant zero digits
+      function BCDPrec(const BCD: tBCD): word;
+      var scale: word;
+      begin
+        Result := BCD.Precision;
+        scale := BCDScale(BCD);
+        i := Low(BCD.Fraction);
+        while (Result>0) and (Result>scale) do begin
+          // high nibble
+          if BCD.Fraction[i] shr 4 <> 0 then Exit;
+          Dec(Result);
+          if Result <= scale then Exit;
+          // low nibble
+          if BCD.Fraction[i] <> 0 then Exit;
+          Dec(Result);
+          Inc(i);
+        end;
+      end;
+
     begin
 {$ifndef bigger_BCD}
       neg1 := ( BCD1.SignSpecialPlaces AND NegBit ) <> 0;
@@ -1292,8 +1311,8 @@
         _WHEN ( NOT neg1 ) AND neg2
           _THEN result := +1;
         _WHENOTHER
-          pr1 := BCD1.Precision;
-          pr2 := BCD2.Precision;
+          pr1 := BCDPrec(BCD1);
+          pr2 := BCDPrec(BCD2);
 {$ifndef bigger_BCD}
           pl1 := BCD1.SignSpecialPlaces AND PlacesMask;
           pl2 := BCD2.SignSpecialPlaces AND PlacesMask;
fmtbcd.pp.2.diff (1,263 bytes)   
tfmtbcd.pp.diff (445 bytes)   
--- tfmtbcd.pp.ori	Wed Feb 24 15:14:37 2021
+++ tfmtbcd.pp	Tue Jul 20 12:29:24 2021
@@ -302,6 +302,8 @@
   testBCDCompare(-100.1, 100.1, -1);
   testBCDCompare(-100.1, -100.2, 1);
   testBCDCompare(100, 100.1, -1);
+  testBCDCompare(DoubleToBcd(0), 0, 0);
+  testBCDCompare(CurrToBcd(0), 0, 0);
   testBCDCompare(CurrToBcd(0.01), CurrToBcd(0.001), 1); // BCD values with Precision<Scale
   testBCDCompare(CurrToBcd(0.01), 0.01, 0);
 
tfmtbcd.pp.diff (445 bytes)   

Zdravko Gabrovski

2021-07-20 20:37

reporter   ~0131963

I can confirm that patch 0000001 fixes the problem.
Tomorrow I will test also patch 0000002.

Zdravko Gabrovski

2021-07-21 14:52

reporter   ~0131979

The patch 02 also fix the problem.
I can not decide which of them to apply.

Michael Van Canneyt

2021-07-21 15:09

administrator   ~0131980

Applied patch 2, it seems to me this is the more correct one.

Issue History

Date Modified Username Field Change
2021-07-19 13:26 Zdravko Gabrovski New Issue
2021-07-19 13:32 Zdravko Gabrovski Note Added: 0131938
2021-07-19 13:32 Zdravko Gabrovski File Added: 1.7z
2021-07-19 13:43 Michael Van Canneyt Note Added: 0131939
2021-07-19 13:44 Michael Van Canneyt Category Database => Compiler
2021-07-19 13:44 Michael Van Canneyt FPCTarget => -
2021-07-19 16:49 Zdravko Gabrovski Note Added: 0131941
2021-07-19 17:39 Zdravko Gabrovski Note Added: 0131942
2021-07-20 06:21 LacaK Note Added: 0131945
2021-07-20 06:26 LacaK Note Edited: 0131945 View Revisions
2021-07-20 06:31 LacaK Note Edited: 0131945 View Revisions
2021-07-20 06:40 LacaK Note Edited: 0131945 View Revisions
2021-07-20 06:53 LacaK Note Edited: 0131945 View Revisions
2021-07-20 07:53 LacaK Note Added: 0131947
2021-07-20 11:26 LacaK Note Added: 0131953
2021-07-20 11:26 LacaK File Added: fmtbcd.pp.1.diff
2021-07-20 11:26 LacaK File Added: fmtbcd.pp.2.diff
2021-07-20 11:26 LacaK File Added: tfmtbcd.pp.diff
2021-07-20 11:28 LacaK Relationship added related to 0030853
2021-07-20 11:28 LacaK Tag Attached: FmtBCD
2021-07-20 20:37 Zdravko Gabrovski Note Added: 0131963
2021-07-21 05:19 LacaK Note Edited: 0131947 View Revisions
2021-07-21 14:52 Zdravko Gabrovski Note Added: 0131979
2021-07-21 15:09 Michael Van Canneyt Assigned To => Michael Van Canneyt
2021-07-21 15:09 Michael Van Canneyt Status new => resolved
2021-07-21 15:09 Michael Van Canneyt Resolution open => fixed
2021-07-21 15:09 Michael Van Canneyt Fixed in Version => 3.3.1
2021-07-21 15:09 Michael Van Canneyt Fixed in Revision => 49623
2021-07-21 15:09 Michael Van Canneyt FPCTarget - => 4.0.0
2021-07-21 15:09 Michael Van Canneyt Note Added: 0131980
2021-07-21 15:10 Michael Van Canneyt Category Compiler => Packages