From 2d683bcbe6c2f6edcfda6747ffe88118658cb6cf Mon Sep 17 00:00:00 2001
From: yury <jura@cp-lab.com>
Date: Mon, 8 Jan 2007 17:37:21 +0000
Subject: [PATCH] * implemented fpc_Val_Currency_ShortStr.Not used yet.

git-svn-id: trunk@5852 -
---
 rtl/inc/compproc.inc |   1 +
 rtl/inc/sstrings.inc | 134 +++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 135 insertions(+)

diff --git a/rtl/inc/compproc.inc b/rtl/inc/compproc.inc
index 9fcbe331c5..4e3c2a8c1d 100644
--- a/rtl/inc/compproc.inc
+++ b/rtl/inc/compproc.inc
@@ -112,6 +112,7 @@ procedure fpc_chararray_Float(d : ValReal;len,fr,rt : SizeInt;out a : array of c
 Function fpc_Val_Real_ShortStr(const s : shortstring; out code : ValSInt): ValReal; compilerproc;
 Function fpc_Val_SInt_ShortStr(DestSize: SizeInt; Const S: ShortString; out Code: ValSInt): ValSInt; compilerproc;
 Function fpc_Val_UInt_Shortstr(Const S: ShortString; out Code: ValSInt): ValUInt; compilerproc;
+Function fpc_Val_Currency_ShortStr(const s : shortstring; out Code : longint): currency; compilerproc;
 {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
 Function fpc_Val_Real_AnsiStr(Const S : AnsiString; out Code : ValSInt): ValReal; compilerproc;
 Function fpc_Val_UInt_AnsiStr (Const S : AnsiString; out Code : ValSInt): ValUInt; compilerproc;
diff --git a/rtl/inc/sstrings.inc b/rtl/inc/sstrings.inc
index 200d30b78a..1e4022c424 100644
--- a/rtl/inc/sstrings.inc
+++ b/rtl/inc/sstrings.inc
@@ -1008,6 +1008,140 @@ begin
 end;
 
 
+Function fpc_Val_Currency_ShortStr(const s : shortstring; out Code : longint): currency; [public, alias:'FPC_VAL_CURRENCY_SHORTSTR']; compilerproc;
+const
+  MaxInt64 : Int64  = $7FFFFFFFFFFFFFFF;
+  Int64Edge : Int64 = ($7FFFFFFFFFFFFFFF - 10) div 10;
+  Int64Edge2 : Int64 = $7FFFFFFFFFFFFFFF div 10;
+var
+  res : Int64;
+  i,j,power,sign,len : longint;
+  FracOverflow : boolean;
+begin
+  fpc_Val_Currency_ShortStr:=0;
+  res:=0;
+  len:=Length(s);
+  Code:=1;
+  sign:=1;
+  power:=0;
+  while True do
+    if Code > len then
+      exit
+    else
+      if s[Code] in [' ', #9] then
+        Inc(Code)
+      else
+        break;
+  { Read sign }
+  case s[Code] of
+   '+' : Inc(Code);
+   '-' : begin
+           sign:=-1;
+           inc(code);
+         end;
+  end;
+  { Read digits }
+  FracOverflow:=False;
+  i:=0;
+  while Code <= len do
+    begin
+      case s[Code] of
+        '0'..'9':
+          begin
+            j:=Ord(s[code])-Ord('0');
+            { check overflow }
+            if (res <= Int64Edge) or (res <= (MaxInt64 - j) div 10) then
+              begin
+                res:=res*10 + j;
+                Inc(i);
+              end
+            else
+              if power = 0 then
+                { exit if integer part overflow }
+                exit
+              else
+                begin
+                  if not FracOverflow and (j >= 5) and (res < MaxInt64) then
+                    { round if first digit of fractional part overflow }
+                    Inc(res);
+                  FracOverflow:=True;
+                end;
+          end;
+        '.':
+          begin
+            if power = 0 then
+              begin
+                power:=1;
+                i:=0;
+              end
+            else
+              exit;
+          end;
+        else
+          break;
+      end;
+      Inc(Code);
+    end;
+  if (i = 0) and (power = 0) then
+    exit;
+  if power <> 0 then
+    power:=i;
+  power:=4 - power;
+  { Exponent? }
+  if Code <= len then
+    if s[Code] in ['E', 'e'] then
+      begin
+        Inc(Code);
+        if Code > len then
+          exit;
+        i:=1;
+        case s[Code] of
+          '+':
+            Inc(Code);
+          '-':
+            begin
+              i:=-1;
+              Inc(Code);
+            end;
+        end;
+        { read exponent }
+        j:=0;
+        while Code <= len do
+          if s[Code] in ['0'..'9'] then
+            begin
+              if j > 4951 then
+                exit;
+              j:=j*10 + (Ord(s[code])-Ord('0'));
+              Inc(Code);
+            end
+          else
+            exit;
+        power:=power + j*i;
+      end
+    else
+      exit;
+
+  if power > 0 then
+    begin
+      for i:=1 to power do
+        if res <= Int64Edge2 then
+          res:=res*10
+        else
+          exit;
+    end
+  else
+    for i:=1 to -power do
+      begin
+        if res <= MaxInt64 - 5 then
+          Inc(res, 5);
+        res:=res div 10;
+      end;
+  res:=res*sign;
+  fpc_Val_Currency_ShortStr:=PCurrency(@res)^;
+  Code:=0;
+end;
+
+
 Procedure SetString (Out S : Shortstring; Buf : PChar; Len : SizeInt);
 begin
   If Len > High(S) then