From: Eric Botcazou <ebotcazou@adacore.com>
Date: Tue, 17 May 2011 13:53:26 +0000 (+0000)
Subject: * gnat.dg/invalid1.adb: New test.
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=cc0fd50a42ec4bdb6f055b0d760c92994845128d;p=gcc.git

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

From-SVN: r173831
---

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index d0fa8a66149..841c72d8d29 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+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
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;