[multiple changes]
authorArnaud Charlet <charlet@gcc.gnu.org>
Tue, 15 May 2012 11:07:26 +0000 (13:07 +0200)
committerArnaud Charlet <charlet@gcc.gnu.org>
Tue, 15 May 2012 11:07:26 +0000 (13:07 +0200)
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

12 files changed:
gcc/ada/ChangeLog
gcc/ada/exp_ch3.adb
gcc/ada/exp_ch6.adb
gcc/ada/exp_disp.adb
gcc/ada/exp_intr.adb
gcc/ada/gnat_rm.texi
gcc/ada/inline.adb
gcc/ada/prj-env.adb
gcc/ada/prj-nmsc.adb
gcc/ada/prj.ads
gcc/ada/sem_ch10.adb
gcc/ada/sem_ch6.adb

index 34ab93d74ba550653aa843586a9b217b6fd781e5..26bf104730091dfc81f9217adce46b10c018dc9a 100644 (file)
@@ -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
index 9f6e56539117bb2254f7aa8629b976078462ad2f..ecc5a1c5a45fb914e79308413709a9e368e7a5a1 100644 (file)
@@ -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)))));
index 7b6b296456c184d722065163df9be13cb237f806..ab27d231113b6532de8ce08b4fa4a9a5de0a5bd3 100644 (file)
@@ -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;
index e065538c72b12facded6540464458377e8350d3b..fd175bd02c3f6bcf27ee89d6dca7c88ebe4c3fc6 100644 (file)
@@ -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
index 50f404e6bc88cf3633f20e88e889393b85e3752b..6617cc0066ddf8d539f4bd65e3e9e1f7e440335f 100644 (file)
@@ -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;
index 88a30f9fe5d89b686f5c9c5c8e7bf5499f0ecc9c..db0101f9870d67d6f6740384198dfeeda34a9353 100644 (file)
@@ -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.
index 473553584dd77a34738e3799ab448c6484f3d3ee..86d2fdf4d2e0554052061490e9633fef72955fb5 100644 (file)
@@ -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;
 
    --------------------------
index 23d2cbf526f8c8833a4defdf7481d7cba3304d75..ae0fd181590384b0f4d3cc7bbf10f617106adb75 100644 (file)
@@ -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)
index 28d2f0faa1764ffbd7ec9074803ec3c0840dd7bb..cd62bc9bf44f57d85a7aaaa70103dc8ef4e8d6bb 100644 (file)
@@ -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;
index 696db4ac530c3be534a96827a01465314c62ae9f..93e06646c4b682bc84097d7c02e88e5244555a06 100644 (file)
@@ -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,
index 64e7e3220265ddd4544f37eac87de62cf26f1f5e..3334d1da166d1044a5ca27afa1a77bc48f4a206a 100644 (file)
@@ -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;
 
index 747636d69c112fc7b3473de73311f3a2d62ac20b..2b27ca47745f6c0565ca5317c9b1323521c75359 100644 (file)
@@ -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;