return;
end if;
- -- Case of entity is not in current unit (i.e. with'ed unit case)
-
- if E_Scope /= C_Scope then
-
- -- We are only interested in such calls if the outer call was from
- -- elaboration code, or if we are in Dynamic_Elaboration_Checks mode.
+ -- 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 an
+ -- initialization procedure outside the current package, where the init
+ -- proc is in the root package, and we start from the entity of the name
+ -- in the call.
- if not From_Elab_Code and then not Dynamic_Elaboration_Checks then
- return;
+ declare
+ Ent : constant Entity_Id := Get_Referenced_Ent (N);
+ begin
+ if Is_Init_Proc (Ent)
+ and then not In_Same_Extended_Unit (N, Ent)
+ then
+ W_Scope := Scope (Ent);
+ else
+ W_Scope := E;
end if;
+ end;
- -- Nothing to do if some scope said that no checks were required
+ -- Now loop through scopes to get to the enclosing compilation unit
- if Cunit_SC then
- return;
- end if;
+ while not Is_Compilation_Unit (W_Scope) loop
+ W_Scope := Scope (W_Scope);
+ end loop;
- -- Nothing to do for a generic instance, because in this case the
- -- checking was at the point of instantiation of the generic However,
- -- this shortcut is only applicable in static mode.
+ -- Case of entity is in same unit as call or instantiation. In the
+ -- instantiation case, W_Scope may be different from E_Scope; we want
+ -- the unit in which the instantiation occurs, since we're analyzing
+ -- based on the expansion.
- if Is_Generic_Instance (Ent) and not Dynamic_Elaboration_Checks then
- return;
+ if W_Scope = C_Scope then
+ if not Inter_Unit_Only then
+ Check_Internal_Call (N, Ent, Outer_Scope, E);
end if;
- -- Nothing to do if subprogram with no separate spec. However, a
- -- call to Deep_Initialize may result in a call to a user-defined
- -- Initialize procedure, which imposes a body dependency. This
- -- happens only if the type is controlled and the Initialize
- -- procedure is not inherited.
+ return;
+ end if;
- if Body_Acts_As_Spec then
- if Is_TSS (Ent, TSS_Deep_Initialize) then
- declare
- Typ : constant Entity_Id := Etype (First_Formal (Ent));
- Init : Entity_Id;
+ -- Case of entity is not in current unit (i.e. with'ed unit case)
- begin
- if not Is_Controlled (Typ) then
- return;
- else
- Init := Find_Prim_Op (Typ, Name_Initialize);
+ -- We are only interested in such calls if the outer call was from
+ -- elaboration code, or if we are in Dynamic_Elaboration_Checks mode.
- if Comes_From_Source (Init) then
- Ent := Init;
- else
- return;
- end if;
- end if;
- end;
-
- else
- return;
- end if;
- end if;
+ if not From_Elab_Code and then not Dynamic_Elaboration_Checks then
+ return;
+ end if;
- -- Check cases of internal units
+ -- Nothing to do if some scope said that no checks were required
- Callee_Unit_Internal :=
- Is_Internal_File_Name
- (Unit_File_Name (Get_Source_Unit (E_Scope)));
+ if Cunit_SC then
+ return;
+ end if;
- -- Do not give a warning if the with'ed unit is internal and this is
- -- the generic instantiation case (this saves a lot of hassle dealing
- -- with the Text_IO special child units)
+ -- Nothing to do for a generic instance, because in this case the
+ -- checking was at the point of instantiation of the generic However,
+ -- this shortcut is only applicable in static mode.
- if Callee_Unit_Internal and Inst_Case then
- return;
- end if;
+ if Is_Generic_Instance (Ent) and not Dynamic_Elaboration_Checks then
+ return;
+ end if;
- if C_Scope = Standard_Standard then
- Caller_Unit_Internal := False;
- else
- Caller_Unit_Internal :=
- Is_Internal_File_Name
- (Unit_File_Name (Get_Source_Unit (C_Scope)));
- end if;
+ -- Nothing to do if subprogram with no separate spec. However, a call
+ -- to Deep_Initialize may result in a call to a user-defined Initialize
+ -- procedure, which imposes a body dependency. This happens only if the
+ -- type is controlled and the Initialize procedure is not inherited.
- -- Do not give a warning if the with'ed unit is internal and the
- -- caller is not internal (since the binder always elaborates
- -- internal units first).
+ if Body_Acts_As_Spec then
+ if Is_TSS (Ent, TSS_Deep_Initialize) then
+ declare
+ Typ : constant Entity_Id := Etype (First_Formal (Ent));
+ Init : Entity_Id;
- if Callee_Unit_Internal and (not Caller_Unit_Internal) then
- return;
- end if;
+ begin
+ if not Is_Controlled (Typ) then
+ return;
+ else
+ Init := Find_Prim_Op (Typ, Name_Initialize);
- -- For now, if debug flag -gnatdE is not set, do no checking for
- -- one internal unit withing another. This fixes the problem with
- -- the sgi build and storage errors. To be resolved later ???
+ if Comes_From_Source (Init) then
+ Ent := Init;
+ else
+ return;
+ end if;
+ end if;
+ end;
- if (Callee_Unit_Internal and Caller_Unit_Internal)
- and then not Debug_Flag_EE
- then
+ else
return;
end if;
+ end if;
- if Is_TSS (E, TSS_Deep_Initialize) then
- Ent := E;
- end if;
-
- -- If the call is in an instance, and the called entity is not
- -- defined in the same instance, then the elaboration issue focuses
- -- around the unit containing the template, it is this unit which
- -- requires an Elaborate_All.
+ -- Check cases of internal units
- -- However, if we are doing dynamic elaboration, we need to chase the
- -- call in the usual manner.
+ Callee_Unit_Internal :=
+ Is_Internal_File_Name (Unit_File_Name (Get_Source_Unit (E_Scope)));
- -- We also need to chase the call in the usual manner if it is a call
- -- to a generic formal parameter, since that case was not handled as
- -- part of the processing of the template.
+ -- Do not give a warning if the with'ed unit is internal and this is
+ -- the generic instantiation case (this saves a lot of hassle dealing
+ -- with the Text_IO special child units)
- Inst_Caller := Instantiation (Get_Source_File_Index (Sloc (N)));
- Inst_Callee := Instantiation (Get_Source_File_Index (Sloc (Ent)));
+ if Callee_Unit_Internal and Inst_Case then
+ return;
+ end if;
- if Inst_Caller = No_Location then
- Unit_Caller := No_Unit;
- else
- Unit_Caller := Get_Source_Unit (N);
- end if;
+ if C_Scope = Standard_Standard then
+ Caller_Unit_Internal := False;
+ else
+ Caller_Unit_Internal :=
+ Is_Internal_File_Name (Unit_File_Name (Get_Source_Unit (C_Scope)));
+ end if;
- if Inst_Callee = No_Location then
- Unit_Callee := No_Unit;
- else
- Unit_Callee := Get_Source_Unit (Ent);
- end if;
+ -- Do not give a warning if the with'ed unit is internal and the
+ -- caller is not internal (since the binder always elaborates
+ -- internal units first).
- if Unit_Caller /= No_Unit
- and then Unit_Callee /= Unit_Caller
- and then not Dynamic_Elaboration_Checks
- and then not Is_Call_Of_Generic_Formal (N)
- then
- E_Scope := Spec_Entity (Cunit_Entity (Unit_Caller));
+ if Callee_Unit_Internal and (not Caller_Unit_Internal) then
+ return;
+ end if;
- -- If we don't get a spec entity, just ignore call. Not quite
- -- clear why this check is necessary. ???
+ -- For now, if debug flag -gnatdE is not set, do no checking for
+ -- one internal unit withing another. This fixes the problem with
+ -- the sgi build and storage errors. To be resolved later ???
- if No (E_Scope) then
- return;
- end if;
+ if (Callee_Unit_Internal and Caller_Unit_Internal)
+ and not Debug_Flag_EE
+ then
+ return;
+ end if;
- -- Otherwise step to enclosing compilation unit
+ if Is_TSS (E, TSS_Deep_Initialize) then
+ Ent := E;
+ end if;
- while not Is_Compilation_Unit (E_Scope) loop
- E_Scope := Scope (E_Scope);
- end loop;
+ -- If the call is in an instance, and the called entity is not
+ -- defined in the same instance, then the elaboration issue focuses
+ -- around the unit containing the template, it is this unit which
+ -- requires an Elaborate_All.
- -- For the case where N is not an instance, and is not a call within
- -- instance to other than a generic formal, we recompute E_Scope
- -- for the error message, since we do NOT want to go to the unit
- -- which has the ultimate declaration in the case of renaming and
- -- derivation and we also want to go to the generic unit in the
- -- case of an instance, and no further.
+ -- However, if we are doing dynamic elaboration, we need to chase the
+ -- call in the usual manner.
- else
- -- Loop to carefully follow renamings and derivations one step
- -- outside the current unit, but not further.
+ -- We also need to chase the call in the usual manner if it is a call
+ -- to a generic formal parameter, since that case was not handled as
+ -- part of the processing of the template.
- if not (Inst_Case or Variable_Case)
- and then Present (Alias (Ent))
- then
- E_Scope := Alias (Ent);
- else
- E_Scope := Ent;
- end if;
+ Inst_Caller := Instantiation (Get_Source_File_Index (Sloc (N)));
+ Inst_Callee := Instantiation (Get_Source_File_Index (Sloc (Ent)));
- loop
- while not Is_Compilation_Unit (E_Scope) loop
- E_Scope := Scope (E_Scope);
- end loop;
+ if Inst_Caller = No_Location then
+ Unit_Caller := No_Unit;
+ else
+ Unit_Caller := Get_Source_Unit (N);
+ end if;
- -- If E_Scope is the same as C_Scope, it means that there
- -- definitely was a local renaming or derivation, and we
- -- are not yet out of the current unit.
+ if Inst_Callee = No_Location then
+ Unit_Callee := No_Unit;
+ else
+ Unit_Callee := Get_Source_Unit (Ent);
+ end if;
- exit when E_Scope /= C_Scope;
- Ent := Alias (Ent);
- E_Scope := Ent;
+ if Unit_Caller /= No_Unit
+ and then Unit_Callee /= Unit_Caller
+ and then not Dynamic_Elaboration_Checks
+ and then not Is_Call_Of_Generic_Formal (N)
+ then
+ E_Scope := Spec_Entity (Cunit_Entity (Unit_Caller));
- -- If no alias, there is a previous error
+ -- If we don't get a spec entity, just ignore call. Not quite
+ -- clear why this check is necessary. ???
- if No (Ent) then
- Check_Error_Detected;
- return;
- end if;
- end loop;
- end if;
-
- if Within_Elaborate_All (Current_Sem_Unit, E_Scope) then
+ if No (E_Scope) then
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 an initialization procedure outside the current package, where
- -- the init proc is in the root package, and we start from the entity
- -- of the name in the call.
-
- declare
- Ent : constant Entity_Id := Get_Referenced_Ent (N);
- begin
- if Is_Init_Proc (Ent)
- and then not In_Same_Extended_Unit (N, Ent)
- then
- W_Scope := Scope (Ent);
- else
- W_Scope := E;
- end if;
- end;
-
- -- Now loop through scopes to get to the enclosing compilation unit
+ -- Otherwise step to enclosing compilation unit
- while not Is_Compilation_Unit (W_Scope) loop
- W_Scope := Scope (W_Scope);
+ while not Is_Compilation_Unit (E_Scope) loop
+ E_Scope := Scope (E_Scope);
end loop;
- -- Now check if an elaborate_all (or dynamic check) is needed
+ -- For the case where N is not an instance, and is not a call within
+ -- instance to other than a generic formal, we recompute E_Scope
+ -- for the error message, since we do NOT want to go to the unit
+ -- which has the ultimate declaration in the case of renaming and
+ -- derivation and we also want to go to the generic unit in the
+ -- case of an instance, and no further.
- if not Suppress_Elaboration_Warnings (Ent)
- and then not Elaboration_Checks_Suppressed (Ent)
- and then not Suppress_Elaboration_Warnings (E_Scope)
- and then not Elaboration_Checks_Suppressed (E_Scope)
- and then ((Elab_Warnings or Elab_Info_Messages)
- or else SPARK_Mode = On)
- and then Generate_Warnings
+ else
+ -- Loop to carefully follow renamings and derivations one step
+ -- outside the current unit, but not further.
+
+ if not (Inst_Case or Variable_Case)
+ and then Present (Alias (Ent))
then
- -- Instantiation case
+ E_Scope := Alias (Ent);
+ else
+ E_Scope := Ent;
+ end if;
- if Inst_Case then
- if SPARK_Mode = On then
- Error_Msg_NE
- ("instantiation of & during elaboration in SPARK",
- N, Ent);
+ loop
+ while not Is_Compilation_Unit (E_Scope) loop
+ E_Scope := Scope (E_Scope);
+ end loop;
- else
- Elab_Warning
- ("instantiation of & may raise Program_Error?l?",
- "info: instantiation of & during elaboration?$?", Ent);
- end if;
+ -- If E_Scope is the same as C_Scope, it means that there
+ -- definitely was a local renaming or derivation, and we
+ -- are not yet out of the current unit.
- -- Indirect call case, info message only in static elaboration
- -- case, because the attribute reference itself cannot raise an
- -- exception. Note that SPARK does not permit indirect calls.
+ exit when E_Scope /= C_Scope;
+ Ent := Alias (Ent);
+ E_Scope := Ent;
- elsif Access_Case then
- Elab_Warning
- ("", "info: access to & during elaboration?$?", Ent);
+ -- If no alias, there is a previous error
- -- Variable reference in SPARK mode
+ if No (Ent) then
+ Check_Error_Detected;
+ return;
+ end if;
+ end loop;
+ end if;
- elsif Variable_Case then
- Error_Msg_NE
- ("reference to & during elaboration in SPARK", N, Ent);
+ if Within_Elaborate_All (Current_Sem_Unit, E_Scope) then
+ return;
+ end if;
- -- Subprogram call case
+ -- Now check if an Elaborate_All (or dynamic check) is needed
- else
- 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?l?",
- "info: implicit call to & during elaboration?$?",
- Ent);
+ if not Suppress_Elaboration_Warnings (Ent)
+ and then not Elaboration_Checks_Suppressed (Ent)
+ and then not Suppress_Elaboration_Warnings (E_Scope)
+ and then not Elaboration_Checks_Suppressed (E_Scope)
+ and then ((Elab_Warnings or Elab_Info_Messages)
+ or else SPARK_Mode = On)
+ and then Generate_Warnings
+ then
+ -- Instantiation case
- elsif SPARK_Mode = On then
- Error_Msg_NE
- ("call to & during elaboration in SPARK", N, Ent);
+ if Inst_Case then
+ if SPARK_Mode = On then
+ Error_Msg_NE
+ ("instantiation of & during elaboration in SPARK", N, Ent);
- else
- Elab_Warning
- ("call to & may raise Program_Error?l?",
- "info: call to & during elaboration?$?",
- Ent);
- end if;
+ else
+ Elab_Warning
+ ("instantiation of & may raise Program_Error?l?",
+ "info: instantiation of & during elaboration?$?", Ent);
end if;
- Error_Msg_Qual_Level := Nat'Last;
+ -- Indirect call case, info message only in static elaboration
+ -- case, because the attribute reference itself cannot raise an
+ -- exception. Note that SPARK does not permit indirect calls.
- -- Case of Elaborate_All not present and required, for SPARK this
- -- is an error, so give an error message.
+ elsif Access_Case then
+ Elab_Warning ("", "info: access to & during elaboration?$?", Ent);
- if SPARK_Mode = On then
- Error_Msg_NE
- ("\Elaborate_All pragma required for&", N, W_Scope);
+ -- Variable reference in SPARK mode
+
+ elsif Variable_Case then
+ Error_Msg_NE
+ ("reference to & during elaboration in SPARK", N, Ent);
- -- Otherwise we generate an implicit pragma. For a subprogram
- -- instantiation, Elaborate is good enough, since no transitive
- -- call is possible at elaboration time in this case.
+ -- Subprogram call case
- elsif Nkind (N) in N_Subprogram_Instantiation then
+ else
+ 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
- ("\missing pragma Elaborate for&?l?",
- "\implicit pragma Elaborate for& generated?$?",
- W_Scope);
+ ("implicit call to & may raise Program_Error?l?",
+ "info: implicit call to & during elaboration?$?",
+ Ent);
- -- For all other cases, we need an implicit Elaborate_All
+ elsif SPARK_Mode = On then
+ Error_Msg_NE ("call to & during elaboration in SPARK", N, Ent);
else
Elab_Warning
- ("\missing pragma Elaborate_All for&?l?",
- "\implicit pragma Elaborate_All for & generated?$?",
- W_Scope);
+ ("call to & may raise Program_Error?l?",
+ "info: call to & during elaboration?$?",
+ Ent);
end if;
+ end if;
- Error_Msg_Qual_Level := 0;
+ Error_Msg_Qual_Level := Nat'Last;
- -- Take into account the flags related to elaboration warning
- -- messages when enumerating the various calls involved. This
- -- ensures the proper pairing of the main warning and the
- -- clarification messages generated by Output_Calls.
+ -- Case of Elaborate_All not present and required, for SPARK this
+ -- is an error, so give an error message.
- Output_Calls (N, Check_Elab_Flag => True);
+ if SPARK_Mode = On then
+ Error_Msg_NE ("\Elaborate_All pragma required for&", N, W_Scope);
- -- Set flag to prevent further warnings for same unit unless in
- -- All_Errors_Mode.
+ -- Otherwise we generate an implicit pragma. For a subprogram
+ -- instantiation, Elaborate is good enough, since no transitive
+ -- call is possible at elaboration time in this case.
- if not All_Errors_Mode and not Dynamic_Elaboration_Checks then
- Set_Suppress_Elaboration_Warnings (W_Scope, True);
- end if;
+ elsif Nkind (N) in N_Subprogram_Instantiation then
+ Elab_Warning
+ ("\missing pragma Elaborate for&?l?",
+ "\implicit pragma Elaborate for& generated?$?",
+ W_Scope);
+
+ -- For all other cases, we need an implicit Elaborate_All
+
+ else
+ Elab_Warning
+ ("\missing pragma Elaborate_All for&?l?",
+ "\implicit pragma Elaborate_All for & generated?$?",
+ W_Scope);
end if;
- -- Check for runtime elaboration check required
+ Error_Msg_Qual_Level := 0;
- 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.
+ -- Take into account the flags related to elaboration warning
+ -- messages when enumerating the various calls involved. This
+ -- ensures the proper pairing of the main warning and the
+ -- clarification messages generated by Output_Calls.
- -- Note that for this case, we do check the real unit (the one
- -- from following renamings, since that is the issue).
+ Output_Calls (N, Check_Elab_Flag => True);
- -- Could this possibly miss a useless but required PE???
+ -- Set flag to prevent further warnings for same unit unless in
+ -- All_Errors_Mode.
- Insert_Elab_Check (N,
- Make_Attribute_Reference (Loc,
- Attribute_Name => Name_Elaborated,
- Prefix =>
- New_Occurrence_Of (Spec_Entity (E_Scope), Loc)));
+ if not All_Errors_Mode and not Dynamic_Elaboration_Checks then
+ Set_Suppress_Elaboration_Warnings (W_Scope, True);
+ end if;
+ end if;
- -- Prevent duplicate elaboration checks on the same call,
- -- which can happen if the body enclosing the call appears
- -- itself in a call whose elaboration check is delayed.
+ -- Check for runtime elaboration check required
- if Nkind (N) in N_Subprogram_Call then
- Set_No_Elaboration_Check (N);
- 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.
- -- Case of static elaboration model
+ -- Note that for this case, we do check the real unit (the one
+ -- from following renamings, since that is the issue).
- else
- -- 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
- null;
+ -- Could this possibly miss a useless but required PE???
- -- Do not generate an Elaborate_All for finalization routines
- -- which perform partial clean up as part of initialization.
+ Insert_Elab_Check (N,
+ Make_Attribute_Reference (Loc,
+ Attribute_Name => Name_Elaborated,
+ Prefix =>
+ New_Occurrence_Of (Spec_Entity (E_Scope), Loc)));
- elsif In_Init_Proc and then Is_Finalization_Procedure (Ent) then
- null;
+ -- Prevent duplicate elaboration checks on the same call,
+ -- which can happen if the body enclosing the call appears
+ -- itself in a call whose elaboration check is delayed.
- -- Here we need to generate an implicit elaborate all
+ if Nkind (N) in N_Subprogram_Call then
+ Set_No_Elaboration_Check (N);
+ end if;
+ end if;
- else
- -- Generate Elaborate_all warning unless suppressed
+ -- Case of static elaboration model
- if (Elab_Info_Messages 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
- ("info: call to& in elaboration code " &
- "requires pragma Elaborate_All on&?$?", N, E);
- end if;
+ else
+ -- 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
+ null;
+
+ -- Do not generate an Elaborate_All for finalization routines
+ -- which perform partial clean up as part of initialization.
- -- Set indication for binder to generate Elaborate_All
+ elsif In_Init_Proc and then Is_Finalization_Procedure (Ent) then
+ null;
+
+ -- Here we need to generate an implicit elaborate all
- Set_Elaboration_Constraint (N, E, W_Scope);
+ else
+ -- Generate Elaborate_All warning unless suppressed
+
+ if (Elab_Info_Messages 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
+ ("info: call to& in elaboration code " &
+ "requires pragma Elaborate_All on&?$?", N, E);
end if;
- end if;
- -- Case of entity is in same unit as call or instantiation
+ -- Set indication for binder to generate Elaborate_All
- elsif not Inter_Unit_Only then
- Check_Internal_Call (N, Ent, Outer_Scope, E);
+ Set_Elaboration_Constraint (N, E, W_Scope);
+ end if;
end if;
end Check_A_Call;
projects / gcc.git / commitdiff