mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-07 18:47:52 +02:00
21eeec9981
based on the Grisu1 algorithm. This corrects several precision issues
with the previous code used to perform such conversions (patch by
Max Nazhalov, mantis #25241)
o adaptation of several tests to deal with the better precision of these
routines compared to the previous version
Please don't remove the real2str.inc file yet, it's still used by the
JVM target for now
git-svn-id: trunk@25888 -
399 lines
5.3 KiB
ObjectPascal
399 lines
5.3 KiB
ObjectPascal
program tw7756;
|
|
|
|
{$mode objfpc}
|
|
|
|
uses Variants, SysUtils;
|
|
|
|
var
|
|
// s : string;
|
|
cp, cd, ci, ce, cg : integer; //iterators
|
|
fr : TFloatRec;
|
|
v : variant;
|
|
precs : array [1..3] of integer = (0, 15, 50);
|
|
decs : array [1..6] of integer =
|
|
(0, 5, 15, 25, 50, 60);
|
|
i : array [1..7] of integer = (-9057, -9194, -9059, 0, 9057, 9194, 9059);
|
|
e : array [1..11] of extended = (
|
|
-1.1E256, -5.5E256, -1.1E-256, -5.5E-256, -pi, 0.0, pi, 1.1E-256, 5.5E-256, 1.1E256, 5.5E256);
|
|
|
|
const results: array[1..324] of string =
|
|
('257-',
|
|
'258-1',
|
|
'-255-',
|
|
'-255-',
|
|
'1-',
|
|
'0+',
|
|
'1+',
|
|
'-255+',
|
|
'-255+',
|
|
'257+',
|
|
'258+1',
|
|
'257-',
|
|
'258-1',
|
|
'-255-',
|
|
'-255-',
|
|
'1-',
|
|
'0+',
|
|
'1+',
|
|
'-255+',
|
|
'-255+',
|
|
'257+',
|
|
'258+1',
|
|
'257-',
|
|
'258-1',
|
|
'-255-',
|
|
'-255-',
|
|
'1-',
|
|
'0+',
|
|
'1+',
|
|
'-255+',
|
|
'-255+',
|
|
'257+',
|
|
'258+1',
|
|
'257-',
|
|
'258-1',
|
|
'-255-',
|
|
'-255-',
|
|
'1-',
|
|
'0+',
|
|
'1+',
|
|
'-255+',
|
|
'-255+',
|
|
'257+',
|
|
'258+1',
|
|
'257-',
|
|
'258-1',
|
|
'-255-',
|
|
'-255-',
|
|
'1-',
|
|
'0+',
|
|
'1+',
|
|
'-255+',
|
|
'-255+',
|
|
'257+',
|
|
'258+1',
|
|
'257-',
|
|
'258-1',
|
|
'-255-',
|
|
'-255-',
|
|
'1-',
|
|
'0+',
|
|
'1+',
|
|
'-255+',
|
|
'-255+',
|
|
'257+',
|
|
'258+1',
|
|
'257-11',
|
|
'257-55',
|
|
'-255-',
|
|
'-255-',
|
|
'1-3',
|
|
'0+',
|
|
'1+3',
|
|
'-255+',
|
|
'-255+',
|
|
'257+11',
|
|
'257+55',
|
|
'257-11',
|
|
'257-55',
|
|
'-255-',
|
|
'-255-',
|
|
'1-314159',
|
|
'0+',
|
|
'1+314159',
|
|
'-255+',
|
|
'-255+',
|
|
'257+11',
|
|
'257+55',
|
|
'257-11',
|
|
'257-55',
|
|
'-255-',
|
|
'-255-',
|
|
'1-314159265358979',
|
|
'0+',
|
|
'1+314159265358979',
|
|
'-255+',
|
|
'-255+',
|
|
'257+11',
|
|
'257+55',
|
|
'257-11',
|
|
'257-55',
|
|
'-255-',
|
|
'-255-',
|
|
'1-314159265358979',
|
|
'0+',
|
|
'1+314159265358979',
|
|
'-255+',
|
|
'-255+',
|
|
'257+11',
|
|
'257+55',
|
|
'257-11',
|
|
'257-55',
|
|
'-255-',
|
|
'-255-',
|
|
'1-314159265358979',
|
|
'0+',
|
|
'1+314159265358979',
|
|
'-255+',
|
|
'-255+',
|
|
'257+11',
|
|
'257+55',
|
|
'257-11',
|
|
'257-55',
|
|
'-255-',
|
|
'-255-',
|
|
'1-314159265358979',
|
|
'0+',
|
|
'1+314159265358979',
|
|
'-255+',
|
|
'-255+',
|
|
'257+11',
|
|
'257+55',
|
|
'257-11',
|
|
'257-54999999999999998',
|
|
'-255-',
|
|
'-255-',
|
|
'1-3',
|
|
'0+',
|
|
'1+3',
|
|
'-255+',
|
|
'-255+',
|
|
'257+11',
|
|
'257+54999999999999998',
|
|
'257-11',
|
|
'257-54999999999999998',
|
|
'-255-',
|
|
'-255-',
|
|
'1-314159',
|
|
'0+',
|
|
'1+314159',
|
|
'-255+',
|
|
'-255+',
|
|
'257+11',
|
|
'257+54999999999999998',
|
|
'257-11',
|
|
'257-54999999999999998',
|
|
'-255-',
|
|
'-255-',
|
|
'1-3141592653589793',
|
|
'0+',
|
|
'1+3141592653589793',
|
|
'-255+',
|
|
'-255+',
|
|
'257+11',
|
|
'257+54999999999999998',
|
|
'257-11',
|
|
'257-54999999999999998',
|
|
'-255-',
|
|
'-255-',
|
|
'1-31415926535897931',
|
|
'0+',
|
|
'1+31415926535897931',
|
|
'-255+',
|
|
'-255+',
|
|
'257+11',
|
|
'257+54999999999999998',
|
|
'257-11',
|
|
'257-54999999999999998',
|
|
'-255-',
|
|
'-255-',
|
|
'1-31415926535897931',
|
|
'0+',
|
|
'1+31415926535897931',
|
|
'-255+',
|
|
'-255+',
|
|
'257+11',
|
|
'257+54999999999999998',
|
|
'257-11',
|
|
'257-54999999999999998',
|
|
'-255-',
|
|
'-255-',
|
|
'1-31415926535897931',
|
|
'0+',
|
|
'1+31415926535897931',
|
|
'-255+',
|
|
'-255+',
|
|
'257+11',
|
|
'257+54999999999999998',
|
|
'5-1',
|
|
'5-1',
|
|
'5-1',
|
|
'0+',
|
|
'5+1',
|
|
'5+1',
|
|
'5+1',
|
|
'5-1',
|
|
'5-1',
|
|
'5-1',
|
|
'0+',
|
|
'5+1',
|
|
'5+1',
|
|
'5+1',
|
|
'5-1',
|
|
'5-1',
|
|
'5-1',
|
|
'0+',
|
|
'5+1',
|
|
'5+1',
|
|
'5+1',
|
|
'5-1',
|
|
'5-1',
|
|
'5-1',
|
|
'0+',
|
|
'5+1',
|
|
'5+1',
|
|
'5+1',
|
|
'5-1',
|
|
'5-1',
|
|
'5-1',
|
|
'0+',
|
|
'5+1',
|
|
'5+1',
|
|
'5+1',
|
|
'5-1',
|
|
'5-1',
|
|
'5-1',
|
|
'0+',
|
|
'5+1',
|
|
'5+1',
|
|
'5+1',
|
|
'4-9057',
|
|
'4-9194',
|
|
'4-9059',
|
|
'0+',
|
|
'4+9057',
|
|
'4+9194',
|
|
'4+9059',
|
|
'4-9057',
|
|
'4-9194',
|
|
'4-9059',
|
|
'0+',
|
|
'4+9057',
|
|
'4+9194',
|
|
'4+9059',
|
|
'4-9057',
|
|
'4-9194',
|
|
'4-9059',
|
|
'0+',
|
|
'4+9057',
|
|
'4+9194',
|
|
'4+9059',
|
|
'4-9057',
|
|
'4-9194',
|
|
'4-9059',
|
|
'0+',
|
|
'4+9057',
|
|
'4+9194',
|
|
'4+9059',
|
|
'4-9057',
|
|
'4-9194',
|
|
'4-9059',
|
|
'0+',
|
|
'4+9057',
|
|
'4+9194',
|
|
'4+9059',
|
|
'4-9057',
|
|
'4-9194',
|
|
'4-9059',
|
|
'0+',
|
|
'4+9057',
|
|
'4+9194',
|
|
'4+9059',
|
|
'4-9057',
|
|
'4-9194',
|
|
'4-9059',
|
|
'0+',
|
|
'4+9057',
|
|
'4+9194',
|
|
'4+9059',
|
|
'4-9057',
|
|
'4-9194',
|
|
'4-9059',
|
|
'0+',
|
|
'4+9057',
|
|
'4+9194',
|
|
'4+9059',
|
|
'4-9057',
|
|
'4-9194',
|
|
'4-9059',
|
|
'0+',
|
|
'4+9057',
|
|
'4+9194',
|
|
'4+9059',
|
|
'4-9057',
|
|
'4-9194',
|
|
'4-9059',
|
|
'0+',
|
|
'4+9057',
|
|
'4+9194',
|
|
'4+9059',
|
|
'4-9057',
|
|
'4-9194',
|
|
'4-9059',
|
|
'0+',
|
|
'4+9057',
|
|
'4+9194',
|
|
'4+9059',
|
|
'4-9057',
|
|
'4-9194',
|
|
'4-9059',
|
|
'0+',
|
|
'4+9057',
|
|
'4+9194',
|
|
'4+9059');
|
|
|
|
function DecimalToStr(fr: TFloatRec): string;
|
|
var
|
|
s : string;
|
|
begin
|
|
s := IntToStr(fr.Exponent);
|
|
if fr.Negative
|
|
then s := s+ '-'
|
|
else s := s+ '+';
|
|
s := s + StrPas(@fr.Digits[0]);
|
|
Result := s;
|
|
end;
|
|
|
|
var
|
|
s: ansistring;
|
|
BEGIN
|
|
cg := 1; // grid row index
|
|
for cp := Low(Precs) to High(Precs) do //itarete through precisions
|
|
for cd := Low(decs) to High(decs) do //itarete through decimals
|
|
for ce := Low(e) to High(e) do //itarete through extended values
|
|
begin
|
|
// write(IntToStr(precs[cp]):2,';',IntToStr(decs[cd]):2,';');
|
|
// str(e[ce]:250, s); s := Trim(s);
|
|
v := e[ce];
|
|
// write(s:25, ';');
|
|
FloatToDecimal(fr, v, precs[cp], decs[cd]);
|
|
// write(DecimalToStr(fr):25, ';');
|
|
// writeln(DecimalToStr(fr));
|
|
if DecimalToStr(fr) <> results[cg] then
|
|
begin
|
|
writeln(' -- expected ',results[cg]);
|
|
writeln(cg);
|
|
halt(1);
|
|
end;
|
|
inc(cg);
|
|
end;
|
|
// integers
|
|
for cp := Low(Precs) to High(Precs) do //itarete through precisions
|
|
for cd := Low(decs) to High(decs) do //itarete through decimals
|
|
for ci := Low(i) to High(i) do //itarete through integers
|
|
begin
|
|
// write(IntToStr(precs[cp]):2, ';', IntToStr(decs[cd]):2, ';');
|
|
// s := IntToStr(i[ci]);
|
|
v := i[ci];
|
|
// write(s:25, ';');
|
|
FloatToDecimal(fr, v, precs[cp], decs[cd]);
|
|
// write(DecimalToStr(fr):25, ';');
|
|
// writeln(DecimalToStr(fr));
|
|
if DecimalToStr(fr) <> results[cg] then
|
|
halt(2);
|
|
inc(cg);
|
|
end;
|
|
END.
|
|
|
|
|