gcc/testsuite/gnat.dg/float_value1.adb

   1 --  { dg-do run { target i?86-*-* x86_64-*-* } }
   2
   3 with Ada.Strings.Fixed; use Ada.Strings.Fixed;
   4
   5 procedure Float_Value1 is
   6    Str1 : String := "0." & 50000 * "4";
   7    Str2 : String := "1." & 5000 * "4";
   8    Str3 : String := "16#0." & 500000 * "4" & "#";
   9    Str4 : String := "1" & (5000 * "0") & "E-5000";
  10    Str5 : String := "1" & "." & 50000 * "0" & "1";
  11    Str6 : String := 50000 * "0" & "." & 50000 * "2" & "1";
  12    Str7 : String := "1" & (5000 * "0") & "1" & "E-5000";
  13    Str8 : String := "16#1" & "." & 50000 * "0" & "1#";
  14
  15    procedure Test (Msg, Str, Expected : String) is
  16       Number     : Long_Long_Float;
  17    begin
  18       Number := Long_Long_Float'Value (Str);
  19       if Number'Img /= Expected then
  20          raise Program_Error;
  21       end if;
  22    end Test;
  23
  24 begin
  25    Test ("0.4444...[50000 times]   ", Str1, " 4.44444444444444444E-01");
  26    Test ("1.4...[5000 times]       ", Str2, " 1.44444444444444444E+00");
  27    Test ("16#0.[50000 '4']#        ", Str3, " 2.66666666666666667E-01");
  28    Test ("1[5000 zeros]E-5000      ", Str4, " 1.00000000000000000E+00");
  29    Test ("1.[50000zeros]1          ", Str5, " 1.00000000000000000E+00");
  30    Test ("[50000zeros].[50000 '2']1", Str6, " 2.22222222222222222E-01");
  31    Test ("1[50000zeros]1.E-5000    ", Str7, " 1.00000000000000000E+01");
  32    Test ("16#1.[50000zeros]1#      ", Str8, " 1.00000000000000000E+00");
  33
  34    --  Check that number of trailing zero after point does not change
  35    --  the value
  36
  37    for J in 1 .. 10000 loop
  38       declare
  39          Str : String := "0.1" & J * "0";
  40       begin
  41          if Long_Long_Float'Value (Str) /= 0.1 then
  42             raise Program_Error;
  43          end if;
  44       end;
  45    end loop;
  46 end Float_Value1;