gcc/testsuite/gnat.dg/opt37.adb

   1 -- { dg-compile }
   2 -- { dg-options "-O2 -gnato -fdump-tree-optimized" }
   3
   4 package body Opt37 is
   5
   6    function To_Unchecked (Bits : T_Bit_Array) return Unsigned32 is
   7       Value : Unsigned32 := 0;
   8    begin
   9       for I in Bits'Range loop
  10          Value := Value * 2 + Unsigned32 (Bits(I));
  11       end loop;
  12       return Value;
  13    end;
  14
  15    function To_Scalar (Bits : T_Bit_Array) return Positive is
  16       Tmp   : Unsigned32;
  17       Value : Positive;
  18    begin
  19       Tmp := To_Unchecked (Bits);
  20       if Tmp in 0 .. Unsigned32 (Positive'last) then
  21          Value := Positive (Tmp);
  22       else
  23          Value := -Positive (Unsigned32'last - Tmp);
  24          if Value > Positive'first then
  25             Value := Value - 1;
  26          else
  27             raise Program_Error;
  28          end if;
  29       end if;
  30       return Value;
  31    end;
  32
  33    function Func (Bit_Array : T_Bit_Array;
  34                   Bit_Index : T_Bit_Index) return Positive is
  35    begin
  36       return To_Scalar (Bit_Array (Bit_Index .. Bit_Index + 1));
  37    end;
  38
  39 end Opt37;
  40
  41 -- { dg-final { scan-tree-dump-not "alloca" "optimized" } }
  42 -- { dg-final { cleanup-tree-dump "optimized" } }