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