diff options
Diffstat (limited to 'gcc/ada/freeze.adb')
| -rw-r--r-- | gcc/ada/freeze.adb | 175 |
1 files changed, 113 insertions, 62 deletions
diff --git a/gcc/ada/freeze.adb b/gcc/ada/freeze.adb index 31f93985c44..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); @@ -2398,6 +2403,8 @@ package body Freeze is elsif Root_Type (F_Type) = Standard_Boolean and then Convention (F_Type) = Convention_Ada + and then not Has_Warnings_Off (F_Type) + and then not Has_Size_Clause (F_Type) then Error_Msg_N ("?& is an 8-bit Ada Boolean, " @@ -2543,6 +2550,7 @@ package body Freeze is and then Convention (R_Type) = Convention_Ada and then not Has_Warnings_Off (E) and then not Has_Warnings_Off (R_Type) + and then not Has_Size_Clause (R_Type) then Error_Msg_N ("?return type of & is an 8-bit " @@ -2597,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)) @@ -2605,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; @@ -2632,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); @@ -2661,8 +2693,16 @@ package body Freeze is -- The check doesn't apply to imported objects, which are not -- ever default initialized, and is why the check is deferred -- until freezing, at which point we know if Import applies. + -- Deferred constants are also exempted from this test because + -- their completion is explicit, or through an import pragma. - if not Is_Imported (E) + if Ekind (E) = E_Constant + and then Present (Full_View (E)) + then + null; + + elsif Comes_From_Source (E) + and then not Is_Imported (E) and then not Has_Init_Expression (Declaration_Node (E)) and then ((Has_Non_Null_Base_Init_Proc (Etype (E)) @@ -3617,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 - - 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 references to primitive operations for a tagged type - 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 @@ -5221,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 -- --------------------------------- |