[multiple changes]

2010-10-11  Javier Miranda  <miranda@adacore.com>

	* exp_ch6.adb (Expand_Call): For VM platforms, add missing expansion of
	tag check in case of dispatching call through "=".

2010-10-11  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Access_Subprogram_Declaration): In Ada2012 an incomplete
	type is legal in the profile of any basic declaration.
	* sem_ch6.adb (Analyze_Return_Type, Process_Formals): In Ada2012 an
	incomplete type, including a limited view of a type, is legal in the
	profile of any subprogram declaration.
	If the type is tagged, its use is also legal in a body.
	* sem_ch10.adb (Install_Limited_With_Clause): Do not process context
	item if misplaced.
	(Install_Limited_Withed_Unit): Refine legality checks when both the
	limited and the non-limited view of a package are visible in the context
	of a unit.
	If this is not an error case, the limited view is ignored.
	freeze.adb (Freeze_Entity): In Ada2012, an incomplete type is legal in
	access to subprogram declarations

From-SVN: r165295

6 files changed, 202 insertions, 22 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 01e0625..9260f78 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,25 @@
+2010-10-11  Javier Miranda  <miranda@adacore.com>
+
+	* exp_ch6.adb (Expand_Call): For VM platforms, add missing expansion of
+	tag check in case of dispatching call through "=".
+
+2010-10-11  Ed Schonberg  <schonberg@adacore.com>
+
+	* sem_ch3.adb (Access_Subprogram_Declaration): In Ada2012 an incomplete
+	type is legal in the profile of any basic declaration.
+	* sem_ch6.adb (Analyze_Return_Type, Process_Formals): In Ada2012 an
+	incomplete type, including a limited view of a type, is legal in the
+	profile of any subprogram declaration.
+	If the type is tagged, its use is also legal in a body.
+	* sem_ch10.adb (Install_Limited_With_Clause): Do not process context
+	item if misplaced.
+	(Install_Limited_Withed_Unit): Refine legality checks when both the
+	limited and the non-limited view of a package are visible in the context
+	of a unit.
+	If this is not an error case, the limited view is ignored.
+	freeze.adb (Freeze_Entity): In Ada2012, an incomplete type is legal in
+	access to subprogram declarations
+
 2010-10-11  Robert Dewar  <dewar@adacore.com>
 
 	* exp_ch6.adb: Code clean up.
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 2ffa9f7..1fe1eca 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -137,7 +137,7 @@ package body Exp_Ch6 is
    --  access type. If the function call is the initialization expression for a
    --  return object, we pass along the master passed in by the caller. The
    --  activation chain to pass is always the local one. Note: Master_Actual
-   --  can be Empty, but only if there are no tasks
+   --  can be Empty, but only if there are no tasks.
 
    procedure Check_Overriding_Operation (Subp : Entity_Id);
    --  Subp is a dispatching operation. Check whether it may override an
@@ -1779,6 +1779,11 @@ package body Exp_Ch6 is
       --  convoluted tree traversal before setting the proper subprogram to be
       --  called.
 
+      function New_Value (From : Node_Id) return Node_Id;
+      --  From is the original Expression. New_Value is equivalent to a call
+      --  to Duplicate_Subexpr with an explicit dereference when From is an
+      --  access parameter.
+
       --------------------------
       -- Add_Actual_Parameter --
       --------------------------
@@ -1942,6 +1947,22 @@ package body Exp_Ch6 is
          raise Program_Error;
       end Inherited_From_Formal;
 
+      ---------------
+      -- New_Value --
+      ---------------
+
+      function New_Value (From : Node_Id) return Node_Id is
+         Res : constant Node_Id := Duplicate_Subexpr (From);
+      begin
+         if Is_Access_Type (Etype (From)) then
+            return
+              Make_Explicit_Dereference (Sloc (From),
+                Prefix => Res);
+         else
+            return Res;
+         end if;
+      end New_Value;
+
       --  Local variables
 
       Remote        : constant Boolean := Is_Remote_Call (Call_Node);
@@ -2652,8 +2673,12 @@ package body Exp_Ch6 is
         and then Present (Controlling_Argument (Call_Node))
       then
          declare
+            Call_Typ   : constant Entity_Id := Etype (Call_Node);
             Typ        : constant Entity_Id := Find_Dispatching_Type (Subp);
             Eq_Prim_Op : Entity_Id := Empty;
+            New_Call   : Node_Id;
+            Param      : Node_Id;
+            Prev_Call  : Node_Id;
 
          begin
             if not Is_Limited_Type (Typ) then
@@ -2673,6 +2698,45 @@ package body Exp_Ch6 is
             else
                Apply_Tag_Checks (Call_Node);
 
+               --  If this is a dispatching "=", we must first compare the
+               --  tags so we generate: x.tag = y.tag and then x = y
+
+               if Subp = Eq_Prim_Op then
+
+                  --  Mark the node as analyzed to avoid reanalizing this
+                  --  dispatching call (which would cause a never-ending loop)
+
+                  Prev_Call := Relocate_Node (Call_Node);
+                  Set_Analyzed (Prev_Call);
+
+                  Param := First_Actual (Call_Node);
+                  New_Call :=
+                    Make_And_Then (Loc,
+                      Left_Opnd =>
+                           Make_Op_Eq (Loc,
+                             Left_Opnd =>
+                               Make_Selected_Component (Loc,
+                                 Prefix        => New_Value (Param),
+                                 Selector_Name =>
+                                   New_Reference_To (First_Tag_Component (Typ),
+                                                     Loc)),
+
+                             Right_Opnd =>
+                               Make_Selected_Component (Loc,
+                                 Prefix        =>
+                                   Unchecked_Convert_To (Typ,
+                                     New_Value (Next_Actual (Param))),
+                                 Selector_Name =>
+                                   New_Reference_To
+                                     (First_Tag_Component (Typ), Loc))),
+                      Right_Opnd => Prev_Call);
+
+                  Rewrite (Call_Node, New_Call);
+
+                  Analyze_And_Resolve
+                    (Call_Node, Call_Typ, Suppress => All_Checks);
+               end if;
+
                --  Expansion of a dispatching call results in an indirect call,
                --  which in turn causes current values to be killed (see
                --  Resolve_Call), so on VM targets we do the call here to
@@ -2685,9 +2749,7 @@ package body Exp_Ch6 is
             --  to the call node because we generated:
             --     x.tag = y.tag and then x = y
 
-            if Subp = Eq_Prim_Op
-              and then Nkind (Call_Node) = N_Op_And
-            then
+            if Subp = Eq_Prim_Op then
                Call_Node := Right_Opnd (Call_Node);
             end if;
          end;
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb
index b21ee15..c807220 100644
--- a/gcc/ada/freeze.adb
+++ b/gcc/ada/freeze.adb
@@ -3738,7 +3738,11 @@ package body Freeze is
                then
                   if Is_Tagged_Type (Etype (Formal)) then
                      null;
-                  else
+
+                  --  AI05-151 : incomplete types are allowed in access to
+                  --  subprogram specifications.
+
+                  elsif Ada_Version < Ada_2012 then
                      Error_Msg_NE
                        ("invalid use of incomplete type&", E, Etype (Formal));
                   end if;
diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index 0f7e1ab..3e73151 100644
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -3726,6 +3726,7 @@ package body Sem_Ch10 is
       while Present (Item) loop
          if Nkind (Item) = N_With_Clause
            and then Limited_Present (Item)
+           and then not Error_Posted (Item)
          then
             if Nkind (Name (Item)) = N_Selected_Component then
                Expand_Limited_With_Clause
@@ -4703,7 +4704,49 @@ package body Sem_Ch10 is
           (Is_Immediately_Visible (P)
             or else (Is_Child_Package and then Is_Visible_Child_Unit (P)))
       then
-         return;
+
+         --  The presence of both the limited and the analyzed nonlimited view
+         --  may also be an error, such as an illegal context for a limited
+         --  with_clause. In that case, do not process the context item at all.
+
+         if Error_Posted (N) then
+            return;
+         end if;
+
+         if Nkind (Unit (Cunit (Current_Sem_Unit))) = N_Package_Body then
+            declare
+               Item : Node_Id;
+            begin
+               Item := First (Context_Items (Cunit (Current_Sem_Unit)));
+               while Present (Item) loop
+                  if Nkind (Item) = N_With_Clause
+                    and then Comes_From_Source (Item)
+                    and then Entity (Name (Item)) = P
+                  then
+                     return;
+                  end if;
+
+                  Next (Item);
+               end loop;
+            end;
+
+            --  If this is a child body, assume that the nonlimited with_clause
+            --  appears in an ancestor. Could be refined ???
+
+            if Is_Child_Unit
+              (Defining_Entity
+                 (Unit (Library_Unit (Cunit (Current_Sem_Unit)))))
+            then
+               return;
+            end if;
+
+         else
+
+            --  If in package declaration, nonlimited view brought in from
+            --  parent unit or some error condition.
+
+            return;
+         end if;
       end if;
 
       if Debug_Flag_I then
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 29f28b0..5445740 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -1112,9 +1112,18 @@ package body Sem_Ch3 is
 
                else
                   if From_With_Type (Typ) then
-                     Error_Msg_NE
-                      ("illegal use of incomplete type&",
-                         Result_Definition (T_Def), Typ);
+
+                     --  AI05-151 : incomplete types are allowed in all basic
+                     --  declarations, including access to subprograms.
+
+                     if Ada_Version >= Ada_2012 then
+                        null;
+
+                     else
+                        Error_Msg_NE
+                         ("illegal use of incomplete type&",
+                            Result_Definition (T_Def), Typ);
+                     end if;
 
                   elsif Ekind (Current_Scope) = E_Package
                     and then In_Private_Part (Current_Scope)
@@ -7037,7 +7046,7 @@ package body Sem_Ch3 is
 
          Check_Or_Process_Discriminants (N, Derived_Type);
 
-         --  For non-tagged types the constraint on the Parent_Type must be
+         --  For untagged types, the constraint on the Parent_Type must be
          --  present and is used to rename the discriminants.
 
          if not Is_Tagged and then not Has_Discriminants (Parent_Type) then
@@ -13179,7 +13188,7 @@ package body Sem_Ch3 is
       end if;
 
       --  Final check: Direct descendants must have their primitives in the
-      --  same order. We exclude from this test non-tagged types and instances
+      --  same order. We exclude from this test untagged types and instances
       --  of formal derived types. We skip this test if we have already
       --  reported serious errors in the sources.
 
@@ -16180,9 +16189,9 @@ package body Sem_Ch3 is
                  ("discriminant defaults not allowed for formal type",
                   Expression (Discr));
 
-            --  Tagged types cannot have defaulted discriminants, but a
-            --  non-tagged private type with defaulted discriminants
-            --   can have a tagged completion.
+            --  Tagged types declarations cannot have defaulted discriminants,
+            --  but an untagged private type with defaulted discriminants can
+            --  have a tagged completion.
 
             elsif Is_Tagged_Type (Current_Scope)
               and then Comes_From_Source (N)
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index f106141..9b77577 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -1432,8 +1432,27 @@ package body Sem_Ch6 is
                          and then
                            Ekind (Root_Type (Typ)) = E_Incomplete_Type)
             then
-               Error_Msg_NE
-                 ("invalid use of incomplete type&", Designator, Typ);
+               --  AI05-0151: Tagged incomplete types are allowed in all formal
+               --  parts. Untagged incomplete types are not allowed in bodies.
+
+               if Ada_Version >= Ada_2012 then
+                  if Is_Tagged_Type (Typ) then
+                     null;
+
+                  elsif Nkind_In (Parent (Parent (N)),
+                     N_Accept_Statement,
+                     N_Entry_Body,
+                     N_Subprogram_Body)
+                  then
+                     Error_Msg_NE
+                       ("invalid use of untagged incomplete type&",
+                          Designator, Typ);
+                  end if;
+
+               else
+                  Error_Msg_NE
+                    ("invalid use of incomplete type&", Designator, Typ);
+               end if;
             end if;
          end if;
 
@@ -8306,13 +8325,34 @@ package body Sem_Ch6 is
                elsif not Nkind_In (Parent (T), N_Access_Function_Definition,
                                                N_Access_Procedure_Definition)
                then
-                  Error_Msg_NE
-                    ("invalid use of incomplete type&",
-                       Param_Spec, Formal_Type);
 
-                  --  Further checks on the legality of incomplete types
-                  --  in formal parts must be delayed until the freeze point
-                  --  of the enclosing subprogram or access to subprogram.
+                  --  AI05-0151: Tagged incomplete types are allowed in all
+                  --  formal parts. Untagged incomplete types are not allowed
+                  --  in bodies.
+
+                  if Ada_Version >= Ada_2012 then
+                     if Is_Tagged_Type (Formal_Type) then
+                        null;
+
+                     elsif Nkind_In (Parent (Parent (T)),
+                        N_Accept_Statement,
+                        N_Entry_Body,
+                        N_Subprogram_Body)
+                     then
+                        Error_Msg_NE
+                          ("invalid use of untagged incomplete type&",
+                             Ptype, Formal_Type);
+                     end if;
+
+                  else
+                     Error_Msg_NE
+                       ("invalid use of incomplete type&",
+                          Param_Spec, Formal_Type);
+
+                     --  Further checks on the legality of incomplete types
+                     --  in formal parts are delayed until the freeze point
+                     --  of the enclosing subprogram or access to subprogram.
+                  end if;
                end if;
 
             elsif Ekind (Formal_Type) = E_Void then