gcc/testsuite/gnat.dg/frame_overflow.adb

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