-- --
-- B o d y --
-- --
--- Copyright (C) 1997-2006, Free Software Foundation, Inc. --
+-- Copyright (C) 1997-2007, 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- --
and then Elab_Warnings
and then Generate_Warnings
then
- if Inst_Case then
- Error_Msg_NE
- ("instantiation of& may raise Program_Error?", N, Ent);
+ Generate_Elab_Warnings : declare
+ procedure Elab_Warning
+ (Msg_D : String;
+ Msg_S : String;
+ Ent : Node_Or_Entity_Id);
+ -- Generate a call to Error_Msg_NE with parameters Msg_D or
+ -- Msg_S (for dynamic or static elaboration model), N and Ent.
+
+ ------------------
+ -- Elab_Warning --
+ ------------------
+
+ procedure Elab_Warning
+ (Msg_D : String;
+ Msg_S : String;
+ Ent : Node_Or_Entity_Id)
+ is
+ begin
+ if Dynamic_Elaboration_Checks then
+ Error_Msg_NE (Msg_D, N, Ent);
+ else
+ Error_Msg_NE (Msg_S, N, Ent);
+ end if;
+ end Elab_Warning;
- else
- if Is_Init_Proc (Entity (Name (N)))
- and then Comes_From_Source (Ent)
- then
- Error_Msg_NE
- ("implicit call to & may raise Program_Error?", N, Ent);
+ -- Start of processing for Generate_Elab_Warnings
+
+ begin
+ if Inst_Case then
+ Elab_Warning
+ ("instantiation of& may raise Program_Error?",
+ "instantiation of& during elaboration?", Ent);
else
- Error_Msg_NE
- ("call to & may raise Program_Error?", N, Ent);
+ if Nkind (Name (N)) in N_Has_Entity
+ and then Is_Init_Proc (Entity (Name (N)))
+ and then Comes_From_Source (Ent)
+ then
+ Elab_Warning
+ ("implicit call to & may raise Program_Error?",
+ "implicit call to & during elaboration?",
+ Ent);
+
+ else
+ Elab_Warning
+ ("call to & may raise Program_Error?",
+ "call to & during elaboration?",
+ Ent);
+ end if;
end if;
- end if;
- Error_Msg_Qual_Level := Nat'Last;
+ Error_Msg_Qual_Level := Nat'Last;
- if Nkind (N) in N_Subprogram_Instantiation then
- Error_Msg_NE
- ("\missing pragma Elaborate for&?", N, W_Scope);
- else
- Error_Msg_NE
- ("\missing pragma Elaborate_All for&?", N, W_Scope);
- end if;
+ if Nkind (N) in N_Subprogram_Instantiation then
+ Elab_Warning
+ ("\missing pragma Elaborate for&?",
+ "\implicit pragma Elaborate for& generated?",
+ W_Scope);
+ else
+ Elab_Warning
+ ("\missing pragma Elaborate_All for&?",
+ "\implicit pragma Elaborate_All for & generated?",
+ W_Scope);
+ end if;
+ end Generate_Elab_Warnings;
Error_Msg_Qual_Level := 0;
Output_Calls (N);
- -- Set flag to prevent further warnings for same unit
- -- unless in All_Errors_Mode.
+ -- Set flag to prevent further warnings for same unit unless in
+ -- All_Errors_Mode.
if not All_Errors_Mode and not Dynamic_Elaboration_Checks then
Set_Suppress_Elaboration_Warnings (W_Scope, True);
Expander_Mode_Save_And_Set (True);
for J in Delay_Check.First .. Delay_Check.Last loop
- New_Scope (Delay_Check.Table (J).Curscop);
+ Push_Scope (Delay_Check.Table (J).Curscop);
From_Elab_Code := Delay_Check.Table (J).From_Elab_Code;
Check_Internal_Call_Continue (
begin
Set_Elaboration_Entity (E, Ent);
- New_Scope (Scope (E));
+ Push_Scope (Scope (E));
Insert_Action (Declaration_Node (E),
Make_Object_Declaration (Loce,
declare
Spec : constant Node_Id := Specification (N);
begin
- New_Scope (Defining_Unit_Name (Spec));
+ Push_Scope (Defining_Unit_Name (Spec));
Supply_Bodies (Visible_Declarations (Spec));
Supply_Bodies (Private_Declarations (Spec));
Pop_Scope;