gcc/testsuite/gnat.dg/frame_overflow.adb

   1 -- { dg-do compile }
   2
   3 with System;
   4
   5 procedure frame_overflow is
   6
   7    type Bitpos_Range_T is range 1..2**(System.Word_Size-1)-1;
   8    type Bitmap_Array_T is array (Bitpos_Range_T) of Boolean;
   9
  10    type Bitmap_T is record
  11       Bits : Bitmap_Array_T := (others => False);
  12    end record;
  13
  14    function
  15      Set_In (Bitmap : Bitmap_T; Bitpos : Bitpos_Range_T)  return Bitmap_T
  16    is
  17       Result: Bitmap_T := Bitmap; -- { dg-error "Storage_Error" }
  18    begin
  19       Result.Bits (Bitpos) := True;
  20       return Result;
  21    end;
  22
  23    function Negate (Bitmap : Bitmap_T) return Bitmap_T is
  24       Result: Bitmap_T; -- { dg-error "Storage_Error" }
  25    begin
  26       for E in Bitpos_Range_T loop
  27         Result.Bits (E) := not Bitmap.Bits (E);
  28       end loop;
  29       return Result;
  30   end;
  31
  32 begin
  33    null;
  34 end;