This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[Ada] Remove restriction on inlining in related units
- From: Eric Botcazou <ebotcazou at adacore dot com>
- To: gcc-patches at gcc dot gnu dot org
- Date: Mon, 22 May 2017 11:24:48 +0200
- Subject: [Ada] Remove restriction on inlining in related units
- Authentication-results: sourceware.org; auth=none
This change makes it possible for the compiler to inline into a child package
a subprogram declared in a parent package, even if the parent package has a
with clause for the child package in the body. It also fixes segfaults that
can occur when inlining into a package a subprogram coming from an unrelated
package containing a Taft Amendment type that closes a dependency cycle with
at least one member type declared in the first package.
The following code must compile quietly with -O -gnatn -Winline:
package Buf.Support is
type Sup_T is new Integer;
procedure Doit (Obj : T);
end Buf.Support;
package body Buf.Support is
procedure Doit (Obj : T) is
begin
if Buf.Get_Support (Obj) > 100 then
raise Program_Error;
end if;
end Doit;
end Buf.Support;
limited with Buf.Support;
package Buf is
type T is limited private;
function Get_Support (Obj : T) return Buf.Support.Sup_T with Inline;
private
type T is new Integer;
end Buf;
with Buf.Support;
package body Buf is
function Get_Support (Obj : T) return Buf.Support.Sup_T is
begin
return Buf.Support.Sup_T (Obj + 1);
end Get_Support;
end Buf;
Tested on x86_64-suse-linux, applied on the mainline.
2017-05-22 Ed Schonberg <schonberg@adacore.com>
Eric Botcazou <ebotcazou@adacore.com>
* sem_ch4.adb (Analyze_Call): In Ada2012 an incomplete type from a
limited view may appear in the profile of a function, and a call to
that function in another unit in which the full view is available must
use this full view to spurious type errors at the point of call.
* inline.adb (Analyze_Inlined_Bodies): Remove restriction on loading
of parent body with a with clause for the main unit.
* gcc-interface/decl.c (defer_limited_with_list): Document new usage.
(gnat_to_gnu_entity) <E_Access_Type>: Handle completed Taft Amendment
types declared in external units like types from limited with clauses.
Adjust final processing of defer_limited_with_list accordingly.
* gcc-interface/trans.c (gnat_to_gnu) < N_Selected_Component>: Try
again to translate the prefix after the field if it is incomplete.
2017-05-22 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/limited_with5.ad[sb]: New test.
* gnat.dg/limited_with5_pkg.ad[sb]: New helper.
* gnat.dg/limited_with6.ad[sb]: New test.
* gnat.dg/limited_with6_pkg.ad[sb]: New helper.
--
Eric BotcazouIndex: gcc-interface/decl.c
===================================================================
--- gcc-interface/decl.c (revision 248320)
+++ gcc-interface/decl.c (working copy)
@@ -101,8 +101,8 @@ struct incomplete
static int defer_incomplete_level = 0;
static struct incomplete *defer_incomplete_list;
-/* This variable is used to delay expanding From_Limited_With types until the
- end of the spec. */
+/* This variable is used to delay expanding types coming from a limited with
+ clause and completed Taft Amendment types until the end of the spec. */
static struct incomplete *defer_limited_with_list;
typedef struct subst_pair_d {
@@ -3580,6 +3580,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
const bool is_from_limited_with
= (IN (Ekind (gnat_desig_equiv), Incomplete_Kind)
&& From_Limited_With (gnat_desig_equiv));
+ /* Whether it is a completed Taft Amendment type. Such a type is to
+ be treated as coming from a limited with clause if it is not in
+ the main unit, i.e. we break potential circularities here in case
+ the body of an external unit is loaded for inter-unit inlining. */
+ const bool is_completed_taft_type
+ = (IN (Ekind (gnat_desig_equiv), Incomplete_Kind)
+ && Has_Completion_In_Body (gnat_desig_equiv)
+ && Present (Full_View (gnat_desig_equiv)));
/* The "full view" of the designated type. If this is an incomplete
entity from a limited with, treat its non-limited view as the full
view. Otherwise, if this is an incomplete or private type, use the
@@ -3646,13 +3654,14 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
/* Get the type of the thing we are to point to and build a pointer to
it. If it is a reference to an incomplete or private type with a
- full view that is a record or an array, make a dummy type node and
- get the actual type later when we have verified it is safe. */
+ full view that is a record, an array or an access, make a dummy type
+ and get the actual type later when we have verified it is safe. */
else if ((!in_main_unit
&& !present_gnu_tree (gnat_desig_equiv)
&& Present (gnat_desig_full)
&& (Is_Record_Type (gnat_desig_full)
- || Is_Array_Type (gnat_desig_full)))
+ || Is_Array_Type (gnat_desig_full)
+ || Is_Access_Type (gnat_desig_full)))
/* Likewise if this is a reference to a record, an array or a
subprogram type and we are to defer elaborating incomplete
types. We do this because this access type may be the full
@@ -3763,7 +3772,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
save_gnu_tree (gnat_entity, gnu_decl, false);
saved = true;
- if (defer_incomplete_level == 0 && !is_from_limited_with)
+ if (defer_incomplete_level == 0
+ && !is_from_limited_with
+ && !is_completed_taft_type)
{
update_pointer_to (TYPE_MAIN_VARIANT (gnu_desig_type),
gnat_to_gnu_type (gnat_desig_equiv));
@@ -3772,7 +3783,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
{
struct incomplete *p = XNEW (struct incomplete);
struct incomplete **head
- = (is_from_limited_with
+ = (is_from_limited_with || is_completed_taft_type
? &defer_limited_with_list : &defer_incomplete_list);
p->old_type = gnu_desig_type;
@@ -4766,7 +4777,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entit
}
for (p = defer_limited_with_list; p; p = p->next)
- if (p->old_type && Non_Limited_View (p->full_type) == gnat_entity)
+ if (p->old_type
+ && (Non_Limited_View (p->full_type) == gnat_entity
+ || Full_View (p->full_type) == gnat_entity))
{
update_pointer_to (TYPE_MAIN_VARIANT (p->old_type),
TREE_TYPE (gnu_decl));
Index: gcc-interface/trans.c
===================================================================
--- gcc-interface/trans.c (revision 248140)
+++ gcc-interface/trans.c (working copy)
@@ -6413,7 +6413,6 @@ gnat_to_gnu (Node_Id gnat_node)
Entity_Id gnat_prefix = Prefix (gnat_node);
Entity_Id gnat_field = Entity (Selector_Name (gnat_node));
tree gnu_prefix = gnat_to_gnu (gnat_prefix);
- tree gnu_field;
gnu_prefix = maybe_implicit_deref (gnu_prefix);
@@ -6442,8 +6441,19 @@ gnat_to_gnu (Node_Id gnat_node)
NULL_TREE, gnu_prefix);
else
{
- gnu_field = gnat_to_gnu_field_decl (gnat_field);
+ tree gnu_field = gnat_to_gnu_field_decl (gnat_field);
+ /* If the prefix has incomplete type, try again to translate it.
+ The idea is that the translation of the field just above may
+ have completed it through gnat_to_gnu_entity, in case it is
+ the dereference of an access to Taft Amendment type used in
+ the instantiation of a generic body from an external unit. */
+ if (!COMPLETE_TYPE_P (TREE_TYPE (gnu_prefix)))
+ {
+ gnu_prefix = gnat_to_gnu (gnat_prefix);
+ gnu_prefix = maybe_implicit_deref (gnu_prefix);
+ }
+
gnu_result
= build_component_ref (gnu_prefix, gnu_field,
(Nkind (Parent (gnat_node))
Index: inline.adb
===================================================================
--- inline.adb (revision 248140)
+++ inline.adb (working copy)
@@ -667,57 +667,6 @@ package body Inline is
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;
- -- Determine whether the unit whose body is loaded is an ancestor of
- -- the main unit, and has a with_clause on it. The body is not
- -- analyzed yet, so the check is purely lexical: the name of the with
- -- clause is a selected component, and names of ancestors must match.
-
- -------------------------
- -- Is_Ancestor_Of_Main --
- -------------------------
-
- function Is_Ancestor_Of_Main
- (U_Name : Entity_Id;
- Nam : Node_Id) return Boolean
- is
- Pref : Node_Id;
-
- begin
- if Nkind (Nam) /= N_Selected_Component then
- return False;
-
- else
- if Chars (Selector_Name (Nam)) /=
- Chars (Cunit_Entity (Main_Unit))
- then
- return False;
- end if;
-
- Pref := Prefix (Nam);
- if Nkind (Pref) = N_Identifier then
-
- -- Par is an ancestor of Par.Child.
-
- return Chars (Pref) = Chars (U_Name);
-
- elsif Nkind (Pref) = N_Selected_Component
- and then Chars (Selector_Name (Pref)) = Chars (U_Name)
- then
- -- Par.Child is an ancestor of Par.Child.Grand.
-
- return True; -- should check that ancestor match
-
- else
- -- A is an ancestor of A.B.C if it is an ancestor of A.B
-
- return Is_Ancestor_Of_Main (U_Name, Pref);
- end if;
- end if;
- end Is_Ancestor_Of_Main;
-
-- Start of processing for Analyze_Inlined_Bodies
begin
@@ -766,7 +715,7 @@ package body Inline is
begin
if not Is_Loaded (Bname) then
Style_Check := False;
- Load_Needed_Body (Comp_Unit, OK, Do_Analyze => False);
+ Load_Needed_Body (Comp_Unit, OK);
if not OK then
@@ -780,43 +729,6 @@ package body Inline is
Error_Msg_File_1 :=
Get_File_Name (Bname, Subunit => False);
Error_Msg_N ("\but file{ was not found!??", Comp_Unit);
-
- else
- -- If the package to be inlined is an ancestor unit of
- -- the main unit, and it has a semantic dependence on
- -- it, the inlining cannot take place to prevent an
- -- elaboration circularity. The desired body is not
- -- analyzed yet, to prevent the completion of Taft
- -- amendment types that would lead to elaboration
- -- circularities in gigi.
-
- declare
- U_Id : constant Entity_Id :=
- Defining_Entity (Unit (Comp_Unit));
- Body_Unit : constant Node_Id :=
- Library_Unit (Comp_Unit);
- Item : Node_Id;
-
- begin
- Item := First (Context_Items (Body_Unit));
- while Present (Item) loop
- if Nkind (Item) = N_With_Clause
- and then
- Is_Ancestor_Of_Main (U_Id, Name (Item))
- then
- Set_Is_Inlined (U_Id, False);
- exit;
- end if;
-
- Next (Item);
- end loop;
-
- -- If no suspicious with_clauses, analyze the body
-
- if Is_Inlined (U_Id) then
- Semantics (Body_Unit);
- end if;
- end;
end if;
end if;
end;
Index: sem_ch4.adb
===================================================================
--- sem_ch4.adb (revision 248140)
+++ sem_ch4.adb (working copy)
@@ -1469,18 +1469,26 @@ package body Sem_Ch4 is
-- can also happen when the function declaration appears before the
-- full view of the type (which is legal in Ada 2012) and the call
-- appears in a different unit, in which case the incomplete view
- -- must be replaced with the full view to prevent subsequent type
- -- errors.
+ -- must be replaced with the full view (or the non-limited view)
+ -- to prevent subsequent type errors. Note that the usual install/
+ -- removal of limited_with clauses is not sufficient to handle this
+ -- case, because the limited view may have been captured is another
+ -- compilation unit that defines the current function.
- if Is_Incomplete_Type (Etype (N))
- and then Present (Full_View (Etype (N)))
- then
- if Is_Entity_Name (Nam) then
- Set_Etype (Nam, Full_View (Etype (N)));
- Set_Etype (Entity (Nam), Full_View (Etype (N)));
- end if;
+ if Is_Incomplete_Type (Etype (N)) then
+ if Present (Full_View (Etype (N))) then
+ if Is_Entity_Name (Nam) then
+ Set_Etype (Nam, Full_View (Etype (N)));
+ Set_Etype (Entity (Nam), Full_View (Etype (N)));
+ end if;
+
+ Set_Etype (N, Full_View (Etype (N)));
- Set_Etype (N, Full_View (Etype (N)));
+ elsif From_Limited_With (Etype (N))
+ and then Present (Non_Limited_View (Etype (N)))
+ then
+ Set_Etype (N, Non_Limited_View (Etype (N)));
+ end if;
end if;
end if;
end Analyze_Call;
-- { dg-do compile }
-- { dg-options "-O -gnatn -Winline" }
package body Limited_With5 is
procedure Doit (Obj : Limited_With5_Pkg.T) is
begin
if Limited_With5_Pkg.Get_Expression_Support (Obj) > Sup_T'(100) then
raise Program_Error;
end if;
end Doit;
end Limited_With5;
with Limited_With5_Pkg;
package Limited_With5 is
type Sup_T is new Integer;
procedure Doit (Obj : Limited_With5_Pkg.T);
end Limited_With5;
with Limited_With6_Pkg;
package Limited_With6 is
type Sup_T is new Integer;
procedure Doit (Obj : Limited_With6_Pkg.T);
type Rec is record
A : Limited_With6_Pkg.Taft_Ptr;
end record;
end Limited_With6;
with Limited_With5;
package body Limited_With5_Pkg is
function Get_Expression_Support (Obj : T) return Limited_With5.Sup_T is
begin
return Limited_With5.Sup_T (Obj + 1);
end Get_Expression_Support;
end Limited_With5_Pkg;
limited with Limited_With5;
package Limited_With5_Pkg is
type T is limited private;
function Get_Expression_Support (Obj : T) return Limited_With5.Sup_T with Inline;
private
type T is new Integer;
end Limited_With5_Pkg;
with Limited_With6;
package body Limited_With6_Pkg is
function Get_Expression_Support (Obj : T) return Limited_With6.Sup_T is
begin
return Limited_With6.Sup_T (Obj + 1);
end Get_Expression_Support;
type TT is access all Limited_With6.Rec;
end Limited_With6_Pkg;
-- { dg-do compile }
-- { dg-options "-O -gnatn -Winline" }
package body Limited_With6 is
procedure Doit (Obj : Limited_With6_Pkg.T) is
begin
if Limited_With6_Pkg.Get_Expression_Support (Obj) > Sup_T'(100) then
raise Program_Error;
end if;
end Doit;
end Limited_With6;
limited with Limited_With6;
package Limited_With6_Pkg is
type T is limited private;
function Get_Expression_Support (Obj : T) return Limited_With6.Sup_T with Inline;
type Taft_Ptr is private;
private
type T is new Integer;
type TT;
type Taft_Ptr is access TT;
end Limited_With6_Pkg;