sem_ch3.adb (Access_Subprogram_Declaration): If the return type is incomplete...

2008-08-06  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Access_Subprogram_Declaration): If the return type is
	incomplete, add the access_to_subprogram type to the list of private
	dependents only if the incomplete type will be completed in the current
	scope.
	(Build_Discriminant_Constraints): If the type of the discriminant is
	access_to_variable, reject a constraint that is access_to_constant.

From-SVN: r138784

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 00580bf..bc16c08 100644 (file)
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -1179,8 +1179,13 @@ package body Sem_Ch3 is
          end loop;
       end if;
 
+      --  If the return type is incomplete, this is legal as long as the
+      --  type is declared in the current scope and will be completed in
+      --  it (rather than being part of limited view).
+
       if Ekind (Etype (Desig_Type)) = E_Incomplete_Type
         and then not Has_Delayed_Freeze (Desig_Type)
+        and then In_Open_Scopes (Scope (Etype (Desig_Type)))
       then
          Append_Elmt (Desig_Type, Private_Dependents (Etype (Desig_Type)));
          Set_Has_Delayed_Freeze (Desig_Type);
@@ -2567,7 +2572,7 @@ package body Sem_Ch3 is
            and then Is_Access_Constant (Etype (E))
          then
             Error_Msg_N
-              ("object that is an access to variable cannot be initialized " &
+              ("access to variable cannot be initialized " &
                 "with an access-to-constant expression", E);
          end if;
 
@@ -7622,6 +7627,15 @@ package body Sem_Ch3 is
                          (Designated_Type (Etype (Discr_Expr (J))))
             then
                Wrong_Type (Discr_Expr (J), Etype (Discr));
+
+            elsif Is_Access_Type (Etype (Discr))
+              and then not Is_Access_Constant (Etype (Discr))
+              and then Is_Access_Type (Etype (Discr_Expr (J)))
+              and then Is_Access_Constant (Etype (Discr_Expr (J)))
+            then
+               Error_Msg_NE
+                 ("constraint for discriminant& must be access to variable",
+                    Def, Discr);
             end if;
          end if;