From 70d904ca8edc145e16c7d5720059eb437e439ee2 Mon Sep 17 00:00:00 2001 From: Ed Schonberg Date: Fri, 8 Aug 2008 13:09:37 +0000 Subject: [PATCH] freeze.adb (Generate_Prim_Op_References): New procedure, abstracted from Freeze_Entity. 2008-08-08 Ed Schonberg * 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 --- gcc/ada/ChangeLog | 6 ++ gcc/ada/freeze.adb | 162 ++++++++++++++++++++++++++++----------------- 2 files changed, 107 insertions(+), 61 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 1f5e4e66499..df7f18bf560 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2008-08-08 Ed Schonberg + + * 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 * gcc-interface/Makefile.in: Reintroduce g-soccon.ads as a diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 5a8f98380a7..5e069f4c7a4 100644 --- a/gcc/ada/freeze.adb +++ b/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 @@ -5231,6 +5203,74 @@ package body Freeze is end if; 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 -- --------------------------------- -- 2.30.2