1------------------------------------------------------------------------------
2--                     XML/Ada - An XML suite for Ada95                     --
3--                                                                          --
4--                     Copyright (C) 2007-2017, AdaCore                     --
5--                                                                          --
6-- This library is free software;  you can redistribute it and/or modify it --
7-- under terms of the  GNU General Public License  as published by the Free --
8-- Software  Foundation;  either version 3,  or (at your  option) any later --
9-- version. This library is distributed in the hope that it will be useful, --
10-- but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN- --
11-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE.                            --
12--                                                                          --
13-- As a special exception under Section 7 of GPL version 3, you are granted --
14-- additional permissions described in the GCC Runtime Library Exception,   --
15-- version 3.1, as published by the Free Software Foundation.               --
16--                                                                          --
17-- You should have received a copy of the GNU General Public License and    --
18-- a copy of the GCC Runtime Library Exception along with this program;     --
19-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
20-- <http://www.gnu.org/licenses/>.                                          --
21--                                                                          --
22------------------------------------------------------------------------------
23
24with Schema.Decimal;    use Schema.Decimal;
25with GNAT.IO;           use GNAT.IO;
26with Sax.Symbols;       use Sax.Symbols;
27with Sax.Utils;         use Sax.Utils;
28
29procedure TestNumbers is
30   procedure Assert_Nan (Num : String);
31   --  Check that Num is not a valid number
32
33   procedure Assert (Num1, Num2 : String; Expected : Character);
34   --  Compare two numbers
35
36   procedure Assert_Digits
37      (Num : String; Fraction, Total : Integer; Error : Boolean := False);
38
39   procedure Float_Less_Than (Num1, Num2 : String);
40   --  Makes sure than Num1 < Num2
41
42   Symbols : constant Symbol_Table := Allocate;
43
44   -------------------
45   -- Assert_Digits --
46   -------------------
47
48   procedure Assert_Digits
49      (Num : String; Fraction, Total : Integer; Error : Boolean := False)
50   is
51      N     : Arbitrary_Precision_Number;
52      Err : Symbol;
53   begin
54      Value (Symbols, Num, N, Err);
55      Err := Check_Digits (Symbols, N, Fraction, Total);
56
57      if Error then
58         if Err = No_Symbol then
59            Put_Line (Num & " expected error" & Fraction'Img & Total'Img);
60         end if;
61      else
62         if Err /= No_Symbol then
63            Put_Line (Num & " unexpected error" & Fraction'Img & Total'Img);
64            Put_Line (Get (Err).all);
65         end if;
66      end if;
67   end Assert_Digits;
68
69   ----------------
70   -- Assert_Nan --
71   ----------------
72
73   procedure Assert_Nan (Num : String) is
74      Error : Symbol;
75      N : Arbitrary_Precision_Number;
76      pragma Unreferenced (N);
77   begin
78      Value (Symbols, Num, N, Error);
79      if Error = No_Symbol then
80         Put_Line (Num & " should not be authorized");
81      end if;
82   end Assert_Nan;
83
84   ------------
85   -- Assert --
86   ------------
87
88   procedure Assert (Num1, Num2 : String; Expected : Character) is
89      Error : Symbol;
90      N1, N2 : Arbitrary_Precision_Number;
91   begin
92      Value (Symbols, Num1, N1, Error);
93      Value (Symbols, Num2, N2, Error);
94
95      case Expected is
96         when '<' =>
97            if not (N1 < N2) then
98               Put_Line (Num1 & " < " & Num2);
99            end if;
100            if not (N2 > N1) then
101               Put_Line (Num2 & " > " & Num1);
102            end if;
103
104         when '=' =>
105            if not (N1 = N2) then
106               Put_Line (Num1 & " = " & Num2);
107            end if;
108
109         when '>' =>
110            if not (N1 > N2) then
111               Put_Line (Num1 & " > " & Num2);
112            end if;
113            if not (N2 < N1) then
114               Put_Line (Num2 & " < " & Num1);
115            end if;
116
117         when others =>
118            Put_Line ("Unexpected comparision");
119      end case;
120   end Assert;
121
122   ---------------------
123   -- Float_Less_Than --
124   ---------------------
125
126   procedure Float_Less_Than (Num1, Num2 : String) is
127      N1 :  constant XML_Float := Value (Num1);
128      N2 :  constant XML_Float := Value (Num2);
129   begin
130      if not (N1 < N2) then
131         Put_Line ("Should have " & Num1 & " < " & Num2);
132      end if;
133      if not (N1 <= N2) then
134         Put_Line ("Should have " & Num1 & " <= " & Num2);
135      end if;
136   end Float_Less_Than;
137
138   Num_Invalid1 : constant String := "--23";
139   Num_Invalid2 : constant String := "-23..";
140   Num_Invalid3 : constant String := "2A24";
141   Num_Invalid4 : constant String := "@234";
142   Num_Invalid5 : constant String := "12E";
143   Num_Invalid6 : constant String := "12E@23";
144
145   Num1 : constant String := "1";
146   Num2 : constant String := "10";
147   Num3 : constant String := "1E-1";
148   Num4 : constant String := "9e-1";
149   Num5 : constant String := "-100E-2";
150   Num6 : constant String := "-124.567E2";
151   Num7 : constant String := "-12345.678E1";
152
153   Num8 : constant String := "124.45E5";
154   Num9 : constant String := "123.4";
155
156begin
157   Assert_Nan (Num_Invalid1);
158   Assert_Nan (Num_Invalid2);
159   Assert_Nan (Num_Invalid3);
160   Assert_Nan (Num_Invalid4);
161   Assert_Nan (Num_Invalid5);
162   Assert_Nan (Num_Invalid6);
163
164   Assert (Num1, Num2, '<');
165   Assert (Num1, Num3, '>');
166   Assert (Num1, Num4, '>');
167   Assert (Num1, Num5, '>');
168   Assert (Num6, Num7, '>');
169
170   Assert_Digits (Num8, 0, 9);
171   Assert_Digits (Num8, 0, 8);
172   Assert_Digits (Num8, 0, 4, True);
173
174   Assert_Digits (Num9, -1, 5);
175   Assert_Digits (Num9, -1, 4);
176   Assert_Digits (Num9, -1, 3, True);
177
178   Assert_Digits (Num9, 2, -1);
179   Assert_Digits (Num9, 1, -1);
180   Assert_Digits (Num9, Fraction => 0, Total => -1, Error => True);
181
182   Assert_Digits (Num8, 1, -1);
183   Assert_Digits (Num8, 0, -1);
184   Assert_Digits (Num6, 1, -1);
185   Assert_Digits (Num6, 0, -1, True);
186
187   Float_Less_Than ("0.0", "1.0");
188   Float_Less_Than ("1.0", "2.0");
189   Float_Less_Than ("-2.0", "1.0");
190   Float_Less_Than ("-2.0", "-1.0");
191   Float_Less_Than ("-1.79E+308", "-1.79");
192   Float_Less_Than ("1E+3245", "1E+3246");
193   Float_Less_Than ("-1E+3246", "-1E+3245");
194   Float_Less_Than ("1E-32", "1E+32");
195   Float_Less_Than ("-1E+32", "1E-32");
196
197end TestNumbers;
198