From: Arnaud Charlet Date: Mon, 8 Jul 2013 08:10:20 +0000 (+0200) Subject: [multiple changes] X-Git-Tag: releases/gcc-4.9.0~5094 X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=466c212744b8307eef2e40272ceda90e8fc12f97;p=thirdparty%2Fgcc.git [multiple changes] 2013-07-08 Ed Schonberg * exp_ch9.adb (Expand_N_Asynchronous_Select): If the trigger of the asynchronous select is a dispatching call, transform the abortable part into a procedure, to avoid duplication of local loop variables that may appear within. 2013-07-08 Vincent Celier * projects.texi: Update the documentation of suffixes in package Naming. 2013-07-08 Ed Schonberg * sem_ch6.adb (Conforming_Types): Anonymous_access_to_subprograsm types are type conformant if the designated type of one is protected and the other is not. Convention only matters when checking subtype conformance. 2013-07-08 Ed Schonberg * sem_res.adb (Make_Call_Into_Operator): In ASIS mode, propagate back the fully resolved operands to the original function call so that all semantic information remains available to ASIS. From-SVN: r200767 --- diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index f11eaa683337..a463f6a2b131 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,28 @@ +2013-07-08 Ed Schonberg + + * exp_ch9.adb (Expand_N_Asynchronous_Select): If the trigger + of the asynchronous select is a dispatching call, transform the + abortable part into a procedure, to avoid duplication of local + loop variables that may appear within. + +2013-07-08 Vincent Celier + + * projects.texi: Update the documentation of suffixes in package + Naming. + +2013-07-08 Ed Schonberg + + * sem_ch6.adb (Conforming_Types): Anonymous_access_to_subprograsm + types are type conformant if the designated type of one is + protected and the other is not. Convention only matters when + checking subtype conformance. + +2013-07-08 Ed Schonberg + + * sem_res.adb (Make_Call_Into_Operator): In ASIS mode, propagate + back the fully resolved operands to the original function call + so that all semantic information remains available to ASIS. + 2013-07-08 Ed Schonberg * sem_ch4.adb: minor reformatting (remove obsolete comment). diff --git a/gcc/ada/exp_ch9.adb b/gcc/ada/exp_ch9.adb index 59c5b2d62ce5..fdafd22a6d2d 100644 --- a/gcc/ada/exp_ch9.adb +++ b/gcc/ada/exp_ch9.adb @@ -6756,6 +6756,40 @@ package body Exp_Ch9 is S : Entity_Id; -- Primitive operation slot T : Entity_Id; -- Additional status flag + procedure Rewrite_Abortable_Part; + -- If the trigger is a dispatching call, the expansion inserts multiple + -- copies of the abortable part. This is both inefficient, and may lead + -- to duplicate definitions that the back-end will reject, when the + -- abortable part includes loops. This procedure rewrites the abortable + -- part into a call to a generated procedure. + + ---------------------------- + -- Rewrite_Abortable_Part -- + ---------------------------- + + procedure Rewrite_Abortable_Part is + Proc : constant Entity_Id := Make_Defining_Identifier (Loc, Name_uA); + Decl : Node_Id; + + begin + Decl := + Make_Subprogram_Body (Loc, + Specification => + Make_Procedure_Specification (Loc, Defining_Unit_Name => Proc), + Declarations => New_List, + Handled_Statement_Sequence => + Make_Handled_Sequence_Of_Statements (Loc, Astats)); + Insert_Before (N, Decl); + Analyze (Decl); + + -- Rewrite abortable part into a call to this procedure. + + Astats := + New_List ( + Make_Procedure_Call_Statement (Loc, + Name => New_Occurrence_Of (Proc, Loc))); + end Rewrite_Abortable_Part; + begin Process_Statements_For_Controlled_Objects (Trig); Process_Statements_For_Controlled_Objects (Abrt); @@ -6791,12 +6825,13 @@ package body Exp_Ch9 is if Ada_Version >= Ada_2005 and then (No (Original_Node (Ecall)) - or else not Nkind_In (Original_Node (Ecall), - N_Delay_Relative_Statement, - N_Delay_Until_Statement)) + or else not Nkind_In (Original_Node (Ecall), + N_Delay_Relative_Statement, + N_Delay_Until_Statement)) then Extract_Dispatching_Call (Ecall, Call_Ent, Obj, Actuals, Formals); + Rewrite_Abortable_Part; Decls := New_List; Stmts := New_List; @@ -6831,9 +6866,9 @@ package body Exp_Ch9 is Make_Object_Declaration (Loc, Defining_Identifier => Make_Defining_Identifier (Loc, Name_uD), - Object_Definition => - New_Reference_To ( - RTE (RE_Dummy_Communication_Block), Loc))); + Object_Definition => + New_Reference_To + (RTE (RE_Dummy_Communication_Block), Loc))); K := Build_K (Loc, Decls, Obj); @@ -6875,8 +6910,7 @@ package body Exp_Ch9 is Prepend_To (Cleanup_Stmts, Make_Assignment_Statement (Loc, - Name => - New_Reference_To (Bnn, Loc), + Name => New_Reference_To (Bnn, Loc), Expression => Make_Unchecked_Type_Conversion (Loc, Subtype_Mark => @@ -6889,10 +6923,10 @@ package body Exp_Ch9 is Prepend_To (Cleanup_Stmts, Make_Procedure_Call_Statement (Loc, Name => - New_Reference_To ( - Find_Prim_Op (Etype (Etype (Obj)), - Name_uDisp_Asynchronous_Select), - Loc), + New_Reference_To + (Find_Prim_Op + (Etype (Etype (Obj)), Name_uDisp_Asynchronous_Select), + Loc), Parameter_Associations => New_List ( New_Copy_Tree (Obj), -- @@ -7117,10 +7151,10 @@ package body Exp_Ch9 is Append_To (Conc_Typ_Stmts, Make_Procedure_Call_Statement (Loc, Name => - New_Reference_To ( - Find_Prim_Op (Etype (Etype (Obj)), - Name_uDisp_Get_Prim_Op_Kind), - Loc), + New_Reference_To + (Find_Prim_Op (Etype (Etype (Obj)), + Name_uDisp_Get_Prim_Op_Kind), + Loc), Parameter_Associations => New_List ( New_Copy_Tree (Obj), @@ -7240,11 +7274,11 @@ package body Exp_Ch9 is Abortable_Block := Make_Block_Statement (Loc, - Identifier => New_Reference_To (Blk_Ent, Loc), + Identifier => New_Reference_To (Blk_Ent, Loc), Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, Statements => Astats), - Has_Created_Identifier => True, + Has_Created_Identifier => True, Is_Asynchronous_Call_Block => True); -- Append call to if Enqueue (When, DB'Unchecked_Access) then @@ -7292,8 +7326,8 @@ package body Exp_Ch9 is Make_Object_Declaration (Loc, Defining_Identifier => Dblock_Ent, Aliased_Present => True, - Object_Definition => New_Reference_To ( - RTE (RE_Delay_Block), Loc))), + Object_Definition => + New_Reference_To (RTE (RE_Delay_Block), Loc))), Handled_Statement_Sequence => Make_Handled_Sequence_Of_Statements (Loc, Stmts))); @@ -7318,10 +7352,9 @@ package body Exp_Ch9 is Decl := First (Decls); while Present (Decl) - and then - (Nkind (Decl) /= N_Object_Declaration - or else not Is_RTE (Etype (Object_Definition (Decl)), - RE_Communication_Block)) + and then (Nkind (Decl) /= N_Object_Declaration + or else not Is_RTE (Etype (Object_Definition (Decl)), + RE_Communication_Block)) loop Next (Decl); end loop; @@ -7338,13 +7371,12 @@ package body Exp_Ch9 is -- Mode => Asynchronous_Call; -- Block => Bnn); - Stmt := First (Stmts); - -- Skip assignments to temporaries created for in-out parameters -- This makes unwarranted assumptions about the shape of the expanded -- tree for the call, and should be cleaned up ??? + Stmt := First (Stmts); while Nkind (Stmt) /= N_Procedure_Call_Statement loop Next (Stmt); end loop; diff --git a/gcc/ada/projects.texi b/gcc/ada/projects.texi index 2c334686b545..7072e0e6ada5 100644 --- a/gcc/ada/projects.texi +++ b/gcc/ada/projects.texi @@ -926,16 +926,21 @@ The following attributes can be defined in package @code{Naming}: that contain declaration (header files in C for instance). The attribute is indexed on the language. The two attributes are equivalent, but the latter is obsolescent. + + If the value of the attribute is the empty string, it indicates to the + Project Manager that the only specifications/header files for the language + are those specified with attributes @code{Spec} or + @code{Specification_Exceptions}. + If @code{Spec_Suffix ("Ada")} is not specified, then the default is @code{"^.ads^.ADS^"}. - The value must satisfy the following requirements: + + A non empty value must satisfy the following requirements: @itemize - - @item It must not be empty - @item It cannot start with an alphanumeric character - @item It cannot start with an underscore followed by an alphanumeric character @item It must include at least one dot - + @item If @code{Dot_Replacement} is a single dot, then it cannot include + more than one dot. @end itemize @item @b{Body_Suffix} and @b{Implementation_Suffix}: @@ -945,6 +950,14 @@ The following attributes can be defined in package @code{Naming}: code (bodies in Ada). They are indexed on the language. The second version is obsolescent and fully replaced by the first attribute. + For each language of a project, one of these two attributes need to be + specified, either in the project itself or in the configuration project file. + + If the value of the attribute is the empty string, it indicates to the + Project Manager that the only source files for the language + are those specified with attributes @code{Body} or + @code{Implementation_Exceptions}. + These attributes must satisfy the same requirements as @code{Spec_Suffix}. In addition, they must be different from any of the values in @code{Spec_Suffix}. @@ -956,10 +969,10 @@ The following attributes can be defined in package @code{Naming}: suffixes will be a body if the longest suffix is @code{Body_Suffix ("Ada")} or a spec if the longest suffix is @code{Spec_Suffix ("Ada")}. - If the suffix does not start with a '.', a file with a name exactly equal - to the suffix will also be part of the project (for instance if you define - the suffix as @code{Makefile}, a file called @file{Makefile} will be part - of the project. This capability is usually not interesting when building. + If the suffix does not start with a '.', a file with a name exactly equal to + the suffix will also be part of the project (for instance if you define the + suffix as @code{Makefile.in}, a file called @file{Makefile.in} will be part + of the project. This capability is usually not interesting when building. However, it might become useful when a project is also used to find the list of source files in an editor, like the GNAT Programming System (GPS). @@ -968,7 +981,11 @@ The following attributes can be defined in package @code{Naming}: @cindex @code{Separate_Suffix} This attribute is specific to Ada. It denotes the suffix used in file names that contain separate bodies. If it is not specified, then it defaults to - same value as @code{Body_Suffix ("Ada")}. The same rules apply as for the + same value as @code{Body_Suffix ("Ada")}. + + The value of this attribute cannot be the empty string. + + Otherwise, the same rules apply as for the @code{Body_Suffix} attribute. The only accepted index is "Ada". @item @b{Spec} or @b{Specification}: diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 68edadfafd7f..57712d83d9cb 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -2789,11 +2789,11 @@ package body Sem_Ch6 is and then (Nkind (Original_Node (Spec_Decl)) = N_Subprogram_Renaming_Declaration - or else (Present (Corresponding_Body (Spec_Decl)) - and then - Nkind (Unit_Declaration_Node - (Corresponding_Body (Spec_Decl))) = - N_Subprogram_Renaming_Declaration)) + or else (Present (Corresponding_Body (Spec_Decl)) + and then + Nkind (Unit_Declaration_Node + (Corresponding_Body (Spec_Decl))) = + N_Subprogram_Renaming_Declaration)) then Conformant := True; @@ -7663,13 +7663,16 @@ package body Sem_Ch6 is end if; -- Ada 2005 (AI-254): Anonymous access-to-subprogram types must be - -- treated recursively because they carry a signature. + -- treated recursively because they carry a signature. As far as + -- conformance is concerned, convention plays no role, and either + -- or both could be access to protected subprograms. Are_Anonymous_Access_To_Subprogram_Types := - Ekind (Type_1) = Ekind (Type_2) + Ekind_In (Type_1, E_Anonymous_Access_Subprogram_Type, + E_Anonymous_Access_Protected_Subprogram_Type) and then - Ekind_In (Type_1, E_Anonymous_Access_Subprogram_Type, - E_Anonymous_Access_Protected_Subprogram_Type); + Ekind_In (Type_2, E_Anonymous_Access_Subprogram_Type, + E_Anonymous_Access_Protected_Subprogram_Type); -- Test anonymous access type case. For this case, static subtype -- matching is required for mode conformance (RM 6.3.1(15)). We check diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index 95cc437224c0..9b26f096f884 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -1576,6 +1576,22 @@ package body Sem_Res is else Resolve (N, Typ); end if; + + -- If in ASIS_Mode, propagate operand types to original actuals of + -- function call, which would otherwise not be fully resolved. + + if ASIS_Mode then + if Is_Binary then + Set_Parameter_Associations + (Original_Node (N), + New_List (New_Copy_Tree (Left_Opnd (N)), + New_Copy_Tree (Right_Opnd (N)))); + else + Set_Parameter_Associations + (Original_Node (N), + New_List (New_Copy_Tree (Right_Opnd (N)))); + end if; + end if; end Make_Call_Into_Operator; -------------------