Re: [PATCH] ada: An access to non-constant cannot cover an access to constant

[Samuel Tardieu <sam at rfc1149 dot net>]

>>>>> "Ed" == Edmond Schonberg <schonberg@adacore.com> writes:

Ed> Alternatively, you could emit the error message right there, as is
Ed> done for (the implicit conversions related to) access actuals:

Do those look ok?

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 5c61d00..c16b406 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -2364,6 +2364,20 @@ package body Sem_Ch3 is
 
          Set_Is_True_Constant (Id, True);
 
+         --  If the initialization expression is an access to constant,
+         --  it cannot be used with an access type.
+
+         if Is_Access_Type (Etype (E))
+           and then Is_Access_Constant (Etype (E))
+           and then Is_Access_Type (T)
+           and then not Is_Access_Constant (T)
+         then
+            Error_Msg_NE ("object of type& cannot be initialized with " &
+                          "an access-to-constant expression",
+                          E,
+                          T);
+         end if;
+
          --  If we are analyzing a constant declaration, set its completion
          --  flag after analyzing the expression.
 
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 3d77135..803589f 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.