gcc/testsuite/gnat.dg/discr30.adb

   1 -- PR ada/48844
   2 -- Reported by Georg Bauhaus <bauhaus@futureapps.de> */
   3
   4 -- { dg-do compile }
   5
   6 procedure Discr30 is
   7
   8    generic
   9      type Source is private;
  10      type Target is private;
  11    function Conversion (S : Source) return Target;
  12
  13    function Conversion (S : Source) return Target is
  14       type Source_Wrapper is tagged record
  15          S : Source;
  16       end record;
  17       type Target_Wrapper is tagged record
  18          T : Target;
  19       end record;
  20
  21       type Selector is (Source_Field, Target_Field);
  22       type Magic (Sel : Selector := Target_Field) is record
  23          case Sel is
  24             when Source_Field => S : Source_Wrapper;
  25             when Target_Field => T : Target_Wrapper;
  26          end case;
  27       end record;
  28
  29       M : Magic;
  30
  31       function Convert (T : Target_Wrapper) return Target is
  32       begin
  33          M := (Sel => Source_Field, S => (S => S));
  34          return T.T;
  35       end Convert;
  36
  37    begin
  38       return Convert (M.T);
  39    end Conversion;
  40
  41    type Integer_Access is access all Integer;
  42
  43    I : aliased Integer;
  44    I_Access : Integer_Access := I'Access;
  45
  46    function Convert is new Conversion (Integer_Access, Integer);
  47
  48 begin
  49    I := Convert (I_Access);
  50 end;