Skip to content

R
riscv-gcc-1
Commit 70d904ca by Ed Schonberg Committed by Arnaud Charlet
Options

freeze.adb (Generate_Prim_Op_References): New procedure, abstracted from Freeze_Entity. 

2008-08-08  Ed Schonberg  <schonberg@adacore.com>

	* freeze.adb (Generate_Prim_Op_References): New procedure, abstracted
	from Freeze_Entity. Used to generate cross-reference information for
	types declared in generic packages.

From-SVN: r138881
parent cfb53555
Showing with 107 additions and 61 deletions
gcc/ada/ChangeLog
2008-08-08 Ed Schonberg <schonberg@adacore.com>
* freeze.adb (Generate_Prim_Op_References): New procedure, abstracted
from Freeze_Entity. Used to generate cross-reference information for
types declared in generic packages.
2008-08-08 Thomas Quinot <quinot@adacore.com>
* gcc-interface/Makefile.in: Reintroduce g-soccon.ads as a
gcc/ada/freeze.adb
......@@ -134,6 +134,11 @@ package body Freeze is
-- the designated type. Otherwise freezing the access type does not freeze
-- the designated type.
procedure Generate_Prim_Op_References
(Typ : Entity_Id);
-- For a tagged type, generate implicit references to its primitive
-- operations, for source navigation.
procedure Process_Default_Expressions
(E : Entity_Id;
After : in out Node_Id);
......@@ -2600,6 +2605,10 @@ package body Freeze is
--
-- type T is tagged;
-- function F (X : Boolean) return T; -- ERROR
-- The type must be declared in the current scope
-- for the use to be legal, and the full view
-- must be available when the construct that mentions
-- it is frozen.
elsif Ekind (Etype (E)) = E_Incomplete_Type
and then Is_Tagged_Type (Etype (E))
......@@ -2608,7 +2617,7 @@ package body Freeze is
then
Error_Msg_N
("(Ada 2005): invalid use of tagged incomplete type",
E);
E);
end if;
end if;
end;
......@@ -2635,10 +2644,30 @@ package body Freeze is
-- Here for other than a subprogram or type
else
-- For a generic package, freeze types within, so that proper
-- cross-reference information is generated for tagged types.
-- This is the only freeze processing needed for generic packages.
if Ekind (E) = E_Generic_Package then
declare
T : Entity_Id;
begin
T := First_Entity (E);
while Present (T) loop
if Is_Type (T) then
Generate_Prim_Op_References (T);
end if;
Next_Entity (T);
end loop;
end;
-- If entity has a type, and it is not a generic unit, then
-- freeze it first (RM 13.14(10)).
if Present (Etype (E))
elsif Present (Etype (E))
and then Ekind (E) /= E_Generic_Function
then
Freeze_And_Append (Etype (E), Loc, Result);
......@@ -3628,66 +3657,9 @@ package body Freeze is
end if;
end if;
-- Generate primitive operation references for a tagged type
if Is_Tagged_Type (E)
and then not Is_Class_Wide_Type (E)
then
declare
Prim_List : Elist_Id;
Prim : Elmt_Id;
Ent : Entity_Id;
Aux_E : Entity_Id;
begin
-- Handle subtypes
-- Generate references to primitive operations for a tagged type
if Ekind (E) = E_Protected_Subtype
or else Ekind (E) = E_Task_Subtype
then
Aux_E := Etype (E);
else
Aux_E := E;
end if;
-- Ada 2005 (AI-345): In case of concurrent type generate
-- reference to the wrapper that allow us to dispatch calls
-- through their implemented abstract interface types.
-- The check for Present here is to protect against previously
-- reported critical errors.
if Is_Concurrent_Type (Aux_E)
and then Present (Corresponding_Record_Type (Aux_E))
then
Prim_List := Primitive_Operations
(Corresponding_Record_Type (Aux_E));
else
Prim_List := Primitive_Operations (Aux_E);
end if;
-- Loop to generate references for primitive operations
if Present (Prim_List) then
Prim := First_Elmt (Prim_List);
while Present (Prim) loop
-- If the operation is derived, get the original for
-- cross-reference purposes (it is the original for
-- which we want the xref, and for which the comes
-- from source test needs to be performed).
Ent := Node (Prim);
while Present (Alias (Ent)) loop
Ent := Alias (Ent);
end loop;
Generate_Reference (E, Ent, 'p', Set_Ref => False);
Next_Elmt (Prim);
end loop;
end if;
end;
end if;
Generate_Prim_Op_References (E);
-- Now that all types from which E may depend are frozen, see if the
-- size is known at compile time, if it must be unsigned, or if
......@@ -5232,6 +5204,74 @@ package body Freeze is
end Is_Fully_Defined;
---------------------------------
-- Generate_Prim_Op_References --
---------------------------------
procedure Generate_Prim_Op_References
(Typ : Entity_Id)
is
Base_T : Entity_Id;
Prim : Elmt_Id;
Prim_List : Elist_Id;
Ent : Entity_Id;
begin
-- Handle subtypes of synchronized types.
if Ekind (Typ) = E_Protected_Subtype
or else Ekind (Typ) = E_Task_Subtype
then
Base_T := Etype (Typ);
else
Base_T := Typ;
end if;
-- References to primitive operations are only relevant for tagged types
if not Is_Tagged_Type (Base_T)
or else Is_Class_Wide_Type (Base_T)
then
return;
end if;
-- Ada 2005 (AI-345): For synchronized types generate reference
-- to the wrapper that allow us to dispatch calls through their
-- implemented abstract interface types.
-- The check for Present here is to protect against previously
-- reported critical errors.
if Is_Concurrent_Type (Base_T)
and then Present (Corresponding_Record_Type (Base_T))
then
Prim_List := Primitive_Operations
(Corresponding_Record_Type (Base_T));
else
Prim_List := Primitive_Operations (Base_T);
end if;
if No (Prim_List) then
return;
end if;
Prim := First_Elmt (Prim_List);
while Present (Prim) loop
-- If the operation is derived, get the original for cross-reference
-- reference purposes (it is the original for which we want the xref
-- and for which the comes_from_source test must be performed).
Ent := Node (Prim);
while Present (Alias (Ent)) loop
Ent := Alias (Ent);
end loop;
Generate_Reference (Typ, Ent, 'p', Set_Ref => False);
Next_Elmt (Prim);
end loop;
end Generate_Prim_Op_References;
---------------------------------
-- Process_Default_Expressions --
---------------------------------
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment