diff options
author | Arnaud Charlet <charlet@gcc.gnu.org> | 2012-05-15 13:07:26 +0200 |
---|---|---|
committer | Arnaud Charlet <charlet@gcc.gnu.org> | 2012-05-15 13:07:26 +0200 |
commit | 8a49a499a558ea71160ccfa5330f6c65af92cf80 (patch) | |
tree | ee46c275077e0468b6aa9a87ff59ebcb6c1876a0 | |
parent | 8c5b2819fa3377dec06665fe8dfded5e3c638bc9 (diff) | |
download | gcc-8a49a499a558ea71160ccfa5330f6c65af92cf80.zip gcc-8a49a499a558ea71160ccfa5330f6c65af92cf80.tar.gz gcc-8a49a499a558ea71160ccfa5330f6c65af92cf80.tar.bz2 |
[multiple changes]
2012-05-15 Ed Schonberg <schonberg@adacore.com>
* sem_ch10.adb (Expand_With_Clause): In the context of a generic
package declaration, a private with-clause on a child unit implies
that the implicit with clauses on its parents are private as well.
2012-05-15 Javier Miranda <miranda@adacore.com>
* sem_ch6.adb (Is_Interface_Conformant): Add missing call to
Base_Type to handle subtypes.
* exp_ch6.adb (Expand_Call): For calls located in thunks handle
unchecked conversions of access types found in actuals.
* exp_disp.adb (Expand_Interface_Thunk): Add missing unchecked
conversion to actuals whose type is an access type. Done to
avoid reporting spurious errors.
2012-05-15 Vincent Celier <celier@adacore.com>
* prj-env.adb (Create_Mapping): Ignore sources that are
suppressed (Create_Mapping_File.Process): Ditto
* prj-nmsc.adb (Add_Source): Update to take into
account suppressed files that may hide inherited sources.
(Mark_Excluded_Sources): Mark excluded sources of the current
project as suppressed.
* prj.ads (Source_Data): New Boolean component Suppressed,
defaulted to False
2012-05-15 Thomas Quinot <quinot@adacore.com>
* exp_intr.adb: Minor reformatting.
2012-05-15 Thomas Quinot <quinot@adacore.com>
* gnat_rm.texi: Document attribute Scalar_Storage_Order.
2012-05-15 Javier Miranda <miranda@adacore.com>
* exp_ch3.adb (Build_Offset_To_Top): Modify the
expansion of the offset_to_top functions to ensure that their
profile is conformant with the profile specified in Ada.Tags. No
change in functionality.
2012-05-15 Eric Botcazou <ebotcazou@adacore.com>
* inline.adb (Subp_Info): Remove Count and Next_Nopred
components, add Processed component and move around Next component.
(Add_Call): Reverse meaning of Successors table to the natural one.
(Add_Inlined_Body): Do not inline a package if it is in the main unit.
(Add_Inlined_Subprogram): Do not add the subprogram to the list if the
package is in the main unit. Do not recurse on the successors.
(Add_Subp): Adjust to new contents of Subp_Info.
(Analyze_Inlined_Bodies): Do not attempt
to compute a topological order on the list of inlined subprograms,
but compute the transitive closure from the main unit instead.
(Get_Code_Unit_Entity): Always return the spec for a package.
From-SVN: r187526
-rw-r--r-- | gcc/ada/ChangeLog | 56 | ||||
-rw-r--r-- | gcc/ada/exp_ch3.adb | 26 | ||||
-rw-r--r-- | gcc/ada/exp_ch6.adb | 8 | ||||
-rw-r--r-- | gcc/ada/exp_disp.adb | 8 | ||||
-rw-r--r-- | gcc/ada/exp_intr.adb | 11 | ||||
-rw-r--r-- | gcc/ada/gnat_rm.texi | 52 | ||||
-rw-r--r-- | gcc/ada/inline.adb | 166 | ||||
-rw-r--r-- | gcc/ada/prj-env.adb | 5 | ||||
-rw-r--r-- | gcc/ada/prj-nmsc.adb | 67 | ||||
-rw-r--r-- | gcc/ada/prj.ads | 8 | ||||
-rw-r--r-- | gcc/ada/sem_ch10.adb | 9 | ||||
-rw-r--r-- | gcc/ada/sem_ch6.adb | 2 |
12 files changed, 280 insertions, 138 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 34ab93d..26bf104 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,59 @@ +2012-05-15 Ed Schonberg <schonberg@adacore.com> + + * sem_ch10.adb (Expand_With_Clause): In the context of a generic + package declaration, a private with-clause on a child unit implies + that the implicit with clauses on its parents are private as well. + +2012-05-15 Javier Miranda <miranda@adacore.com> + + * sem_ch6.adb (Is_Interface_Conformant): Add missing call to + Base_Type to handle subtypes. + * exp_ch6.adb (Expand_Call): For calls located in thunks handle + unchecked conversions of access types found in actuals. + * exp_disp.adb (Expand_Interface_Thunk): Add missing unchecked + conversion to actuals whose type is an access type. Done to + avoid reporting spurious errors. + +2012-05-15 Vincent Celier <celier@adacore.com> + + * prj-env.adb (Create_Mapping): Ignore sources that are + suppressed (Create_Mapping_File.Process): Ditto + * prj-nmsc.adb (Add_Source): Update to take into + account suppressed files that may hide inherited sources. + (Mark_Excluded_Sources): Mark excluded sources of the current + project as suppressed. + * prj.ads (Source_Data): New Boolean component Suppressed, + defaulted to False + +2012-05-15 Thomas Quinot <quinot@adacore.com> + + * exp_intr.adb: Minor reformatting. + +2012-05-15 Thomas Quinot <quinot@adacore.com> + + * gnat_rm.texi: Document attribute Scalar_Storage_Order. + +2012-05-15 Javier Miranda <miranda@adacore.com> + + * exp_ch3.adb (Build_Offset_To_Top): Modify the + expansion of the offset_to_top functions to ensure that their + profile is conformant with the profile specified in Ada.Tags. No + change in functionality. + +2012-05-15 Eric Botcazou <ebotcazou@adacore.com> + + * inline.adb (Subp_Info): Remove Count and Next_Nopred + components, add Processed component and move around Next component. + (Add_Call): Reverse meaning of Successors table to the natural one. + (Add_Inlined_Body): Do not inline a package if it is in the main unit. + (Add_Inlined_Subprogram): Do not add the subprogram to the list if the + package is in the main unit. Do not recurse on the successors. + (Add_Subp): Adjust to new contents of Subp_Info. + (Analyze_Inlined_Bodies): Do not attempt + to compute a topological order on the list of inlined subprograms, + but compute the transitive closure from the main unit instead. + (Get_Code_Unit_Entity): Always return the spec for a package. + 2012-05-15 Yannick Moy <moy@adacore.com> * aspects.ads: Minor addition of comments to provide info on diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 9f6e565..ecc5a1c 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -1883,9 +1883,10 @@ package body Exp_Ch3 is procedure Build_Offset_To_Top_Function (Iface_Comp : Entity_Id); -- Generate: - -- function Fxx (O : in Rec_Typ) return Storage_Offset is + -- function Fxx (O : Address) return Storage_Offset is + -- type Acc is access all <Typ>; -- begin - -- return O.Iface_Comp'Position; + -- return Acc!(O).Iface_Comp'Position; -- end Fxx; ---------------------------------- @@ -1896,6 +1897,7 @@ package body Exp_Ch3 is Body_Node : Node_Id; Func_Id : Entity_Id; Spec_Node : Node_Id; + Acc_Type : Entity_Id; begin Func_Id := Make_Temporary (Loc, 'F'); @@ -1912,7 +1914,7 @@ package body Exp_Ch3 is Make_Defining_Identifier (Loc, Name_uO), In_Present => True, Parameter_Type => - New_Reference_To (Rec_Type, Loc)))); + New_Reference_To (RTE (RE_Address), Loc)))); Set_Result_Definition (Spec_Node, New_Reference_To (RTE (RE_Storage_Offset), Loc)); @@ -1924,7 +1926,19 @@ package body Exp_Ch3 is Body_Node := New_Node (N_Subprogram_Body, Loc); Set_Specification (Body_Node, Spec_Node); - Set_Declarations (Body_Node, New_List); + + Acc_Type := Make_Temporary (Loc, 'T'); + Set_Declarations (Body_Node, New_List ( + Make_Full_Type_Declaration (Loc, + Defining_Identifier => Acc_Type, + Type_Definition => + Make_Access_To_Object_Definition (Loc, + All_Present => True, + Null_Exclusion_Present => False, + Constant_Present => False, + Subtype_Indication => + New_Reference_To (Rec_Type, Loc))))); + Set_Handled_Statement_Sequence (Body_Node, Make_Handled_Sequence_Of_Statements (Loc, Statements => New_List ( @@ -1933,7 +1947,9 @@ package body Exp_Ch3 is Make_Attribute_Reference (Loc, Prefix => Make_Selected_Component (Loc, - Prefix => Make_Identifier (Loc, Name_uO), + Prefix => + Unchecked_Convert_To (Acc_Type, + Make_Identifier (Loc, Name_uO)), Selector_Name => New_Reference_To (Iface_Comp, Loc)), Attribute_Name => Name_Position))))); diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb index 7b6b296..ab27d23 100644 --- a/gcc/ada/exp_ch6.adb +++ b/gcc/ada/exp_ch6.adb @@ -2711,6 +2711,14 @@ package body Exp_Ch6 is Next_Entity (Parm_Ent); end loop; + -- Handle unchecked conversion of access types generated + -- in thunks (cf. Expand_Interface_Thunk) + + elsif Is_Access_Type (Etype (Actual)) + and then Nkind (Actual) = N_Unchecked_Type_Conversion + then + Parm_Ent := Entity (Expression (Actual)); + else pragma Assert (Is_Entity_Name (Actual)); Parm_Ent := Entity (Actual); end if; diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb index e065538..fd175bd 100644 --- a/gcc/ada/exp_disp.adb +++ b/gcc/ada/exp_disp.adb @@ -1829,6 +1829,14 @@ package body Exp_Disp is Make_Explicit_Dereference (Loc, New_Reference_To (Defining_Identifier (Decl_2), Loc)))); + -- Ensure proper matching of access types. Required to avoid + -- reporting spurious errors. + + elsif Is_Access_Type (Etype (Target_Formal)) then + Append_To (Actuals, + Unchecked_Convert_To (Base_Type (Etype (Target_Formal)), + New_Reference_To (Defining_Identifier (Formal), Loc))); + -- No special management required for this actual else diff --git a/gcc/ada/exp_intr.adb b/gcc/ada/exp_intr.adb index 50f404e..6617cc0 100644 --- a/gcc/ada/exp_intr.adb +++ b/gcc/ada/exp_intr.adb @@ -564,16 +564,15 @@ package body Exp_Intr is -- conventions and this has already been checked. elsif Present (Alias (E)) then - Expand_Intrinsic_Call (N, Alias (E)); + Expand_Intrinsic_Call (N, Alias (E)); elsif Nkind (N) in N_Binary_Op then Expand_Binary_Operator_Call (N); - -- The only other case is where an external name was specified, - -- since this is the only way that an otherwise unrecognized - -- name could escape the checking in Sem_Prag. Nothing needs - -- to be done in such a case, since we pass such a call to the - -- back end unchanged. + -- The only other case is where an external name was specified, since + -- this is the only way that an otherwise unrecognized name could + -- escape the checking in Sem_Prag. Nothing needs to be done in such + -- a case, since we pass such a call to the back end unchanged. else null; diff --git a/gcc/ada/gnat_rm.texi b/gcc/ada/gnat_rm.texi index 88a30f9..db0101f 100644 --- a/gcc/ada/gnat_rm.texi +++ b/gcc/ada/gnat_rm.texi @@ -272,6 +272,7 @@ Implementation Defined Attributes * Result:: * Safe_Emax:: * Safe_Large:: +* Scalar_Storage_Order:: * Simple_Storage_Pool:: * Small:: * Storage_Unit:: @@ -6023,6 +6024,7 @@ consideration, you should minimize the use of these attributes. * Result:: * Safe_Emax:: * Safe_Large:: +* Scalar_Storage_Order:: * Simple_Storage_Pool:: * Small:: * Storage_Unit:: @@ -6750,6 +6752,54 @@ The @code{Safe_Large} attribute is provided for compatibility with Ada 83. See the Ada 83 reference manual for an exact description of the semantics of this attribute. +@node Scalar_Storage_Order +@unnumberedsec Scalar_Storage_Order +@cindex Endianness +@cindex Scalar storage order +@findex Scalar_Storage_Order +@noindent +For every record subtype @var{S}, the representation attribute +@code{Scalar_Storage_Order} denotes the order in which storage elements +that make up scalar components are ordered within S. Other properties are +as for standard representation attribute @code{Bit_Order}, as defined by +Ada RM 13.5.3(4). The default is @code{System.Default_Bit_Order}. + +If @code{@var{S}'Scalar_Storage_Order} is specified explicitly, it shall be +equal to @code{@var{S}'Bit_Order}. Note: This means that if a +@code{Scalar_Storage_Order} attribute definition clause is not confirming, +then the type's @code{Bit_Order} shall be specified explicitly and set to +the same value. + +A confirming @code{Scalar_Storage_Order} attribute definition clause (i.e. +with a value equal to @code{System.Default_Bit_Order}) has no effect. + +If the opposite storage order is specified, then whenever the +value of a scalar component of S is read, the storage elements of the +enclosing machine scalar are first reversed (before retrieving the +component value, possibly applying some shift and mask operatings on the +enclosing machine scalar), and the opposite operation is done for +writes. + +In that case, the restrictions set forth in 10.3/2 for scalar components +are relaxed. Instead, the following rules apply: + +@itemize @bullet +@item the underlying storage elements are those at positions + @code{(position + first_bit / storage_element_size) .. + (position + (last_bit + storage_element_size - 1) / + storage_element_size)} +@item the sequence of underlying storage elements shall have + a size no greater than the largest machine scalar +@item the enclosing machine scalar is defined as the smallest machine + scalar starting at a position no greater than + @code{position + first_bit / storage_element_size} and covering + storage elements at least up to @code{position + (last_bit + + storage_element_size - 1) / storage_element_size} +@item the position of the component is interpreted relative to that machine + scalar. + +@end itemize + @node Simple_Storage_Pool @unnumberedsec Simple_Storage_Pool @cindex Storage pool, simple @@ -15452,7 +15502,7 @@ sequences for various UCS input formats. @section @code{GNAT.Byte_Swapping} (@file{g-bytswa.ads}) @cindex @code{GNAT.Byte_Swapping} (@file{g-bytswa.ads}) @cindex Byte swapping -@cindex Endian +@cindex Endianness @noindent General routines for swapping the bytes in 2-, 4-, and 8-byte quantities. diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb index 4735535..86d2fdf 100644 --- a/gcc/ada/inline.adb +++ b/gcc/ada/inline.adb @@ -70,15 +70,12 @@ package body Inline is ----------------------- -- For each call to an inlined subprogram, we make entries in a table - -- that stores caller and callee, and indicates a prerequisite from + -- that stores caller and callee, and indicates the call direction from -- one to the other. We also record the compilation unit that contains -- the callee. After analyzing the bodies of all such compilation units, - -- we produce a list of subprograms in topological order, for use by the - -- back-end. If P2 is a prerequisite of P1, then P1 calls P2, and for - -- proper inlining the back-end must analyze the body of P2 before that of - -- P1. The code below guarantees that the transitive closure of inlined - -- subprograms called from the main compilation unit is made available to - -- the code generator. + -- we compute the transitive closure of inlined subprograms called from + -- the main compilation unit and make it available to the code generator + -- in no particular order, thus allowing cycles in the call graph. Last_Inlined : Entity_Id := Empty; @@ -117,12 +114,11 @@ package body Inline is type Subp_Info is record Name : Entity_Id := Empty; + Next : Subp_Index := No_Subp; First_Succ : Succ_Index := No_Succ; - Count : Integer := 0; Listed : Boolean := False; Main_Call : Boolean := False; - Next : Subp_Index := No_Subp; - Next_Nopred : Subp_Index := No_Subp; + Processed : Boolean := False; end record; package Inlined is new Table.Table ( @@ -139,7 +135,8 @@ package body Inline is function Get_Code_Unit_Entity (E : Entity_Id) return Entity_Id; pragma Inline (Get_Code_Unit_Entity); - -- Return the entity node for the unit containing E + -- Return the entity node for the unit containing E. Always return + -- the spec for a package. function Scope_In_Main_Unit (Scop : Entity_Id) return Boolean; -- Return True if Scop is in the main unit or its spec @@ -166,9 +163,7 @@ package body Inline is -- example, an initialization procedure). procedure Add_Inlined_Subprogram (Index : Subp_Index); - -- Add subprogram to Inlined List once all of its predecessors have been - -- placed on the list. Decrement the count of all its successors, and - -- add them to list (recursively) if count drops to zero. + -- Add the subprogram to the list of inlined subprogram for the unit ------------------------------ -- Deferred Cleanup Actions -- @@ -203,29 +198,26 @@ package body Inline is if Present (Caller) then P2 := Add_Subp (Caller); - -- Add P2 to the list of successors of P1, if not already there. + -- Add P1 to the list of successors of P2, if not already there. -- Note that P2 may contain more than one call to P1, and only -- one needs to be recorded. - J := Inlined.Table (P1).First_Succ; + J := Inlined.Table (P2).First_Succ; while J /= No_Succ loop - if Successors.Table (J).Subp = P2 then + if Successors.Table (J).Subp = P1 then return; end if; J := Successors.Table (J).Next; end loop; - -- On exit, make a successor entry for P2 + -- On exit, make a successor entry for P1 Successors.Increment_Last; - Successors.Table (Successors.Last).Subp := P2; + Successors.Table (Successors.Last).Subp := P1; Successors.Table (Successors.Last).Next := - Inlined.Table (P1).First_Succ; - Inlined.Table (P1).First_Succ := Successors.Last; - - Inlined.Table (P2).Count := Inlined.Table (P2).Count + 1; - + Inlined.Table (P2).First_Succ; + Inlined.Table (P2).First_Succ := Successors.Last; else Inlined.Table (P1).Main_Call := True; end if; @@ -345,9 +337,11 @@ package body Inline is -- or other internally generated subprogram, because in that -- case the subprogram body appears in the same unit that -- declares the type, and that body is visible to the back end. + -- Do not inline it either if it is in the main unit. elsif not Is_Inlined (Pack) and then Comes_From_Source (E) + and then not Scope_In_Main_Unit (Pack) then Set_Is_Inlined (Pack); Inlined_Bodies.Increment_Last; @@ -365,8 +359,6 @@ package body Inline is procedure Add_Inlined_Subprogram (Index : Subp_Index) is E : constant Entity_Id := Inlined.Table (Index).Name; Pack : constant Entity_Id := Get_Code_Unit_Entity (E); - Succ : Succ_Index; - Subp : Subp_Index; function Back_End_Cannot_Inline (Subp : Entity_Id) return Boolean; -- There are various conditions under which back-end inlining cannot @@ -441,7 +433,7 @@ package body Inline is and then (Is_Inlined (Pack) or else Is_Generic_Instance (Pack) or else Is_Internal (E)) - and then not Scope_In_Main_Unit (E) + and then not Scope_In_Main_Unit (Pack) and then not Is_Nested (E) and then not Has_Initialized_Type (E) then @@ -460,27 +452,6 @@ package body Inline is end if; Inlined.Table (Index).Listed := True; - - -- Now add to the list those callers of the current subprogram that - -- are themselves called. They may appear on the graph as callers - -- of the current one, even if they are themselves not called, and - -- there is no point in including them in the list for the backend. - -- Furthermore, they might not even be public, in which case the - -- back-end cannot handle them at all. - - Succ := Inlined.Table (Index).First_Succ; - while Succ /= No_Succ loop - Subp := Successors.Table (Succ).Subp; - Inlined.Table (Subp).Count := Inlined.Table (Subp).Count - 1; - - if Inlined.Table (Subp).Count = 0 - and then Is_Called (Inlined.Table (Subp).Name) - then - Add_Inlined_Subprogram (Subp); - end if; - - Succ := Successors.Table (Succ).Next; - end loop; end Add_Inlined_Subprogram; ------------------------ @@ -545,12 +516,11 @@ package body Inline is begin Inlined.Increment_Last; Inlined.Table (Inlined.Last).Name := E; + Inlined.Table (Inlined.Last).Next := No_Subp; Inlined.Table (Inlined.Last).First_Succ := No_Succ; - Inlined.Table (Inlined.Last).Count := 0; Inlined.Table (Inlined.Last).Listed := False; Inlined.Table (Inlined.Last).Main_Call := False; - Inlined.Table (Inlined.Last).Next := No_Subp; - Inlined.Table (Inlined.Last).Next_Nopred := No_Subp; + Inlined.Table (Inlined.Last).Processed := False; end New_Entry; -- Start of processing for Add_Subp @@ -589,8 +559,20 @@ package body Inline is Comp_Unit : Node_Id; J : Int; Pack : Entity_Id; + Subp : Subp_Index; S : Succ_Index; + type Pending_Index is new Nat; + + package Pending_Inlined is new Table.Table ( + Table_Component_Type => Subp_Index, + Table_Index_Type => Pending_Index, + Table_Low_Bound => 1, + Table_Initial => Alloc.Inlined_Initial, + Table_Increment => Alloc.Inlined_Increment, + Table_Name => "Pending_Inlined"); + -- The workpile used to compute the transitive closure + function Is_Ancestor_Of_Main (U_Name : Entity_Id; Nam : Node_Id) return Boolean; @@ -757,64 +739,54 @@ package body Inline is -- as part of an inlined package, but are not themselves called. An -- accurate computation of just those subprograms that are needed -- requires that we perform a transitive closure over the call graph, - -- starting from calls in the main program. Here we do one step of - -- the inverse transitive closure, and reset the Is_Called flag on - -- subprograms all of whose callers are not. + -- starting from calls in the main program. for Index in Inlined.First .. Inlined.Last loop - S := Inlined.Table (Index).First_Succ; + if not Is_Called (Inlined.Table (Index).Name) then + -- This means that Add_Inlined_Body added the subprogram to the + -- table but wasn't able to handle its code unit. Do nothing. - if S /= No_Succ - and then not Inlined.Table (Index).Main_Call - then + null; + elsif Inlined.Table (Index).Main_Call then + Pending_Inlined.Increment_Last; + Pending_Inlined.Table (Pending_Inlined.Last) := Index; + Inlined.Table (Index).Processed := True; + else Set_Is_Called (Inlined.Table (Index).Name, False); - - while S /= No_Succ loop - if Is_Called - (Inlined.Table (Successors.Table (S).Subp).Name) - or else Inlined.Table (Successors.Table (S).Subp).Main_Call - then - Set_Is_Called (Inlined.Table (Index).Name); - exit; - end if; - - S := Successors.Table (S).Next; - end loop; end if; end loop; - -- Now that the units are compiled, chain the subprograms within - -- that are called and inlined. Produce list of inlined subprograms - -- sorted in topological order. Start with all subprograms that - -- have no prerequisites, i.e. inlined subprograms that do not call - -- other inlined subprograms. + -- Iterate over the workpile until it is emptied, propagating the + -- Is_Called flag to the successors of the processed subprogram. - for Index in Inlined.First .. Inlined.Last loop + while Pending_Inlined.Last >= Pending_Inlined.First loop + Subp := Pending_Inlined.Table (Pending_Inlined.Last); + Pending_Inlined.Decrement_Last; - if Is_Called (Inlined.Table (Index).Name) - and then Inlined.Table (Index).Count = 0 - and then not Inlined.Table (Index).Listed - then - Add_Inlined_Subprogram (Index); - end if; + S := Inlined.Table (Subp).First_Succ; + + while S /= No_Succ loop + Subp := Successors.Table (S).Subp; + Set_Is_Called (Inlined.Table (Subp).Name); + + if not Inlined.Table (Subp).Processed then + Pending_Inlined.Increment_Last; + Pending_Inlined.Table (Pending_Inlined.Last) := Subp; + Inlined.Table (Subp).Processed := True; + end if; + + S := Successors.Table (S).Next; + end loop; end loop; - -- Because Add_Inlined_Subprogram treats recursively nodes that have - -- no prerequisites left, at the end of the loop all subprograms - -- must have been listed. If there are any unlisted subprograms - -- left, there must be some recursive chains that cannot be inlined. + -- Finally add the called subprograms to the list of inlined + -- subprograms for the unit. for Index in Inlined.First .. Inlined.Last loop if Is_Called (Inlined.Table (Index).Name) - and then Inlined.Table (Index).Count /= 0 - and then not Is_Predefined_File_Name - (Unit_File_Name - (Get_Source_Unit (Inlined.Table (Index).Name))) + and then not Inlined.Table (Index).Listed then - Error_Msg_N - ("& cannot be inlined?", Inlined.Table (Index).Name); - - -- A warning on the first one might be sufficient ??? + Add_Inlined_Subprogram (Index); end if; end loop; @@ -994,8 +966,12 @@ package body Inline is -------------------------- function Get_Code_Unit_Entity (E : Entity_Id) return Entity_Id is + Unit : Entity_Id := Cunit_Entity (Get_Code_Unit (E)); begin - return Cunit_Entity (Get_Code_Unit (E)); + if Ekind (Unit) = E_Package_Body then + Unit := Spec_Entity (Unit); + end if; + return Unit; end Get_Code_Unit_Entity; -------------------------- diff --git a/gcc/ada/prj-env.adb b/gcc/ada/prj-env.adb index 23d2cbf..ae0fd18 100644 --- a/gcc/ada/prj-env.adb +++ b/gcc/ada/prj-env.adb @@ -754,7 +754,7 @@ package body Prj.Env is exit when Data = No_Source; if Data.Unit /= No_Unit_Index then - if Data.Locally_Removed then + if Data.Locally_Removed and then (not Data.Suppressed) then Fmap.Add_Forbidden_File_Name (Data.File); else Fmap.Add_To_File_Map @@ -829,7 +829,8 @@ package body Prj.Env is Source := Prj.Element (Iter); exit when Source = No_Source; - if Source.Replaced_By = No_Source + if (not Source.Suppressed) + and then Source.Replaced_By = No_Source and then Source.Path.Name /= No_Path and then (Source.Language.Config.Kind = File_Based or else Source.Unit /= No_Unit_Index) diff --git a/gcc/ada/prj-nmsc.adb b/gcc/ada/prj-nmsc.adb index 28d2f0f..cd62bc9 100644 --- a/gcc/ada/prj-nmsc.adb +++ b/gcc/ada/prj-nmsc.adb @@ -642,32 +642,45 @@ package body Prj.Nmsc is Add_Src := True; - -- Always add the source if it is locally removed, to avoid incorrect - -- duplicate checks. + if Unit /= No_Name then + Prev_Unit := Units_Htable.Get (Data.Tree.Units_HT, Unit); + end if; - if not Locally_Removed then - if Unit /= No_Name then - Prev_Unit := Units_Htable.Get (Data.Tree.Units_HT, Unit); - end if; + if Prev_Unit /= No_Unit_Index + and then (Kind = Impl or else Kind = Spec) + and then Prev_Unit.File_Names (Kind) /= null + then + -- Suspicious, we need to check later whether this is authorized - if Prev_Unit /= No_Unit_Index - and then (Kind = Impl or else Kind = Spec) - and then Prev_Unit.File_Names (Kind) /= null - then - -- Suspicious, we need to check later whether this is authorized + Add_Src := False; + Source := Prev_Unit.File_Names (Kind); + else + Source := Source_Files_Htable.Get + (Data.Tree.Source_Files_HT, File_Name); + + if Source /= No_Source and then Source.Index = Index then Add_Src := False; - Source := Prev_Unit.File_Names (Kind); + end if; + end if; - else - Source := Source_Files_Htable.Get - (Data.Tree.Source_Files_HT, File_Name); + -- Always add the source if it is locally removed, to avoid incorrect + -- duplicate checks. - if Source /= No_Source and then Source.Index = Index then - Add_Src := False; - end if; + if Locally_Removed then + Add_Src := True; + + -- A locally removed source may first replace a source in a project + -- being extended. + + if Source /= No_Source + and then Is_Extending (Project, Source.Project) + and then Naming_Exception /= Inherited + then + Source_To_Replace := Source; end if; + else -- Duplication of file/unit in same project is allowed if order of -- source directories is known, or if there is no compiler for the -- language. @@ -725,7 +738,7 @@ package body Prj.Nmsc is elsif Is_Extending (Project, Source.Project) then if not Locally_Removed - and then Naming_Exception /= Inherited + and then Naming_Exception /= Inherited then Source_To_Replace := Source; end if; @@ -733,6 +746,7 @@ package body Prj.Nmsc is elsif Prev_Unit /= No_Unit_Index and then Prev_Unit.File_Names (Kind) /= null and then not Source.Locally_Removed + and then Source.Replaced_By = No_Source and then not Data.In_Aggregate_Lib then -- Path is set if this is a source we found on the disk, in @@ -768,6 +782,7 @@ package body Prj.Nmsc is Add_Src := False; elsif not Source.Locally_Removed + and then Source.Replaced_By /= No_Source and then not Data.Flags.Allow_Duplicate_Basenames and then Lang_Id.Config.Kind = Unit_Based and then Source.Language.Config.Kind = Unit_Based @@ -785,10 +800,10 @@ package body Prj.Nmsc is Add_Src := True; end if; end if; + end if; - if not Add_Src then - return; - end if; + if not Add_Src then + return; end if; -- Add the new file @@ -868,7 +883,7 @@ package body Prj.Nmsc is -- Note that this updates Unit information as well - if Naming_Exception /= Inherited then + if Naming_Exception /= Inherited and then not Locally_Removed then Override_Kind (Id, Kind); end if; end if; @@ -7799,8 +7814,12 @@ package body Prj.Nmsc is (Project.Excluded, Source.File); if Excluded /= No_File_Found then - Source.Locally_Removed := True; Source.In_Interfaces := False; + Source.Locally_Removed := True; + + if Proj = Project.Project then + Source.Suppressed := True; + end if; if Current_Verbosity = High then Debug_Indent; diff --git a/gcc/ada/prj.ads b/gcc/ada/prj.ads index 696db4a..93e0664 100644 --- a/gcc/ada/prj.ads +++ b/gcc/ada/prj.ads @@ -783,8 +783,13 @@ package Prj is Locally_Removed : Boolean := False; -- True if the source has been "excluded" + Suppressed : Boolean := False; + -- True if the source is a locally removed direct source of the project. + -- These sources should not be put in the mapping file. + Replaced_By : Source_Id := No_Source; - -- Missing comment ??? + -- Indicate the source in an extending project that replaces the current + -- source. File : File_Name_Type := No_File; -- Canonical file name of the source @@ -866,6 +871,7 @@ package Prj is Unit => No_Unit_Index, Index => 0, Locally_Removed => False, + Suppressed => False, Compilable => Unknown, In_The_Queue => False, Replaced_By => No_Source, diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb index 64e7e32..3334d1d 100644 --- a/gcc/ada/sem_ch10.adb +++ b/gcc/ada/sem_ch10.adb @@ -2987,10 +2987,13 @@ package body Sem_Ch10 is Set_First_Name (Withn, True); Set_Implicit_With (Withn, True); - -- If the unit is a package declaration, a private_with_clause on a - -- child unit implies the implicit with on the parent is also private. + -- If the unit is a package or generic package declaration, a private_ + -- with_clause on a child unit implies that the implicit with on the + -- parent is also private. - if Nkind (Unit (N)) = N_Package_Declaration then + if Nkind_In + (Unit (N), N_Package_Declaration, N_Generic_Package_Declaration) + then Set_Private_Present (Withn, Private_Present (Item)); end if; diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 747636d..2b27ca4 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -8934,7 +8934,7 @@ package body Sem_Ch6 is or else not Is_Dispatching_Operation (Prim) or else Scope (Prim) /= Scope (Tagged_Type) or else No (Typ) - or else Base_Type (Typ) /= Tagged_Type + or else Base_Type (Typ) /= Base_Type (Tagged_Type) or else not Primitive_Names_Match (Iface_Prim, Prim) then return False; |