From: Arnaud Charlet Date: Mon, 11 Oct 2010 10:13:26 +0000 (+0200) Subject: [multiple changes] X-Git-Tag: releases/gcc-4.6.0~3648 X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=dd386db05d50b7147c1832e242590baf96c5ebae;p=thirdparty%2Fgcc.git [multiple changes] 2010-10-11 Javier Miranda * 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 * 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 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 01e062514fc8..9260f78fcd89 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,25 @@ +2010-10-11 Javier Miranda + + * 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 + + * 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 * exp_ch6.adb: Code clean up. diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 2ffa9f7906c4..1fe1eca0000b 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 b21ee15b0db7..c80722005915 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 0f7e1abb3f28..3e73151a402c 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 29f28b002375..54457405070a 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 f106141968f7..9b77577e7aae 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