paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-02 13:59:35 +01:00
Code Issues Packages Projects Releases Wiki Activity

* fixed web bug #7756

Browse Source 
git-svn-id: trunk@5516 -
This commit is contained in:
Jonas Maebe 2006-12-01 17:00:03 +00:00
parent b0ef674721
commit fb22cb9efc
4 changed files with 487 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -7745,6 +7745,7 @@ tests/webtbs/tw7568.pp svneol=native#text/plain
tests/webtbs/tw7637.pp svneol=native#text/plain
tests/webtbs/tw7643.pp svneol=native#text/plain
tests/webtbs/tw7679.pp svneol=native#text/plain
tests/webtbs/tw7756.pp svneol=native#text/plain
tests/webtbs/tw7817a.pp svneol=native#text/plain
tests/webtbs/tw7817b.pp svneol=native#text/plain
tests/webtbs/ub1873.pp svneol=native#text/plain

150
rtl/objpas/sysutils/sysstr.inc
View File

@ -1887,69 +1887,107 @@ End;
Procedure FloatToDecimal(Var Result: TFloatRec; Value: Extended; Precision, Decimals : integer);
Procedure FloatToDecimal(Out Result: TFloatRec; Value: Extended; Precision, Decimals : integer);
Var
Buffer: String[24];
Error, N: Integer;
Begin
var
Buffer: String[254]; //Though str func returns only 25 chars, this might change in the future
Error, N, L, Start, C: Integer;
GotNonZeroBeforeDot, BeforeDot : boolean;
begin
Str(Value:23, Buffer);
Result.Negative := (Buffer[1] = '-');
Val(Copy(Buffer, 19, 5), Result.Exponent, Error);
Inc(Result. Exponent);
Result.Digits[0] := Buffer[2];
Move(Buffer[4], Result.Digits[1], 14);
If Decimals + Result.Exponent < Precision Then
N := 1;
L := Byte(Buffer[0]);
while Buffer[N]=' ' do
Inc(N);
Result.Negative := (Buffer[N] = '-');
if Result.Negative then
Inc(N);
Start := N; //Start of digits
Result.Exponent := 0; BeforeDot := true;
GotNonZeroBeforeDot := false;
while (L>=N) and (Buffer[N]<>'E') do
begin
if Buffer[N]='.' then
BeforeDot := false
else
begin
if BeforeDot then
begin // Currently this is always 1 char
Inc(Result.Exponent);
Result.Digits[N-Start] := Buffer[N];
if Buffer[N] <> '0' then
GotNonZeroBeforeDot := true;
end
else
Result.Digits[N-Start-1] := Buffer[N]
end;
Inc(N);
end;
Inc(N); // Pass through 'E'
if N<=L then
begin
Val(Copy(Buffer, N, L-N+1), C, Error); // Get exponent after 'E'
Inc(Result.Exponent, C);
end;
// Calculate number of digits we have from str
if BeforeDot then
N := N - Start - 1
else
N := N - Start - 2;
L := SizeOf(Result.Digits);
if N<L then
FillChar(Result.Digits[N], L-N, '0'); //Zero remaining space
if Decimals + Result.Exponent < Precision Then //After this it is the same as in FloatToDecimal
N := Decimals + Result.Exponent
Else
N := Precision;
If N > maxdigits Then
N := maxdigits;
If N = 0 Then
Begin
If Result.Digits[0] >= '5' Then
Begin
Result.Digits[0] := '1';
Result.Digits[1] := #0;
Inc(Result.Exponent);
End
Else
Result.Digits[0] := #0;
End
Else If N > 0 Then
Begin
If Result.Digits[N] >= '5' Then
Begin
Repeat
Result.Digits[N] := #0;
Dec(N);
Inc(Result.Digits[N]);
Until (N = 0) Or (Result.Digits[N] < ':');
If Result.Digits[0] = ':' Then
Begin
Result.Digits[0] := '1';
Inc(Result.Exponent);
End;
End
Else
Begin
Result.Digits[N] := '0';
While (Result.Digits[N] = '0') And (N > -1) Do
Begin
Result.Digits[N] := #0;
Dec(N);
End;
End;
End
if N >= L Then
N := L-1;
if N = 0 Then
begin
if Result.Digits[0] >= '5' Then
begin
Result.Digits[0] := '1';
Result.Digits[1] := #0;
Inc(Result.Exponent);
end
Else
Result.Digits[0] := #0;
end //N=0
Else if N > 0 Then
begin
if Result.Digits[N] >= '5' Then
begin
Repeat
Result.Digits[N] := #0;
Dec(N);
Inc(Result.Digits[N]);
Until (N = 0) Or (Result.Digits[N] < ':');
If Result.Digits[0] = ':' Then
begin
Result.Digits[0] := '1';
Inc(Result.Exponent);
end;
end
Else
begin
Result.Digits[N] := '0';
While (N > -1) And (Result.Digits[N] = '0') Do
begin
Result.Digits[N] := #0;
Dec(N);
end;
end;
end //N>0
Else
Result.Digits[0] := #0;
If Result.Digits[0] = #0 Then
Begin
Result.Exponent := 0;
Result.Negative := False;
End;
End;
if (Result.Digits[0] = #0) and
not GotNonZeroBeforeDot then
begin
Result.Exponent := 0;
Result.Negative := False;
end;
end;
Function FormatFloat(Const format: String; Value: Extended): String;

2
rtl/objpas/sysutils/sysstrh.inc
View File

@ -168,7 +168,7 @@ function TryStrToBool(const S: string; out Value: Boolean): Boolean;
function LastDelimiter(const Delimiters, S: string): Integer;
function StringReplace(const S, OldPattern, NewPattern: string; Flags: TReplaceFlags): string;
Function FloatToTextFmt(Buffer: PChar; Value: Extended; format: PChar): Integer;
Procedure FloatToDecimal(Var Result: TFloatRec; Value: Extended; Precision, Decimals : integer);
Procedure FloatToDecimal(Out Result: TFloatRec; Value: Extended; Precision, Decimals : integer);
Function FormatFloat(Const Format : String; Value : Extended) : String;
Function IsDelimiter(const Delimiters, S: string; Index: Integer): Boolean;
function FormatCurr(const Format: string; Value: Currency): string;

391
tests/webtbs/tw7756.pp Normal file
View File

@ -0,0 +1,391 @@
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-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',
'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;
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
halt(1);
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(1);
inc(cg);
end;
END.