-- --
-- 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- --
with Opt; use Opt;
with Output; use Output;
with Restrict; use Restrict;
+with Rident; use Rident;
with Sem; use Sem;
with Sem_Cat; use Sem_Cat;
with Sem_Ch7; use Sem_Ch7;
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)
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;
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)
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);
-- 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;
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,
(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
- Set_Elaborate_All_Desirable (E_Scope);
- Set_Suppress_Elaboration_Warnings (E_Scope, True);
+ else
+ -- Generate elaborate_all warning unless suppressed
+
+ 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
-- will be doing the actual call later, not now, and it
-- is at the time of the actual call (statically speaking)
-- that we must do our static check, not at the time of
- -- its initial analysis).
+ -- its initial analysis). However, we have to check calls
+ -- within component definitions (e.g., a function call
+ -- that determines an array component bound), so we
+ -- terminate the loop in that case.
P := Parent (N);
while Present (P) loop
Nkind (P) = N_Component_Declaration
then
return;
+
+ -- The call occurs within the constraint of a component,
+ -- so it must be checked.
+
+ elsif Nkind (P) = N_Component_Definition then
+ exit;
+
else
P := Parent (P);
end if;
if (Nkind (Original_Node (N)) = N_Accept_Statement
or else Nkind (Original_Node (N)) = N_Selective_Accept)
- and then Restrictions (No_Entry_Calls_In_Elaboration_Code)
+ and then Restriction_Active (No_Entry_Calls_In_Elaboration_Code)
then
return Abandon;
elsif Dynamic_Elaboration_Checks then
if not Elaboration_Checks_Suppressed (Ent)
and then not Cunit_SC
- and then not Restrictions (No_Entry_Calls_In_Elaboration_Code)
+ and then
+ not Restriction_Active (No_Entry_Calls_In_Elaboration_Code)
then
-- Runtime elaboration check required. generate check of the
-- elaboration Boolean for the unit containing the entity.
OSDN Git Service
