aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorArnaud Charlet <charlet@gcc.gnu.org>2012-05-15 13:07:26 +0200
committerArnaud Charlet <charlet@gcc.gnu.org>2012-05-15 13:07:26 +0200
commit8a49a499a558ea71160ccfa5330f6c65af92cf80 (patch)
treeee46c275077e0468b6aa9a87ff59ebcb6c1876a0
parent8c5b2819fa3377dec06665fe8dfded5e3c638bc9 (diff)
downloadgcc-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/ChangeLog56
-rw-r--r--gcc/ada/exp_ch3.adb26
-rw-r--r--gcc/ada/exp_ch6.adb8
-rw-r--r--gcc/ada/exp_disp.adb8
-rw-r--r--gcc/ada/exp_intr.adb11
-rw-r--r--gcc/ada/gnat_rm.texi52
-rw-r--r--gcc/ada/inline.adb166
-rw-r--r--gcc/ada/prj-env.adb5
-rw-r--r--gcc/ada/prj-nmsc.adb67
-rw-r--r--gcc/ada/prj.ads8
-rw-r--r--gcc/ada/sem_ch10.adb9
-rw-r--r--gcc/ada/sem_ch6.adb2
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;