gcc/testsuite/gnat.dg/invalid1.adb

   1 -- { dg-do run }
   2 -- { dg-options "-gnatws -gnatVa" }
   3
   4 pragma Initialize_Scalars;
   5
   6 procedure 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
  19 begin
  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
  49 end;