[FPC] Bug in non-Extended floating types

[Robert Kosek]

System: Windows XP, Athalon X2 4800+, nVidia 8600GTS 256MB
Compiler/IDE: FPC 2.2.0
API: N/A (SysUtils/System?)

I've been using text files to represent data and read it in through the parser interface, but I've encountered a possible bug that is driving me nutty. Any float value converted from a string is completely bogus. For instance, take my logfile for an example, as I logged the value to convert and its conversion result.

BEGIN LOG -- 10/26/2007 9:12:31
Float encountered.  S = 0.9; V = 0.8999999762;
Float encountered.  S = 0.8; V = 0.8000000119;
END LOG -- 10/26/2007 9:12:35

I know those round to the values I want, it is a float to single assignment if that does anything, but the deviation makes me wonder. I'm using StrToFloat so if there's any problem with StrToFloat then it will affect any user of FreePascal 2.2.0 ... and yet I've seen no such bug reports.

Any ideas on what might've gone wrong on my system?

parser.exe (my experiment)
[pascal]program parser;

uses SysUtils, Classes, gDebug;

var AParser: TParser;
FS: TFileStream;

type
TArmorFlag = (afImpactResist, afSlashResist, afElecVuln);
TArmorFlags = set of TArmorFlag;
TBodyPart = (bpTorso, bpHead);

const
BodyParts: array[TBodyPart ] of string = ('torso','head');
ArmorFlags: array[TArmorFlag] of string = ('impact_resist','slash_resist','elec_vuln');

type
PArmor = ^TArmor;
TArmor = record
// NAME:
single, plural: string;
// DESC:
desc: string;
// VALUE, WEIGHT (OZ):
value, weight: word;
// MITIGATION (REDUCTION):
mitigation: single;
// BODYPART:
part: TBodyPart;
// FLAGS:
flags: TArmorFlags;
end;

var
Armory: array of TArmor;
Pos: Integer = -1;

Tok: Char;
tempS: string;
i: integer;

iP: TBodyPart;
aF: TArmorFlag;

BEGIN
writeln;
writeln('GameLib TParser Experiment');
FS := TFileStream.Create('armor.txt', fmOpenRead);
AParser := TParser.Create(FS);

writeln;
write('Generating objects.');

Tok := AParser.Token;
while Tok <> toEOF do begin
write('.');
tempS := AParser.TokenString;
if tempS = 'armor' then begin
Pos += 1;
SetLength(Armory, Pos+1);
end else if tempS = 'name' then begin
Tok := AParser.NextToken;
if Tok = toString then begin
Armory[Pos].single := AParser.TokenString;
end else
AParser.CheckToken(toString);
end else if tempS = 'plural' then begin
Tok := AParser.NextToken;
if Tok = toString then begin
Armory[Pos].plural := AParser.TokenString;
end else
AParser.CheckToken(toString);
end else if tempS = 'desc' then begin
Tok := AParser.NextToken;
if Tok = toString then begin
Armory[Pos].desc := AParser.TokenString;
end else
AParser.CheckToken(toString);
end else if tempS = 'value' then begin
Tok := AParser.NextToken;
if Tok = toInteger then begin
Armory[Pos].value := AParser.TokenInt;
end else
AParser.CheckToken(toInteger);
end else if tempS = 'weight' then begin
Tok := AParser.NextToken;
if Tok = toInteger then begin
Armory[Pos].weight := AParser.TokenInt;
end else
AParser.CheckToken(toInteger);
end else if tempS = 'mitigation' then begin
Tok := AParser.NextToken;
if Tok = toFloat then begin
Armory[Pos].mitigation := StrToFloat(AParser.TokenString);
Log('Float encountered. S = '+AParser.TokenString+'; V = '+FloatToStr(Armory[Pos].mitigation)+';');
end else
AParser.CheckToken(toFloat);
end else if tempS = 'bodypart' then begin
Tok := AParser.NextToken;
if Tok = toSymbol then begin
tempS := AParser.TokenString;
for iP := low(TBodyPart) to high(TBodyPart) do
if tempS = BodyParts[iP] then begin
Armory[Pos].part := iP;
break;
end;
end else
AParser.CheckToken(toSymbol);
end else if tempS = 'flags' then begin
Tok := AParser.NextToken;
while Tok = toSymbol do begin
tempS := AParser.TokenString;
if tempS = 'done' then break;
for aF := low(TArmorFlag) to high(TArmorFlag) do
if ArmorFlags[aF] = tempS then
include(Armory[pos].flags, aF);
Tok := AParser.NextToken;
end;
end else
AParser.Error('Unrecognized object/token: '+tempS);
Tok := AParser.NextToken;
end;
writeln(' Completed.');

for i := low(Armory) to high(Armory) do begin
writeln('Armor #',i+1,' {');
writeln('Singular: ', Armory[i].single);
writeln('Plural: ', Armory[i].plural);
writeln('Description: ', Armory[i].desc);
writeln('Value: $', Armory[i].value);
writeln('Weight: ', Armory[i].weight);
writeln('Mitigation: ', FloatToStr(Armory[i].mitigation));
writeln('Bodypart: ', BodyParts[Armory[i].part]);
write ('Flags: ');
for aF := low(TArmorFlag) to high(TArmorFlag) do
if aF in Armory[Pos].flags then
write(ArmorFlags[aF],' ');
writeln;
writeln('}');
writeln;
end;

readln;
AParser.Free;
FS.Free;
END.[/pascal]
armor.txt (the datafile)

armor
name		'bronzium plate'
plural		'bronzium plating'
desc		'The key behind bronzium is the polymer chain, of bronze itself, that transforms ordinary bronze into a lattice-like structure that is exponentially tougher.  This change is costly and takes great skill, but produces the greatest of armors able to resist even the finest steel.'
value		25000
weight		208
mitigation	0.9
bodypart	torso
flags		impact_resist slash_resist elec_vuln
done

armor
name		'bronzium helmet'
plural		'bronzium helmets'
desc		'The key behind bronzium is the polymer chain, of bronze itself, that transforms ordinary bronze into a lattice-like structure that is exponentially tougher.  This change is costly and takes great skill, but produces the greatest of armors able to resist even the finest steel.'
value		17500
weight		80
mitigation	0.8
bodypart	head
flags		slash_resist elec_vuln
done

[Robert Kosek]

I wrote myself a custom StrToSingle function using Val, the same thing used for the StrToFloat conversions, and got the exact same result. Honestly I really don't understand how this is happening. As both functions use Val this implicates FPC as having a potentially bad bug, especially where accuracy is required in these routines.

I hope that somewhere it's my fault; that's so much simpler to fix! :?

function StrToSingle(S: String): Single;
var e: Integer;
    f: Single;
begin
  Val(s,f,e);
  if e > 0 then
    LogCritical('Error in StrToSingle!  STR = "'+S+'" Error at char #'+IntToStr(E))
  else
    StrToSingle := f;
end;

[Robert Kosek]

This is bizarre. I branched into a separate project and created my own function to convert a string into a float without the Val code. And lo and behold, both functions worked! I then glanced and realized that I used an Extended variable here, and not a Single size variable.

I expanded my test to cover the four floating point types I'm familiar with. Real, Extended, Single, and Double. The results are far less than satisfactory, and now I'm certain there's a bug somewhere in floating-point types that aren't Extended. See it, compile it, and try it for yourself. Even floating point comparisons and expansions appear flawed right now.

My results:

Float Debugger

Value = 0.9
Custom converter results: true
Default converter results:
  Single   -> false(0.8999999762)
  Double   -> false(0.9)
  Real     -> false(0.9)
  Extended -> true (0.9)

program floattest;

uses SysUtils, StrUtils, Math;

procedure CutStr(const s, delim: string; var s1,s2: string);
var i: integer;
    flag: boolean;
begin
  if length(s) = 0 then
    exit;

  i := 1;
  flag := false;
  s1 := '';
  s2 := '';
  while i <= length&#40;s&#41; do begin
    if s&#91;i&#93; = '.' then begin
      flag &#58;= true;
      i += 1;
    end;
    if flag then
      s2 &#58;= s2+s&#91;i&#93;
    else
      s1 &#58;= s1+s&#91;i&#93;;
    i += 1;
  end;
end;

function CustStrToFloat&#40;S&#58; String&#41;&#58; Extended;
var middle&#58; integer;
    whole,part&#58; string;
begin
  middle &#58;= Pos&#40;'.',S&#41;;
  if middle <= 0 then
    Exit&#40;StrToInt&#40;S&#41;&#41;
  else begin
    CutStr&#40;s,'.',whole,part&#41;;
    exit&#40;StrToInt&#40;whole&#41; + StrToInt&#40;part&#41;/power&#40;10,Length&#40;part&#41;&#41;&#41;;
  end;
end;

var
  f1&#58; single;
  f2&#58; double;
  f3&#58; real;
  f4&#58; extended;

BEGIN
  writeln&#40;'Float Debugger'&#41;;
  writeln;
  writeln&#40;'Value = 0.9'&#41;;
  write&#40;'Custom converter results&#58; '&#41;;
  if CustStrToFloat&#40;'0.9'&#41; = 0.9 then
    writeln&#40;'true'&#41;
  else
    writeln&#40;'false'&#41;;
  writeln&#40;'Default converter results&#58;'&#41;;
  f1 &#58;= StrToFloat&#40;'0.9'&#41;;
  f2 &#58;= StrToFloat&#40;'0.9'&#41;;
  f3 &#58;= StrToFloat&#40;'0.9'&#41;;
  f4 &#58;= StrToFloat&#40;'0.9'&#41;;
  write&#40;'  Single   ->'&#41;;
  if f1 = 0.9 then
    writeln&#40;' true &#40;',FloatToStr&#40;f1&#41;,'&#41;'&#41;
  else
    writeln&#40;' false&#40;',FloatToStr&#40;f1&#41;,'&#41;'&#41;;
  write&#40;'  Double   ->'&#41;;
  if f2 = 0.9 then
    writeln&#40;' true &#40;',FloatToStr&#40;f2&#41;,'&#41;'&#41;
  else
    writeln&#40;' false&#40;',FloatToStr&#40;f2&#41;,'&#41;'&#41;;
  write&#40;'  Real     ->'&#41;;
  if f3 = 0.9 then
    writeln&#40;' true &#40;',FloatToStr&#40;f3&#41;,'&#41;'&#41;
  else
    writeln&#40;' false&#40;',FloatToStr&#40;f3&#41;,'&#41;'&#41;;
  write&#40;'  Extended ->'&#41;;
  if f4 = 0.9 then
    writeln&#40;' true &#40;',FloatToStr&#40;f4&#41;,'&#41;'&#41;
  else
    writeln&#40;' false&#40;',FloatToStr&#40;f4&#41;,'&#41;'&#41;;
  readln;
END.

[Robert Kosek]

Submitted to FPC Bugtracker as issue 10024.

Anyone who can reproduce this problem with FPC 2.2.0, the current public build, please post here and confirm this. Or, if you have a FPC bugtracker account, you can post confirmation over at FPC's bugtracker. Please help track this bug down and kill it!

[Mirage]

Robert, did you test this in Delphi? I think Delphi has the same "bug".
Some numbers cannot be represented in floating-point form precisely. So some approximation used.

[Robert Kosek]

Yes, someone else did actually.

The problem is improper conversion of numbers. Just force a typecast of any constant numbers into the type they're being compared to--this includes casual constants that aren't named. As soon as you do this the problem vanishes faster than a goblin in a lava pit.