From d4316989652a3308305b9cd873a95269a4583ec1 Mon Sep 17 00:00:00 2001 From: charlet Date: Fri, 31 Oct 2014 11:02:55 +0000 Subject: [PATCH] 2014-10-31 Ed Schonberg * freeze.adb (Freeze_Record_Type): Do not check component size if its type is generic. 2014-10-31 Bob Duff * gnat_rm.texi: Fix documentation w.r.t -gnatw.w. 2014-10-31 Ed Schonberg * sem_ch4.adb (Try_Container_Indexing): Use Check_Implicit_Dereference. * sem_util.adb (Check_Implicit_Dereference): a) Handle generalized indexing as well as function calls. b) If the context is a selected component and whe are in an instance, remove entity from selector name to force resolution of the node, so that explicit dereferences can be generated in the instance if they were in the generic unit. 2014-10-31 Eric Botcazou * inline.adb (Back_End_Cannot_Inline): Delete. (Add_Inlined_Subprogram): Do not call it. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@216956 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 24 ++++++++++++++++ gcc/ada/freeze.adb | 8 ++++++ gcc/ada/gnat_rm.texi | 14 ++++++---- gcc/ada/inline.adb | 78 ++++------------------------------------------------ gcc/ada/sem_ch4.adb | 30 ++------------------ gcc/ada/sem_util.adb | 46 +++++++++++++++++++++++++++++-- gcc/ada/sem_util.ads | 6 ++-- 7 files changed, 96 insertions(+), 110 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 4a6b6591854..7b9be963e39 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,5 +1,29 @@ 2014-10-31 Ed Schonberg + * freeze.adb (Freeze_Record_Type): Do not check component size + if its type is generic. + +2014-10-31 Bob Duff + + * gnat_rm.texi: Fix documentation w.r.t -gnatw.w. + +2014-10-31 Ed Schonberg + + * sem_ch4.adb (Try_Container_Indexing): Use Check_Implicit_Dereference. + * sem_util.adb (Check_Implicit_Dereference): a) Handle generalized + indexing as well as function calls. b) If the context is a + selected component and whe are in an instance, remove entity from + selector name to force resolution of the node, so that explicit + dereferences can be generated in the instance if they were in + the generic unit. + +2014-10-31 Eric Botcazou + + * inline.adb (Back_End_Cannot_Inline): Delete. + (Add_Inlined_Subprogram): Do not call it. + +2014-10-31 Ed Schonberg + * exp_ch3.ads (Make_Tag_Assignment): New function, used to re-initialize the tag in a tagged object declaration with initial value. diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 330ba5ddd00..bccec208e45 100644 --- a/gcc/ada/freeze.adb +++ b/gcc/ada/freeze.adb @@ -3356,6 +3356,14 @@ package body Freeze is elsif CodePeer_Mode then null; + -- Omit check if component has a generic type. This can + -- happen in an instantiation within a generic in ASIS + -- mode, where we force freeze actions without full + -- expansion. + + elsif Is_Generic_Type (Etype (Comp)) then + null; + -- Do the check elsif not diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index fa2d9421aaf..e7bd8bf489c 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -7974,14 +7974,16 @@ pragma Warnings (On, Pattern); @end smallexample @noindent -In this usage, the pattern string must match in the Off and On pragmas, -and at least one matching warning must be suppressed. +In this usage, the pattern string must match in the Off and On +pragmas, and (if @option{-gnatw.w} is given) at least one matching +warning must be suppressed. Note: to write a string that will match any warning, use the string -@code{"***"}. It will not work to use a single asterisk or two asterisks -since this looks like an operator name. This form with three asterisks -is similar in effect to specifying @code{pragma Warnings (Off)} except that a -matching @code{pragma Warnings (On, "***")} will be required. This can be +@code{"***"}. It will not work to use a single asterisk or two +asterisks since this looks like an operator name. This form with three +asterisks is similar in effect to specifying @code{pragma Warnings +(Off)} except (if @option{-gnatw.w} is given) that a matching +@code{pragma Warnings (On, "***")} will be required. This can be helpful in avoiding forgetting to turn warnings back on. Note: the debug flag -gnatd.i (@code{/NOWARNINGS_PRAGMAS} in VMS) can be diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index 8e2df38468f..0b9427742f3 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -445,20 +445,6 @@ package body Inline is E : constant Entity_Id := Inlined.Table (Index).Name; Pack : constant Entity_Id := Get_Code_Unit_Entity (E); - function Back_End_Cannot_Inline (Subp : Entity_Id) return Boolean; - -- There are various conditions under which back-end inlining cannot - -- be done reliably: - -- - -- a) If a body has handlers, it must not be inlined, because this - -- may violate program semantics, and because in zero-cost exception - -- mode it will lead to undefined symbols at link time. - -- - -- b) If a body contains inlined function instances, it cannot be - -- inlined under ZCX because the numeric suffix generated by gigi - -- will be different in the body and the place of the inlined call. - -- - -- This procedure must be carefully coordinated with the back end. - procedure Register_Backend_Inlined_Subprogram (Subp : Entity_Id); -- Append Subp to the list of subprograms inlined by the backend @@ -466,52 +452,6 @@ package body Inline is -- Append Subp to the list of subprograms that cannot be inlined by -- the backend. - ---------------------------- - -- Back_End_Cannot_Inline -- - ---------------------------- - - function Back_End_Cannot_Inline (Subp : Entity_Id) return Boolean is - Decl : constant Node_Id := Unit_Declaration_Node (Subp); - Body_Ent : Entity_Id; - Ent : Entity_Id; - - begin - if Nkind (Decl) = N_Subprogram_Declaration - and then Present (Corresponding_Body (Decl)) - then - Body_Ent := Corresponding_Body (Decl); - else - return False; - end if; - - -- If subprogram is marked Inline_Always, inlining is mandatory - - if Has_Pragma_Inline_Always (Subp) then - return False; - end if; - - if Present - (Exception_Handlers - (Handled_Statement_Sequence - (Unit_Declaration_Node (Corresponding_Body (Decl))))) - then - return True; - end if; - - Ent := First_Entity (Body_Ent); - while Present (Ent) loop - if Is_Subprogram (Ent) - and then Is_Generic_Instance (Ent) - then - return True; - end if; - - Next_Entity (Ent); - end loop; - - return False; - end Back_End_Cannot_Inline; - ----------------------------------------- -- Register_Backend_Inlined_Subprogram -- ----------------------------------------- @@ -547,21 +487,15 @@ package body Inline is and then not Is_Nested (E) and then not Has_Initialized_Type (E) then - if Back_End_Cannot_Inline (E) then - Set_Is_Inlined (E, False); - Register_Backend_Not_Inlined_Subprogram (E); + Register_Backend_Inlined_Subprogram (E); + if No (Last_Inlined) then + Set_First_Inlined_Subprogram (Cunit (Main_Unit), E); else - Register_Backend_Inlined_Subprogram (E); - - if No (Last_Inlined) then - Set_First_Inlined_Subprogram (Cunit (Main_Unit), E); - else - Set_Next_Inlined_Subprogram (Last_Inlined, E); - end if; - - Last_Inlined := E; + Set_Next_Inlined_Subprogram (Last_Inlined, E); end if; + + Last_Inlined := E; else Register_Backend_Not_Inlined_Subprogram (E); end if; diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb index ee56e746042..7df725d800f 100644 --- a/gcc/ada/sem_ch4.adb +++ b/gcc/ada/sem_ch4.adb @@ -7036,7 +7036,6 @@ package body Sem_Ch4 is Loc : constant Source_Ptr := Sloc (N); C_Type : Entity_Id; Assoc : List_Id; - Disc : Entity_Id; Func : Entity_Id; Func_Name : Node_Id; Indexing : Node_Id; @@ -7149,21 +7148,7 @@ package body Sem_Ch4 is -- discriminant is not the first discriminant. if Has_Discriminants (Etype (Func)) then - Disc := First_Discriminant (Etype (Func)); - while Present (Disc) loop - declare - Elmt_Type : Entity_Id; - begin - if Has_Implicit_Dereference (Disc) then - Elmt_Type := Designated_Type (Etype (Disc)); - Add_One_Interp (Indexing, Disc, Elmt_Type); - Add_One_Interp (N, Disc, Elmt_Type); - exit; - end if; - end; - - Next_Discriminant (Disc); - end loop; + Check_Implicit_Dereference (N, Etype (Func)); end if; else @@ -7194,18 +7179,7 @@ package body Sem_Ch4 is -- Add implicit dereference interpretation if Has_Discriminants (Etype (It.Nam)) then - Disc := First_Discriminant (Etype (It.Nam)); - while Present (Disc) loop - if Has_Implicit_Dereference (Disc) then - Add_One_Interp - (Indexing, Disc, Designated_Type (Etype (Disc))); - Add_One_Interp - (N, Disc, Designated_Type (Etype (Disc))); - exit; - end if; - - Next_Discriminant (Disc); - end loop; + Check_Implicit_Dereference (N, Etype (It.Nam)); end if; exit; diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 0715894b2d5..09afaaaafa5 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -2673,17 +2673,29 @@ package body Sem_Util is -- Check_Implicit_Dereference -- -------------------------------- - procedure Check_Implicit_Dereference (Nam : Node_Id; Typ : Entity_Id) is + procedure Check_Implicit_Dereference (N : Node_Id; Typ : Entity_Id) is Disc : Entity_Id; Desig : Entity_Id; + Nam : Node_Id; begin + if Nkind (N) = N_Indexed_Component + and then Present (Generalized_Indexing (N)) + then + Nam := Generalized_Indexing (N); + + else + Nam := N; + end if; + if Ada_Version < Ada_2012 or else not Has_Implicit_Dereference (Base_Type (Typ)) then return; - elsif not Comes_From_Source (Nam) then + elsif not Comes_From_Source (N) + and then Nkind (N) /= N_Indexed_Component + then return; elsif Is_Entity_Name (Nam) and then Is_Type (Entity (Nam)) then @@ -2695,6 +2707,26 @@ package body Sem_Util is if Has_Implicit_Dereference (Disc) then Desig := Designated_Type (Etype (Disc)); Add_One_Interp (Nam, Disc, Desig); + + -- If the node is a generalized indexing, add interpretation + -- to that node as well, for subsequent resolution. + + if Nkind (N) = N_Indexed_Component then + Add_One_Interp (N, Disc, Desig); + end if; + + -- If the operation comes from a generic unit and the context + -- is a selected component, the selector name may be global + -- and set in the instance already. Remove the entity to + -- force resolution of the selected component, and the + -- generation of an explicit dereference if needed. + + if In_Instance + and then Nkind (Parent (Nam)) = N_Selected_Component + then + Set_Entity (Selector_Name (Parent (Nam)), Empty); + end if; + exit; end if; @@ -16543,11 +16575,21 @@ package body Sem_Util is begin -- Nothing to do if argument is Empty or has Debug_Info_Off set, which -- indicates that Debug_Info_Needed is never required for the entity. + -- Nothing to do if entity comes from a predefined file. Library files + -- are compiled without debug information, but inlined bodies of these + -- routines may appear in user code, and debug information on them ends + -- up complicating debugging the user code. if No (T) or else Debug_Info_Off (T) then return; + + elsif In_Inlined_Body + and then Is_Predefined_File_Name + (Unit_File_Name (Get_Source_Unit (Sloc (T)))) + then + Set_Needs_Debug_Info (T, False); end if; -- Set flag in entity itself. Note that we will go through the following diff --git a/gcc/ada/sem_util.ads b/gcc/ada/sem_util.ads index 55825575141..bd3a4e9a7a0 100644 --- a/gcc/ada/sem_util.ads +++ b/gcc/ada/sem_util.ads @@ -285,10 +285,12 @@ package Sem_Util is -- the one containing C2, that is known to refer to the same object (RM -- 6.4.1(6.17/3)). - procedure Check_Implicit_Dereference (Nam : Node_Id; Typ : Entity_Id); + procedure Check_Implicit_Dereference (N : Node_Id; Typ : Entity_Id); -- AI05-139-2: Accessors and iterators for containers. This procedure -- checks whether T is a reference type, and if so it adds an interprettion - -- to Expr whose type is the designated type of the reference_discriminant. + -- to N whose type is the designated type of the reference_discriminant. + -- If N is a generalized indexing operation, the interpretation is added + -- both to the corresponding function call, and to the indexing node. procedure Check_Internal_Protected_Use (N : Node_Id; Nam : Entity_Id); -- Within a protected function, the current object is a constant, and -- 2.11.4.GIT