2011-05-20 Basile Starynkevitch <basile@starynkevitch.net>

	MELT branch merged with trunk rev 173935 using svnmerge



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/melt-branch@173937 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 49 insertions, 0 deletions

diff --git a/gcc/testsuite/gnat.dg/invalid1.adb b/gcc/testsuite/gnat.dg/invalid1.adb
new file mode 100644
index 00000000000..ff9b34ad855
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/invalid1.adb
@@ -0,0 +1,49 @@
+-- { 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;