2007-12-19 Ed Schonberg <schonberg@adacore.com>

	    Gary Dismukes  <dismukes@adacore.com>

	PR ada/15803, ada/15805
	* sem_ch6.adb, sem_ch3.adb (Constrain_Access): In Ada2005, diagnose
	illegal access subtypes when there is a constrained partial view.
	(Check_For_Premature_Usage): New procedure inside
	Access_Subprogram_Declaration for checking that an access-to-subprogram
	type doesn't reference its own name within any formal parameters or
	result type (including within nested anonymous access types).
	(Access_Subprogram_Declaration): Add call to Check_For_Premature_Usage.
	(Sem_Ch3.Analyze_Object_Declaration, Sem_ch6.Process_Formals): if the
	context is an access_to_variable, the expression cannot be an
	access_to_constant.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@131079 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index b34132a..920b149 100644 (file)
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -917,13 +917,66 @@ package body Sem_Ch3 is
      (T_Name : Entity_Id;
       T_Def  : Node_Id)
    is
-      Formals : constant List_Id := Parameter_Specifications (T_Def);
-      Formal  : Entity_Id;
-      D_Ityp  : Node_Id;
 
+      procedure Check_For_Premature_Usage (Def : Node_Id);
+      --  Check that type T_Name is not used, directly or recursively,
+      --  as a parameter or a return type in Def. Def is either a subtype,
+      --  an access_definition, or an access_to_subprogram_definition.
+
+      -------------------------------
+      -- Check_For_Premature_Usage --
+      -------------------------------
+
+      procedure Check_For_Premature_Usage (Def : Node_Id) is
+         Param : Node_Id;
+
+      begin
+         --  Check for a subtype mark
+
+         if Nkind (Def) in N_Has_Etype then
+            if Etype (Def) = T_Name then
+               Error_Msg_N
+                 ("type& cannot be used before end of its declaration", Def);
+            end if;
+
+         --  If this is not a subtype, then this is an access_definition
+
+         elsif Nkind (Def) = N_Access_Definition then
+            if Present (Access_To_Subprogram_Definition (Def)) then
+               Check_For_Premature_Usage
+                 (Access_To_Subprogram_Definition (Def));
+            else
+               Check_For_Premature_Usage (Subtype_Mark (Def));
+            end if;
+
+         --  The only cases left are N_Access_Function_Definition and
+         --  N_Access_Procedure_Definition.
+
+         else
+            if Present (Parameter_Specifications (Def)) then
+               Param := First (Parameter_Specifications (Def));
+               while Present (Param) loop
+                  Check_For_Premature_Usage (Parameter_Type (Param));
+                  Param := Next (Param);
+               end loop;
+            end if;
+
+            if Nkind (Def) = N_Access_Function_Definition then
+               Check_For_Premature_Usage (Result_Definition (Def));
+            end if;
+         end if;
+      end Check_For_Premature_Usage;
+
+      --  Local variables
+
+      Formals    : constant List_Id := Parameter_Specifications (T_Def);
+      Formal     : Entity_Id;
+      D_Ityp     : Node_Id;
       Desig_Type : constant Entity_Id :=
                      Create_Itype (E_Subprogram_Type, Parent (T_Def));
 
+   --  Start of processing for Access_Subprogram_Declaration
+
    begin
       --  Associate the Itype node with the inner full-type declaration or
       --  subprogram spec. This is required to handle nested anonymous
@@ -1018,6 +1071,10 @@ package body Sem_Ch3 is
          Set_Parent (Desig_Type, Empty);
       end if;
 
+      --  Check for premature usage of the type being defined
+
+      Check_For_Premature_Usage (T_Def);
+
       --  The return type and/or any parameter type may be incomplete. Mark
       --  the subprogram_type as depending on the incomplete type, so that
       --  it can be updated when the full type declaration is seen. This
@@ -2355,7 +2412,7 @@ package body Sem_Ch3 is
          Analyze (E);
 
          --  In case of errors detected in the analysis of the expression,
-         --  decorate it with the expected type to avoid cascade errors
+         --  decorate it with the expected type to avoid cascaded errors
 
          if No (Etype (E)) then
             Set_Etype (E, T);
@@ -2367,18 +2424,17 @@ 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 the object is an access to variable, the initialization
+         --  expression cannot be an access to constant.
 
-         if Is_Access_Type (Etype (E))
-           and then Is_Access_Constant (Etype (E))
-           and then Is_Access_Type (T)
+         if Is_Access_Type (T)
            and then not Is_Access_Constant (T)
+           and then Is_Access_Type (Etype (E))
+           and then Is_Access_Constant (Etype (E))
          then
-            Error_Msg_NE ("object of type& cannot be initialized with " &
-                          "an access-to-constant expression",
-                          E,
-                          T);
+            Error_Msg_N
+              ("object that is an access to variable cannot be initialized " &
+                "with an access-to-constant expression", E);
          end if;
 
          --  If we are analyzing a constant declaration, set its completion
@@ -8999,9 +9055,11 @@ package body Sem_Ch3 is
             return;
          end if;
 
-         if Ekind (T) = E_General_Access_Type
+         if (Ekind (T) = E_General_Access_Type
+              or else Ada_Version >= Ada_05)
            and then Has_Private_Declaration (Desig_Type)
            and then In_Open_Scopes (Scope (Desig_Type))
+           and then Has_Discriminants (Desig_Type)
          then
             --  Enforce rule that the constraint is illegal if there is
             --  an unconstrained view of the designated type. This means
@@ -9012,7 +9070,8 @@ package body Sem_Ch3 is
 
             --  Rule updated for Ada 2005: the private type is said to have
             --  a constrained partial view, given that objects of the type
-            --  can be declared.
+            --  can be declared. Furthermore, the rule applies to all access
+            --  types, unlike the rule concerning default discriminants.
 
             declare
                Pack  : constant Node_Id :=

diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 5f51369..9aaa37f 100644 (file)
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -6996,18 +6996,17 @@ 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.
+            --  An access to constant cannot be the default for
+            --  an access parameter that is an access to variable.
 
             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);
+               Error_Msg_N
+                 ("formal that is access to variable cannot be initialized " &
+                    "with an access-to-constant expression", Default);
             end if;
 
             --  Check that the designated type of an access parameter's default