From: Samuel Tardieu <sam@rfc1149.net>
Date: Fri, 7 Dec 2007 14:35:22 +0000 (+0000)
Subject: re PR ada/15805 (Illegal program not detected, allows writing through access to constant)
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=2eb160f205ce2a807ecdef95b2e88652a5e3f0ed;p=gcc.git

re PR ada/15805 (Illegal program not detected, allows writing through access to constant)

    gcc/ada/
	PR ada/15805
	* sem_ch6.adb (Process_Formals): Prevent an access type formal
	to be initialized with an access to constant object.

    gcc/testsuite/
	PR ada/15805
	* gnat.dg/specs/access_constants.ads: New test.

From-SVN: r130676
---

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 5a103324577..9ddc6da809f 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,9 @@
+2007-12-07  Samuel Tardieu  <sam@rfc1149.net>
+
+	PR ada/15805
+	* sem_ch6.adb (Process_Formals): Prevent an access type formal
+	to be initialized with an access to constant object.
+
 2007-12-07  Olivier Hainque  <hainque@adacore.com>
 
 	PR ada/34173
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 69064c28a80..b2451cb5eab 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -6998,6 +6998,20 @@ package body Sem_Ch6 is
 
             Analyze_Per_Use_Expression (Default, Formal_Type);
 
+            --  Check that an access to constant is not used with an
+            --  access type.
+
+            if Ekind (Formal_Type) = E_Anonymous_Access_Type
+              and then not Is_Access_Constant (Formal_Type)
+              and then Is_Access_Type (Etype (Default))
+              and then Is_Access_Constant (Etype (Default))
+            then
+               Error_Msg_NE ("parameter of type& cannot be initialized " &
+                             "with an access-to-constant expression",
+                             Default,
+                             Formal_Type);
+            end if;
+
             --  Check that the designated type of an access parameter's default
             --  is not a class-wide type unless the parameter's designated type
             --  is also class-wide.
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 12aad8cbc12..2342e5e3aed 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2007-12-07  Samuel Tardieu  <sam@rfc1149.net>
+
+	PR ada/15805
+	* gnat.dg/specs/access_constants.ads: New test.
+
 2007-12-07  Olivier Hainque  <hainque@adacore.com>
 
 	PR ada/34173
diff --git a/gcc/testsuite/gnat.dg/specs/access_constant.ads b/gcc/testsuite/gnat.dg/specs/access_constant.ads
new file mode 100644
index 00000000000..fa9829e8396
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/specs/access_constant.ads
@@ -0,0 +1,13 @@
+-- { dg-do compile }
+package Access_Constant is
+
+   c: aliased constant integer := 3;
+
+   type const_ptr is access constant integer;
+   cp : const_ptr := c'access;
+
+   procedure inc (var_ptr: access integer :=
+     cp)  -- { dg-error "access-to-constant" }
+      is abstract;
+
+end Access_Constant;