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

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

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.

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

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;