gcc/testsuite/gnat.dg/return2.adb

   1 -- { dg-do compile }
   2 -- { dg-options "-O" }
   3
   4 with Return2_Pkg; use Return2_Pkg;
   5
   6 package body Return2 is
   7
   8   function Value_Internal (Image : String) return Result_Internal_T is
   9   begin
  10     return (Member => False);
  11   end;
  12
  13   type Result_T is array (1 .. 2) of Result_Internal_T;
  14
  15   function Value (Img : String) return T is
  16     My_F : constant String := F;
  17     Result : Result_T;
  18     Value : T;
  19   begin
  20     for I in Result'Range loop
  21       if G (My_F, I) /= "" then
  22         Result (I) := Value_Internal (G (My_F, I));
  23         if Result (I).Member then
  24           Value (Result (I).Data) := True;
  25         else
  26           raise Program_Error;
  27         end if;
  28       end if;
  29     end loop;
  30     return Value;
  31   end;
  32
  33 end Return2;