gcc/testsuite/gnat.dg/discr24.adb

   1 -- { dg-do run }
   2 -- { dg-options "-gnatp" }
   3
   4 procedure Discr24 is
   5
   6    type Family_Type is (Family_Inet, Family_Inet6);
   7    type Port_Type is new Natural;
   8
   9    subtype Inet_Addr_Comp_Type is Natural range 0 .. 255;
  10
  11    type Inet_Addr_VN_Type is array (Natural range <>) of Inet_Addr_Comp_Type;
  12
  13    subtype Inet_Addr_V4_Type is Inet_Addr_VN_Type (1 ..  4);
  14    subtype Inet_Addr_V6_Type is Inet_Addr_VN_Type (1 .. 16);
  15
  16    type Inet_Addr_Type (Family : Family_Type := Family_Inet) is record
  17       case Family is
  18          when Family_Inet =>
  19             Sin_V4 : Inet_Addr_V4_Type := (others => 0);
  20
  21          when Family_Inet6 =>
  22             Sin_V6 : Inet_Addr_V6_Type := (others => 0);
  23       end case;
  24    end record;
  25
  26    type Sock_Addr_Type (Family : Family_Type := Family_Inet) is record
  27       Addr : Inet_Addr_Type (Family);
  28       Port : Port_Type;
  29    end record;
  30
  31    function F return Inet_Addr_Type is
  32    begin
  33       return Inet_Addr_Type'
  34         (Family => Family_Inet, Sin_V4 => (192, 168, 169, 170));
  35    end F;
  36
  37    SA : Sock_Addr_Type;
  38
  39 begin
  40    SA.Addr.Sin_V4 := (172, 16, 17, 18);
  41    SA.Port := 1111;
  42    SA.Addr := F;
  43    if SA.Port /= 1111 then
  44      raise Program_Error;
  45    end if;
  46 end;