gcc/testsuite/gnat.dg/tail_call_p.adb

   1 package body Tail_Call_P is
   2
   3   function Start_Side (Element : T) return Index is
   4   begin
   5     if Element = 1 then
   6       raise Program_Error;
   7     end if;
   8     if Element = 0 then
   9       return Second;
  10     else
  11       return First;
  12     end if;
  13   end;
  14
  15   function Segment (Element : T) return T is
  16   begin
  17     if Element /= 0 then
  18       raise Program_Error;
  19     end if;
  20     return 1;
  21   end;
  22
  23   procedure Really_Insert (Into : T; Element : T; Value : T) is
  24   begin
  25     if Into /= 0 then
  26       raise Program_Error;
  27     end if;
  28   end;
  29
  30   procedure Insert (Into : A; Element : T; Value : T) is
  31   begin
  32     Really_Insert (Into (Start_Side (Element)), Segment (Element), Value);
  33   end Insert;
  34
  35 end Tail_Call_P;