Skip to content

Commit 3aca5ec

Browse files
TurboGitTurboGit
committed
Fix SOAP float serialization to not loose precision.
Update regression test to cover those cases. Continued work for T310-007.
1 parent 88c9d17 commit 3aca5ec

File tree

10 files changed

+66
-33
lines changed

10 files changed

+66
-33
lines changed

‎regtests/0037_anytype/anytype.adb

Lines changed: 6 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
------------------------------------------------------------------------------
22
-- Ada Web Server --
33
-- --
4-
-- Copyright (C) 2004-2019, AdaCore --
4+
-- Copyright (C) 2004-2020, AdaCore --
55
-- --
66
-- This is free software; you can redistribute it and/or modify it --
77
-- under terms of the GNU General Public License as published by the --
@@ -41,6 +41,7 @@ procedure AnyType is
4141
use Ada;
4242
use AWS;
4343
use SOAP.Types;
44+
4445
use AnyType_Service;
4546

4647
H_Server : AWS.Server.HTTP;
@@ -124,6 +125,10 @@ procedure AnyType is
124125
function Trim (Str : String) return String is
125126
K : Natural := Str'Last;
126127
begin
128+
if Str'Length > 4 and then Str (K - 3 .. K) = "E+00" then
129+
K := K - 4;
130+
end if;
131+
127132
while Str (K) = '0' loop
128133
K := K - 1;
129134
end loop;

‎regtests/0071_interoplab_main1/interoplab_main1.adb

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,7 @@
11
------------------------------------------------------------------------------
22
-- Ada Web Server --
33
-- --
4-
-- Copyright (C) 2003-2015, AdaCore --
4+
-- Copyright (C) 2003-2020, AdaCore --
55
-- --
66
-- This is free software; you can redistribute it and/or modify it --
77
-- under terms of the GNU General Public License as published by the --
@@ -263,7 +263,7 @@ procedure Interoplab_Main1 is
263263
Text_IO.Put_Line ("Echo Float");
264264
FIO.Put (TinteropLab.Client.echoFloat (2.345), Aft => 5, Exp => 0);
265265
Text_IO.New_Line;
266-
FIO.Put (TinteropLab.Client.echoFloat (456.8765), Aft => 5, Exp => 0);
266+
FIO.Put (TinteropLab.Client.echoFloat (456.8765));
267267
Text_IO.New_Line;
268268
Text_IO.New_Line;
269269
end T_echoFloat;

‎regtests/0071_interoplab_main1/test.out

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -31,7 +31,7 @@ Echo ArrayOfint
3131

3232
Echo Float
3333
2.34500
34-
456.87650
34+
4.56876E+02
3535

3636
Echo Struct
3737
6
@@ -60,4 +60,3 @@ two
6060
3
6161
3.30
6262
three
63-

‎regtests/0101_soap6/test.out

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -6,12 +6,12 @@
66
<getLastReturn soapenc:arrayType="ns3:Candle[1]" xsi:type="soapenc:Array">
77
<ns4:item xsi:type="ns4:Candle">
88
<artificial xsi:type="ns5:boolean">0</artificial>
9-
<closePrice xsi:type="ns6:double">1.74650000000000</closePrice>
9+
<closePrice xsi:type="ns6:double">1.74650000000000E+00</closePrice>
1010
<flat xsi:type="ns7:boolean">0</flat>
1111
<id xsi:type="ns8:int">533</id>
12-
<maxPrice xsi:type="ns9:double">1.74650000000000</maxPrice>
13-
<minPrice xsi:type="ns10:double">1.74590000000000</minPrice>
14-
<openPrice xsi:type="ns11:double">1.74650000000000</openPrice>
12+
<maxPrice xsi:type="ns9:double">1.74650000000000E+00</maxPrice>
13+
<minPrice xsi:type="ns10:double">1.74590000000000E+00</minPrice>
14+
<openPrice xsi:type="ns11:double">1.74650000000000E+00</openPrice>
1515
<periodType xsi:type="ns12:int">0</periodType>
1616
<time xsi:type="ns13:long">1089143140</time>
1717
<timeIndex xsi:type="ns14:int">108914314</timeIndex>

‎regtests/0272_simpledoc/test.out

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,7 @@
66
xmlns:tns="http://simple.doc.net/sd">
77
<tns:myMethod>
88
<tns:x>6</tns:x>
9-
<tns:y>1.12300</tns:y>
9+
<tns:y>1.12300E+00</tns:y>
1010
</tns:myMethod>
1111
</soapenv:Body>
1212
</soapenv:Envelope>

‎regtests/0273_simpledoc2/test.out

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -4,7 +4,7 @@
44
<soapenv:Body
55
xmlns:awsns="http://soapaws/">
66
<xElement>2</xElement>
7-
<yElement>8.10000</yElement>
7+
<yElement>8.10000E+00</yElement>
88
</soapenv:Body>
99
</soapenv:Envelope>
1010

‎regtests/0274_doclit2/test.out

Lines changed: 12 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -19,27 +19,27 @@ maximumQueueSize = 16
1919
<abc:executionTime>XXXX-XX-XXTXX:XX:XXZ</abc:executionTime>
2020
<abc:valueA>
2121
<abc:latLong>
22-
<sp:latitudeDegrees>1.00000000000000</sp:latitudeDegrees>
23-
<sp:longitudeDegrees>1.10000000000000</sp:longitudeDegrees>
22+
<sp:latitudeDegrees>1.00000000000000E+00</sp:latitudeDegrees>
23+
<sp:longitudeDegrees>1.10000000000000E+00</sp:longitudeDegrees>
2424
</abc:latLong>
25-
<abc:field7>3.00000000000000</abc:field7>
26-
<abc:field8>4.00000000000000</abc:field8>
25+
<abc:field7>3.00000000000000E+00</abc:field7>
26+
<abc:field8>4.00000000000000E+00</abc:field8>
2727
<abc:field9>2</abc:field9>
28-
<abc:field12>0.90000000000000</abc:field12>
28+
<abc:field12>9.00000000000000E-01</abc:field12>
2929
<abc:field10>8</abc:field10>
30-
<abc:field11>0.60000000000000</abc:field11>
30+
<abc:field11>6.00000000000000E-01</abc:field11>
3131
</abc:valueA>
3232
<abc:valueA>
3333
<abc:latLong>
34-
<sp:latitudeDegrees>2.00000000000000</sp:latitudeDegrees>
35-
<sp:longitudeDegrees>2.10000000000000</sp:longitudeDegrees>
34+
<sp:latitudeDegrees>2.00000000000000E+00</sp:latitudeDegrees>
35+
<sp:longitudeDegrees>2.10000000000000E+00</sp:longitudeDegrees>
3636
</abc:latLong>
37-
<abc:field7>3.20000000000000</abc:field7>
38-
<abc:field8>4.20000000000000</abc:field8>
37+
<abc:field7>3.20000000000000E+00</abc:field7>
38+
<abc:field8>4.20000000000000E+00</abc:field8>
3939
<abc:field9>2</abc:field9>
40-
<abc:field12>0.91000000000000</abc:field12>
40+
<abc:field12>9.10000000000000E-01</abc:field12>
4141
<abc:field10>81</abc:field10>
42-
<abc:field11>0.61000000000000</abc:field11>
42+
<abc:field11>6.10000000000000E-01</abc:field11>
4343
</abc:valueA>
4444

4545
</abc:executeRequest>

‎regtests/0325_float_nan/test.out

Lines changed: 12 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,16 @@
11
1.10000
2-
+Inf****
3-
-Inf****
2+
0.00001
3+
1.00000E-06
4+
1.00000E+08
5+
1.00000E-15
6+
+Inf********
7+
-Inf********
48
NaN*****
59
1.20000000000000
6-
+Inf*************
7-
-Inf*************
10+
0.00000000000001
11+
1.00000000000000E-15
12+
1.00000000000000E+16
13+
1.00000000000000E-25
14+
+Inf*****************
15+
-Inf*****************
816
NaN**************

‎regtests/0325_float_nan/wsdl_nan_main.adb

Lines changed: 24 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -40,18 +40,30 @@ procedure WSDL_NaN_Main is
4040
with Import, Convention => Intrinsic, External_Name => "__builtin_inf";
4141

4242
procedure T_Float (V : Float) is
43-
F : Float := 0.0;
43+
Min : constant Float := 10.0 ** (-Float'Digits);
44+
Max : constant Float := 10.0 ** (Float'Digits);
45+
F : Float := 0.0;
4446
begin
4547
F := WSDL_NaN_Service.Client.Echo_F (V);
46-
Float_Text_IO.Put (F, Exp => 0);
48+
if F <= Min or else V >= Max then
49+
Float_Text_IO.Put (F);
50+
else
51+
Float_Text_IO.Put (F, Exp => 0);
52+
end if;
4753
Text_IO.New_Line;
4854
end T_Float;
4955

5056
procedure T_Double (V : Long_Float) is
51-
F : Long_Float := 0.0;
57+
Min : constant Long_Float := 10.0 ** (-Long_Float'Digits);
58+
Max : constant Long_Float := 10.0 ** (Long_Float'Digits);
59+
F : Long_Float := 0.0;
5260
begin
5361
F := WSDL_NaN_Service.Client.Echo_D (V);
54-
Long_Float_Text_IO.Put (F, Exp => 0);
62+
if F <= Min or else V >= Max then
63+
Long_Float_Text_IO.Put (F);
64+
else
65+
Long_Float_Text_IO.Put (F, Exp => 0);
66+
end if;
5567
Text_IO.New_Line;
5668
end T_Double;
5769

@@ -77,13 +89,21 @@ begin
7789
-- Float
7890

7991
T_Float (1.1);
92+
T_Float (0.00001);
93+
T_Float (0.000001);
94+
T_Float (1.0E8);
95+
T_Float (1.0E-15);
8096
T_Float (+Float_Infinity);
8197
T_Float (-Float_Infinity);
8298
T_Float (Float'Invalid_Value);
8399

84100
-- Long Float
85101

86102
T_Double (1.2);
103+
T_Double (0.00000000000001);
104+
T_Double (0.000000000000001);
105+
T_Double (1.0E16);
106+
T_Double (1.0E-25);
87107
T_Double (+Long_Float_Infinity);
88108
T_Double (-Long_Float_Infinity);
89109
T_Double (Long_Float'Invalid_Value);

‎src/soap/soap-types.adb

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -881,10 +881,11 @@ package body SOAP.Types is
881881

882882
procedure Put (R : out String; V : Float) is
883883
begin
884-
Float_Text_IO.Put (R, V, Exp => 0);
884+
Float_Text_IO.Put (R, V);
885885
end Put;
886886

887887
function Image is new F_Image_G (Float, Float_Infinity, Put);
888+
888889
begin
889890
return Image (O.V);
890891
end Image;
@@ -901,7 +902,7 @@ package body SOAP.Types is
901902

902903
procedure Put (R : out String; V : Long_Float) is
903904
begin
904-
Long_Float_Text_IO.Put (R, V, Exp => 0);
905+
Long_Float_Text_IO.Put (R, V);
905906
end Put;
906907

907908
function Image is new F_Image_G (Long_Float, Long_Float_Infinity, Put);

0 commit comments

Comments
 (0)