paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-05 23:47:52 +02:00
Code Issues Packages Projects Releases Wiki Activity

* handle rounding of currency values correctly, resolves #12207

Browse Source 
git-svn-id: trunk@14438 -
This commit is contained in:
florian 2009-12-13 16:19:56 +00:00
parent b29f033afb
commit d3cd6132f2
3 changed files with 35 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -9985,6 +9985,7 @@ tests/webtbs/tw12137.pp svneol=native#text/plain
tests/webtbs/tw12151.pp svneol=native#text/plain
tests/webtbs/tw12186.pp svneol=native#text/plain
tests/webtbs/tw12202.pp svneol=native#text/plain
tests/webtbs/tw12207.pp svneol=native#text/pascal
tests/webtbs/tw12214.pp svneol=native#text/plain
tests/webtbs/tw1222.pp svneol=native#text/plain
tests/webtbs/tw12224.pp svneol=native#text/plain

23
rtl/inc/sstrings.inc
View File

@ -500,12 +500,12 @@ procedure fpc_shortstr_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out
procedure fpc_shortstr_currency(c : currency; len,f : SizeInt; out s : shortstring);[public,alias:'FPC_SHORTSTR_CURRENCY']; compilerproc;
const
MinLen = 8; { Minimal string length in scientific format }
var
buf : array[1..19] of char;
i,j,k,reslen,tlen,sign,r,point : longint;
ic : qword;
begin
fillchar(buf,length(buf),'0');
{ default value for length is -32767 }
if len=-32767 then
len:=25;
@ -594,7 +594,26 @@ begin
break;
end;
If (k=1) and (buf[i-1]='0') then
buf[i]:=chr(Ord(buf[i])+1);
begin
{ 1.9996 rounded to two decimal digits after the decimal separator must result in
2.00, i.e. the rounding is propagated
}
while buf[i]='9' do
begin
buf[i]:='0';
inc(i);
end;
buf[i]:=chr(Ord(buf[i])+1);
{ did we add another digit? This happens when rounding
e.g. 99.9996 to two decimal digits after the decimal separator which should result in
100.00
}
if i>reslen then
begin
inc(reslen);
inc(tlen);
end;
end;
end;
{ preparing result string }
if reslen<len then

13
tests/webtbs/tw12207.pp Normal file
View File

@ -0,0 +1,13 @@
uses
sysutils;
var
s : string;
begin
str(currency(25.996):0:2,s);
if s<>'26.00' then
halt(1);
str(currency(99.996):0:2,s);
if s<>'100.00' then
halt(1);
writeln('ok');
end.