From: Ed Schonberg <schonberg@adacore.com>
Date: Wed, 6 Aug 2008 09:35:17 +0000 (+0200)
Subject: sem_ch3.adb (Access_Subprogram_Declaration): If the return type is incomplete...
X-Git-Tag: releases/gcc-4.4.0~3298
X-Git-Url: http://git.ipfire.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=49d8b8028170af3242cb705fe2fabf46697843c1;p=thirdparty%2Fgcc.git

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 00580bf570ae..bc16c08cb27b 100644
--- 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;