* gnat.dg/invalid1.adb: New test.

From-SVN: r173831

gcc/testsuite/ChangeLog

+2011-05-17  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gnat.dg/invalid1.adb: New test.
+
 2011-05-16  Uros Bizjak  <ubizjak@gmail.com>
 
 	* gcc.target/i386/avx-vzeroupper-16.c: Update scan-assembler-times

gcc/testsuite/gnat.dg/invalid1.adb

+-- { dg-do run }
+-- { dg-options "-gnatws -gnatVa" }
+
+pragma Initialize_Scalars;
+
+procedure Invalid1 is
+
+  X : Boolean;
+  A : Boolean := False;
+
+  procedure Uninit (B : out Boolean) is
+  begin
+    if A then
+      B := True;
+      raise Program_Error;
+    end if;
+  end;
+
+begin
+
+  -- first, check that initialize_scalars is enabled
+  begin
+    if X then
+      A := False;
+    end if;
+    raise Program_Error;
+  exception
+    when Constraint_Error => null;
+  end;
+
+  -- second, check if copyback of an invalid value raises constraint error
+  begin
+    Uninit (A);
+    if A then
+      -- we expect constraint error in the 'if' above according to gnat ug:
+      -- ....
+      -- call.  Note that there is no specific option to test `out'
+      -- parameters, but any reference within the subprogram will be tested
+      -- in the usual manner, and if an invalid value is copied back, any
+      -- reference to it will be subject to validity checking.
+      -- ...
+      raise Program_Error;
+    end if;
+    raise Program_Error;
+  exception
+    when Constraint_Error => null;
+  end;
+
+end;