1-- { dg-do run }
2-- { dg-options "-gnatws -gnatVa" }
3
4pragma Initialize_Scalars;
5
6procedure Invalid1 is
7
8  X : Boolean;
9  A : Boolean := False;
10
11  procedure Uninit (B : out Boolean) is
12  begin
13    if A then
14      B := True;
15      raise Program_Error;
16    end if;
17  end;
18
19begin
20
21  -- first, check that initialize_scalars is enabled
22  begin
23    if X then
24      A := False;
25    end if;
26    raise Program_Error;
27  exception
28    when Constraint_Error => null;
29  end;
30
31  -- second, check if copyback of an invalid value raises constraint error
32  begin
33    Uninit (A);
34    if A then
35      -- we expect constraint error in the 'if' above according to gnat ug:
36      -- ....
37      -- call.  Note that there is no specific option to test `out'
38      -- parameters, but any reference within the subprogram will be tested
39      -- in the usual manner, and if an invalid value is copied back, any
40      -- reference to it will be subject to validity checking.
41      -- ...
42      raise Program_Error;
43    end if;
44    raise Program_Error;
45  exception
46    when Constraint_Error => null;
47  end;
48
49end;
50