diff options
Diffstat (limited to 'gcc/ada')
| -rw-r--r-- | gcc/ada/ChangeLog | 24 | ||||
| -rw-r--r-- | gcc/ada/freeze.adb | 8 | ||||
| -rw-r--r-- | gcc/ada/gnat_rm.texi | 14 | ||||
| -rw-r--r-- | gcc/ada/inline.adb | 78 | ||||
| -rw-r--r-- | gcc/ada/sem_ch4.adb | 30 | ||||
| -rw-r--r-- | gcc/ada/sem_util.adb | 46 | ||||
| -rw-r--r-- | 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 <schonberg@adacore.com> + * freeze.adb (Freeze_Record_Type): Do not check component size + if its type is generic. + +2014-10-31 Bob Duff <duff@adacore.com> + + * gnat_rm.texi: Fix documentation w.r.t -gnatw.w. + +2014-10-31 Ed Schonberg <schonberg@adacore.com> + + * 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 <ebotcazou@adacore.com> + + * inline.adb (Back_End_Cannot_Inline): Delete. + (Add_Inlined_Subprogram): Do not call it. + +2014-10-31 Ed Schonberg <schonberg@adacore.com> + * 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 |