OpenE2K/gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

sem_ch4.adb (Analyze_Call): In Ada2012 an incomplete type from a limited view may appear in the profile of...

Browse Source 
* 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.

From-SVN: r248321
This commit is contained in:
Eric Botcazou 2017-05-22 09:24:24 +00:00
parent 4c24ec6d58
commit d327113612
14 changed files with 153 additions and 109 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
gcc/ada/ChangeLog
View File

@ -1,3 +1,19 @@
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>
* gcc-interface/decl.c (gnat_to_gnu_field): Do not enforce strict

29
gcc/ada/gcc-interface/decl.c
View File

@ -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_entity, tree gnu_expr, bool definition)
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_entity, tree gnu_expr, bool definition)
/* 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_entity, tree gnu_expr, bool definition)
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_entity, tree gnu_expr, bool definition)
{
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_entity, tree gnu_expr, bool definition)
}
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));

14
gcc/ada/gcc-interface/trans.c
View File

@ -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))

90
gcc/ada/inline.adb
View File

@ -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;

28
gcc/ada/sem_ch4.adb
View File

@ -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)));
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)));
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;
Set_Etype (N, Full_View (Etype (N)));
end if;
end if;
end Analyze_Call;

7
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,10 @@
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.
2017-05-22 Eric Botcazou <ebotcazou@adacore.com>
* gnat.dg/specs/volatile1.ads: Remove obsolete errors.

11
gcc/testsuite/gnat.dg/limited_with5.adb Normal file
View File

@ -0,0 +1,11 @@
-- { 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;

6
gcc/testsuite/gnat.dg/limited_with5.ads Normal file
View File

@ -0,0 +1,6 @@
with Limited_With5_Pkg;
package Limited_With5 is
type Sup_T is new Integer;
procedure Doit (Obj : Limited_With5_Pkg.T);
end Limited_With5;

8
gcc/testsuite/gnat.dg/limited_with5_pkg.adb Normal file
View File

@ -0,0 +1,8 @@
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;

8
gcc/testsuite/gnat.dg/limited_with5_pkg.ads Normal file
View File

@ -0,0 +1,8 @@
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;

11
gcc/testsuite/gnat.dg/limited_with6.adb Normal file
View File

@ -0,0 +1,11 @@
-- { 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;

10
gcc/testsuite/gnat.dg/limited_with6.ads Normal file
View File

@ -0,0 +1,10 @@
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;

10
gcc/testsuite/gnat.dg/limited_with6_pkg.adb Normal file
View File

@ -0,0 +1,10 @@
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;

14
gcc/testsuite/gnat.dg/limited_with6_pkg.ads Normal file
View File

@ -0,0 +1,14 @@
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;