gcc/testsuite/gnat.dg/test_fixed_io.adb

   1 --  { dg-do run }
   2
   3 with Ada.Text_IO; use Ada.Text_IO;
   4
   5 procedure test_fixed_io is
   6    type FX is delta 0.0001 range -3.0 .. 250.0;
   7    for FX'Small use 0.0001;
   8    package FXIO is new Fixed_IO (FX);
   9    use FXIO;
  10    ST : String (1 .. 11)  := (others => ' ');
  11    ST2 : String (1 .. 12) := (others => ' ');
  12
  13    N : constant FX := -2.345;
  14 begin
  15    begin
  16       Put (ST, N, 6, 2);
  17       Put_Line ("*ERROR* Test1: Exception Layout_Error was not raised");
  18       Put_Line ("ST = """ & ST & '"');
  19    exception
  20       when Layout_Error =>
  21          null;
  22       when others =>
  23          Put_Line ("Test1: Unexpected exception");
  24    end;
  25
  26    begin
  27       Put (ST2, N, 6, 2);
  28    exception
  29       when Layout_Error =>
  30          Put_Line ("*ERROR* Test2: Exception Layout_Error was raised");
  31       when others =>
  32          Put_Line ("Test2: Unexpected exception");
  33    end;
  34 end;