From cc0fd50a42ec4bdb6f055b0d760c92994845128d Mon Sep 17 00:00:00 2001 From: Eric Botcazou Date: Tue, 17 May 2011 13:53:26 +0000 Subject: [PATCH] * gnat.dg/invalid1.adb: New test. From-SVN: r173831 --- gcc/testsuite/ChangeLog | 4 +++ gcc/testsuite/gnat.dg/invalid1.adb | 49 ++++++++++++++++++++++++++++++ 2 files changed, 53 insertions(+) create mode 100644 gcc/testsuite/gnat.dg/invalid1.adb 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 + + * gnat.dg/invalid1.adb: New test. + 2011-05-16 Uros Bizjak * 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; -- 2.30.2