diff options
Diffstat (limited to 'gcc/ada/sem_elab.adb')
| -rw-r--r-- | gcc/ada/sem_elab.adb | 112 |
1 files changed, 75 insertions, 37 deletions
diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb index f189fe127db..bb62a11234d 100644 --- a/gcc/ada/sem_elab.adb +++ b/gcc/ada/sem_elab.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1997-2003 Free Software Foundation, Inc. -- +-- Copyright (C) 1997-2004 Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -300,7 +300,18 @@ package body Sem_Elab is Decl : Node_Id; E_Scope : Entity_Id; - -- Top level scope of entity for called subprogram + -- Top level scope of entity for called subprogram. This + -- value includes following renamings and derivations, so + -- this scope can be in a non-visible unit. This is the + -- scope that is to be investigated to see whether an + -- elaboration check is required. + + W_Scope : Entity_Id; + -- Top level scope of directly called entity for subprogram. + -- This differs from E_Scope in the case where renamings or + -- derivations are involved, since it does not follow these + -- links, thus W_Scope is always in a visible unit. This is + -- the scope for the Elaborate_All if one is needed. Body_Acts_As_Spec : Boolean; -- Set to true if call is to body acting as spec (no separate spec) @@ -611,7 +622,7 @@ package body Sem_Elab is Ent := Alias (Ent); E_Scope := Ent; - -- If no alias, there is a previous error. + -- If no alias, there is a previous error if No (Ent) then return; @@ -623,6 +634,26 @@ package body Sem_Elab is return; end if; + -- Find top level scope for called entity (not following renamings + -- or derivations). This is where the Elaborate_All will go if it + -- is needed. We start with the called entity, except in the case + -- of initialization procedures, where the init proc is in the root + -- package, where we start fromn the entity of the name in the call. + + if Is_Entity_Name (Name (N)) + and then Is_Init_Proc (Entity (Name (N))) + then + W_Scope := Scope (Entity (Name (N))); + else + W_Scope := E; + end if; + + while not Is_Compilation_Unit (W_Scope) loop + W_Scope := Scope (W_Scope); + end loop; + + -- Now check if an elaborate_all (or dynamic check) is needed + if not Suppress_Elaboration_Warnings (Ent) and then not Elaboration_Checks_Suppressed (Ent) and then not Suppress_Elaboration_Warnings (E_Scope) @@ -633,38 +664,23 @@ package body Sem_Elab is if Inst_Case then Error_Msg_NE ("instantiation of& may raise Program_Error?", N, Ent); + else if Is_Init_Proc (Entity (Name (N))) and then Comes_From_Source (Ent) then Error_Msg_NE - ("implicit call to & in initialization" & - " may raise Program_Error?", N, Ent); - E_Scope := Scope (Entity (Name (N))); + ("implicit call to & may raise Program_Error?", N, Ent); else Error_Msg_NE ("call to & may raise Program_Error?", N, Ent); end if; - - if Unit_Callee = No_Unit - and then E_Scope = Current_Scope - then - -- The missing pragma cannot be on the current unit, so - -- place it on the compilation unit that contains the - -- called entity, which is more likely to be right. - - E_Scope := Ent; - - while not Is_Compilation_Unit (E_Scope) loop - E_Scope := Scope (E_Scope); - end loop; - end if; end if; Error_Msg_Qual_Level := Nat'Last; Error_Msg_NE - ("\missing pragma Elaborate_All for&?", N, E_Scope); + ("\missing pragma Elaborate_All for&?", N, W_Scope); Error_Msg_Qual_Level := 0; Output_Calls (N); @@ -672,7 +688,7 @@ package body Sem_Elab is -- unless in All_Errors_Mode. if not All_Errors_Mode and not Dynamic_Elaboration_Checks then - Set_Suppress_Elaboration_Warnings (E_Scope, True); + Set_Suppress_Elaboration_Warnings (W_Scope, True); end if; end if; @@ -680,12 +696,18 @@ package body Sem_Elab is if Dynamic_Elaboration_Checks then if not Elaboration_Checks_Suppressed (Ent) + and then not Elaboration_Checks_Suppressed (W_Scope) and then not Elaboration_Checks_Suppressed (E_Scope) and then not Cunit_SC then -- Runtime elaboration check required. Generate check of the -- elaboration Boolean for the unit containing the entity. + -- Note that for this case, we do check the real unit (the + -- one from following renamings, since that is the issue!) + + -- Could this possibly miss a useless but required PE??? + Insert_Elab_Check (N, Make_Attribute_Reference (Loc, Attribute_Name => Name_Elaborated, @@ -694,25 +716,41 @@ package body Sem_Elab is (Spec_Entity (E_Scope), Loc))); end if; - -- If no dynamic check required, then ask binder to guarantee - -- that the necessary elaborations will be done properly! + -- Case of static elaboration model else - if not Suppress_Elaboration_Warnings (E) - and then not Elaboration_Checks_Suppressed (E) - and then not Suppress_Elaboration_Warnings (E_Scope) - and then not Elaboration_Checks_Suppressed (E_Scope) - and then Elab_Warnings - and then Generate_Warnings - and then not Inst_Case + -- Do not do anything if elaboration checks suppressed. Note + -- that we check Ent here, not E, since we want the real entity + -- for the body to see if checks are suppressed for it, not the + -- dummy entry for renamings or derivations. + + if Elaboration_Checks_Suppressed (Ent) + or else Elaboration_Checks_Suppressed (E_Scope) + or else Elaboration_Checks_Suppressed (W_Scope) then - Error_Msg_Node_2 := E_Scope; - Error_Msg_NE ("call to& in elaboration code " & - "requires pragma Elaborate_All on&?", N, E); - end if; + null; + + -- Here we need to generate an implicit elaborate all + + else + -- Generate elaborate_all warning unless suppressed - Set_Elaborate_All_Desirable (E_Scope); - Set_Suppress_Elaboration_Warnings (E_Scope, True); + if (Elab_Warnings and Generate_Warnings and not Inst_Case) + and then not Suppress_Elaboration_Warnings (Ent) + and then not Suppress_Elaboration_Warnings (E_Scope) + and then not Suppress_Elaboration_Warnings (W_Scope) + then + Error_Msg_Node_2 := W_Scope; + Error_Msg_NE + ("call to& in elaboration code " & + "requires pragma Elaborate_All on&?", N, E); + end if; + + -- Set indication for binder to generate Elaborate_All + + Set_Elaborate_All_Desirable (W_Scope); + Set_Suppress_Elaboration_Warnings (W_Scope, True); + end if; end if; -- Case of entity is in same unit as call or instantiation |