2011-12-05 Basile Starynkevitch <basile@starynkevitch.net>

	MELT branch merged with trunk rev 182001 using svnmerge



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/melt-branch@182003 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 37 insertions, 18 deletions

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 5cc06e7d899..e7b5327c430 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -9526,6 +9526,7 @@ package body Sem_Ch3 is
          --  In case of previous errors, other expansion actions that provide
          --  bodies for null procedures with not be invoked, so inhibit message
          --  in those cases.
+
          --  Note that E_Operator is not in the list that follows, because
          --  this kind is reserved for predefined operators, that are
          --  intrinsic and do not need completion.
@@ -9583,8 +9584,11 @@ package body Sem_Ch3 is
                May_Need_Implicit_Body (E);
             end if;
 
+         --  Comment needed here for Is_Generic_Type test ???
+
          elsif Ekind (E) = E_Incomplete_Type
            and then No (Underlying_Type (E))
+           and then not Is_Generic_Type (E)
          then
             Post_Error;
 
@@ -9704,9 +9708,25 @@ package body Sem_Ch3 is
                  ("?cannot initialize entities of limited type!", Exp);
 
             elsif Ada_Version < Ada_2005 then
-               Error_Msg_N
-                 ("cannot initialize entities of limited type", Exp);
-               Explain_Limited_Type (T, Exp);
+
+               --  The side effect removal machinery may generate illegal Ada
+               --  code to avoid the usage of access types and 'reference in
+               --  Alfa mode. Since this is legal code with respect to theorem
+               --  proving, do not emit the error.
+
+               if Alfa_Mode
+                 and then Nkind (Exp) = N_Function_Call
+                 and then Nkind (Parent (Exp)) = N_Object_Declaration
+                 and then not Comes_From_Source
+                                (Defining_Identifier (Parent (Exp)))
+               then
+                  null;
+
+               else
+                  Error_Msg_N
+                    ("cannot initialize entities of limited type", Exp);
+                  Explain_Limited_Type (T, Exp);
+               end if;
 
             else
                --  Specialize error message according to kind of illegal
@@ -10674,24 +10694,24 @@ package body Sem_Ch3 is
             return;
          end if;
 
+         --  Enforce rule that the constraint is illegal if there is an
+         --  unconstrained view of the designated type. This means that the
+         --  partial view (either a private type declaration or a derivation
+         --  from a private type) has no discriminants. (Defect Report
+         --  8652/0008, Technical Corrigendum 1, checked by ACATS B371001).
+
+         --  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. Furthermore, the rule applies to all access
+         --  types, unlike the rule concerning default discriminants (see
+         --  RM 3.7.1(7/3))
+
          if (Ekind (T) = E_General_Access_Type
               or else Ada_Version >= Ada_2005)
            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
-            --  that the partial view (either a private type declaration or
-            --  a derivation from a private type) has no discriminants.
-            --  (Defect Report 8652/0008, Technical Corrigendum 1, checked
-            --  by ACATS B371001).
-
-            --  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. Furthermore, the rule applies to all access
-            --  types, unlike the rule concerning default discriminants.
-
             declare
                Pack  : constant Node_Id :=
                          Unit_Declaration_Node (Scope (Desig_Type));
@@ -10719,9 +10739,8 @@ package body Sem_Ch3 is
                      then
                         if No (Discriminant_Specifications (Decl)) then
                            Error_Msg_N
-                            ("cannot constrain general access type if " &
-                               "designated type has constrained partial view",
-                                S);
+                            ("cannot constrain access type if designated " &
+                               "type has constrained partial view", S);
                         end if;
 
                         exit;