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