gcc/testsuite/gnat.dg/derived_type2.adb

   1 -- { dg-do run }
   2 -- { dg-options "-gnatws" }
   3
   4 procedure Derived_Type2 is
   5
   6    package Pkg is
   7
   8       type Parent (B : Boolean := True) is record
   9          case B is
  10             when True => S : String (1 .. 5);
  11             when False => F : Float;
  12          end case;
  13       end record;
  14
  15       function Create (X : Parent) return Parent;
  16
  17    end Pkg;
  18
  19    package body Pkg is
  20
  21       function Create (X : Parent) return Parent is
  22       begin
  23          return (True, "12345");
  24       end;
  25
  26    end Pkg;
  27
  28    use Pkg;
  29
  30    type T is new Parent (True);
  31
  32    X : T;
  33
  34 begin
  35
  36    if Create (X).B /= True then
  37       raise Program_Error;
  38    end if;
  39
  40 end;