From 1294ea43574c20aeec033d58856956f8ddfd802d Mon Sep 17 00:00:00 2001
From: florian <florian@freepascal.org>
Date: Sat, 19 May 2012 14:54:46 +0000
Subject: [PATCH] * patches by Max Nazhalov to solve some issues with currency
 formatting, resolves #18704 and #22063

git-svn-id: trunk@21339 -
---
 .gitattributes          |  1 +
 rtl/inc/sstrings.inc    | 34 ++++++++---------
 tests/webtbs/tw18704.pp | 81 +++++++++++++++++++++++++++++++++++++++++
 3 files changed, 97 insertions(+), 19 deletions(-)
 create mode 100644 tests/webtbs/tw18704.pp

diff --git a/.gitattributes b/.gitattributes
index 65981ef5ae..47ce3e0f5f 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -12447,6 +12447,7 @@ tests/webtbs/tw1863.pp svneol=native#text/plain
 tests/webtbs/tw1867.pp svneol=native#text/plain
 tests/webtbs/tw18690.pp svneol=native#text/plain
 tests/webtbs/tw18702.pp svneol=native#text/pascal
+tests/webtbs/tw18704.pp svneol=native#text/pascal
 tests/webtbs/tw18706.pp svneol=native#text/plain
 tests/webtbs/tw1873.pp svneol=native#text/plain
 tests/webtbs/tw18767a.pp svneol=native#text/pascal
diff --git a/rtl/inc/sstrings.inc b/rtl/inc/sstrings.inc
index daeb6f698e..5960492078 100644
--- a/rtl/inc/sstrings.inc
+++ b/rtl/inc/sstrings.inc
@@ -688,24 +688,20 @@ begin
   { rounding string if r > 0 }
   if r > 0 then
     begin
-      i:=1;
-      k:=0;
-      for j:=0 to r do
-        begin
-          if (k=1) and (buf[i]='9') then
-            buf[i]:='0'
-          else
-            begin
-            buf[i]:=chr(ord(buf[i]) + k);
-            if buf[i] >= '5' then
-              k:=1
-            else
-              k:=0;
-            end;
-          Inc(i);
-          if i>tlen  then
-            break;
-        end;
+      k := 0;
+      i := r+2;
+      if i > tlen then
+         i := tlen+1;
+      if buf[i-2] >= '5' then
+         begin
+           if buf[i-1] < '9' then
+             buf[i-1] := chr(ord(buf[i-1])+1)
+           else
+             begin
+               buf[i-1] := '0';
+               k := 1;
+             end;
+         end;
       If (k=1) and (buf[i-1]='0') then
 	    begin
 		  { 1.9996 rounded to two decimal digits after the decimal separator must result in
@@ -721,7 +717,7 @@ begin
 		    e.g. 99.9996 to two decimal digits after the decimal separator which should result in
 			100.00
 		  }
-		  if i>reslen then
+		  if i>tlen then
 		    begin
 			  inc(reslen);
 			  inc(tlen);
diff --git a/tests/webtbs/tw18704.pp b/tests/webtbs/tw18704.pp
new file mode 100644
index 0000000000..48ecdff3dc
--- /dev/null
+++ b/tests/webtbs/tw18704.pp
@@ -0,0 +1,81 @@
+{$APPTYPE CONSOLE}
+program CurrencyFormatTest;
+
+(*
+   Test subject: .\rtl\inc\sstrings.inc::fpc_shortstr_currency
+   Test FPC having problems: r21245, win32-i386
+ *)
+
+type  
+  TTestCase = record
+    value  : currency;
+    expect : array [0..5] of string;
+  end;
+
+const
+  test_cases : array [0..19] of TTestCase = (
+   ( value : 0.9500;   expect : ('0.95000','0.9500','0.950','0.95','1.0','1')),
+   ( value :-0.9500;   expect : ('-0.95000','-0.9500','-0.950','-0.95','-1.0','-1')),
+   ( value : 1.4445;   expect : ('1.44450','1.4445','1.445','1.44','1.4','1')),
+   ( value :-1.4445;   expect : ('-1.44450','-1.4445','-1.445','-1.44','-1.4','-1')),
+   ( value : 199.4445; expect : ('199.44450','199.4445','199.445','199.44','199.4','199')),
+   ( value :-199.4445; expect : ('-199.44450','-199.4445','-199.445','-199.44','-199.4','-199')),
+   ( value : 1.9995;   expect : ('1.99950','1.9995','2.000','2.00','2.0','2')),
+   ( value :-1.9995;   expect : ('-1.99950','-1.9995','-2.000','-2.00','-2.0','-2')),
+   ( value : 99.9996;  expect : ('99.99960','99.9996','100.000','100.00','100.0','100')),
+   ( value :-99.9996;  expect : ('-99.99960','-99.9996','-100.000','-100.00','-100.0','-100')),
+   ( value : 0.9005;   expect : ('0.90050','0.9005','0.901','0.90','0.9','1')),
+   ( value :-0.9005;   expect : ('-0.90050','-0.9005','-0.901','-0.90','-0.9','-1')),
+   ( value : 0.0005;   expect : ('0.00050','0.0005','0.001','0.00','0.0','0')),
+   ( value :-0.0005;   expect : ('-0.00050','-0.0005','-0.001','-0.00','-0.0','-0')), // NOTE!: at least Delphi 5/7 leaves '-' sign for zero!
+   ( value : 0.0145;   expect : ('0.01450','0.0145','0.015','0.01','0.0','0')),
+   ( value :-0.0145;   expect : ('-0.01450','-0.0145','-0.015','-0.01','-0.0','-0')), // NOTE!: at least Delphi 5/7 leaves '-' sign for zero!
+   ( value : 99.9997;  expect : ('99.99970','99.9997','100.000','100.00','100.0','100')),
+   ( value :-99.9997;  expect : ('-99.99970','-99.9997','-100.000','-100.00','-100.0','-100')),
+   ( value : 999.9996; expect : ('999.99960','999.9996','1000.000','1000.00','1000.0','1000')),
+   ( value :-999.9996; expect : ('-999.99960','-999.9996','-1000.000','-1000.00','-1000.0','-1000'))
+  );
+
+function test_it(const test_case:TTestCase) : boolean;
+var 
+  expect,
+  s : string;
+  i : integer;
+  c : char;
+  ok : boolean;
+begin
+  ok := true;
+  writeln('Using Str for ',test_case.value);
+  for i := high(test_case.expect) downto low(test_case.expect) do
+    begin
+      expect:=test_case.expect[high(test_case.expect)-i];
+      str(test_case.value:0:i,s);
+      if s=expect then
+       c := ' '
+      else
+        begin
+         c := '?';
+         ok := false;
+        end;
+      writeln(c,' frac=',i,', expected=',expect,', got=',s);
+    end;
+  writeln;
+  test_it := ok;
+end;
+
+var
+  i : integer;
+  ok : boolean;
+
+begin
+  writeln;
+  ok := true;
+  for i := low(test_cases) to high(test_cases) do
+    if not test_it(test_cases[i]) then
+      ok := false;
+  if not ok then
+    begin
+      writeln('Verdict: failed!');
+      halt(1);
+    end;
+end.