aboutsummaryrefslogtreecommitdiffstats
path: root/gcc-4.9/gcc/testsuite/gnat.dg/array_bounds_test2.adb
blob: 43e1ed3ced0c334b8946097bc94f94654faf4f6e (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
--  { dg-do run }

with Ada.Unchecked_Deallocation;

procedure Array_Bounds_Test2 is

  type String_Ptr_T is access String;
  procedure Free is new Ada.Unchecked_Deallocation (String, String_Ptr_T);
  String_Data : String_Ptr_T := new String'("Hello World");

  function Peek return String_Ptr_T is
  begin
    return String_Data;
  end Peek;

begin
  declare
    Corrupted_String : String := Peek.all;
  begin
    Free(String_Data);
    if Corrupted_String'First /= 1 then
      raise Program_Error;
    end if;
  end;
end;