2008-04-08 Robert Dewar <dewar@adacore.com>

	* errout.ads: Update comments for new handling of info: messages

	* erroutc.adb (Matches): New procedure
	(Warning_Specifically_Suppressed): Modified to handle multiple * chars
	(Is_Style_Or_Info_Msg): New name for Is_Style_Msg, now set for
	 info messages as well as style messages.

	* erroutc.ads: Remove unneeded fields from Specific_Warning_Entry

	* sem_elab.adb (Supply_Bodies): Create actual bodies for stubbed
	subprograms.
	(Check_A_Call): Special "info: " warnings now have ? in the text
	(Elab_Warning): Use info message in static case



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@134024 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 201 insertions, 166 deletions

diff --git a/gcc/ada/sem_elab.adb b/gcc/ada/sem_elab.adb
index 922a16d53ae..d61ebb09a46 100644
--- a/gcc/ada/sem_elab.adb
+++ b/gcc/ada/sem_elab.adb
@@ -58,11 +58,11 @@ with Uname;    use Uname;
 
 package body Sem_Elab is
 
-   --  The following table records the recursive call chain for output
-   --  in the Output routine. Each entry records the call node and the
-   --  entity of the called routine. The number of entries in the table
-   --  (i.e. the value of Elab_Call.Last) indicates the current depth
-   --  of recursion and is used to identify the outer level.
+   --  The following table records the recursive call chain for output in the
+   --  Output routine. Each entry records the call node and the entity of the
+   --  called routine. The number of entries in the table (i.e. the value of
+   --  Elab_Call.Last) indicates the current depth of recursion and is used to
+   --  identify the outer level.
 
    type Elab_Call_Entry is record
       Cloc : Source_Ptr;
@@ -77,10 +77,10 @@ package body Sem_Elab is
      Table_Increment      => 100,
      Table_Name           => "Elab_Call");
 
-   --  This table is initialized at the start of each outer level call.
-   --  It holds the entities for all subprograms that have been examined
-   --  for this particular outer level call, and is used to prevent both
-   --  infinite recursion, and useless reanalysis of bodies already seen
+   --  This table is initialized at the start of each outer level call. It
+   --  holds the entities for all subprograms that have been examined for this
+   --  particular outer level call, and is used to prevent both infinite
+   --  recursion, and useless reanalysis of bodies already seen
 
    package Elab_Visited is new Table.Table (
      Table_Component_Type => Entity_Id,
@@ -127,9 +127,8 @@ package body Sem_Elab is
      Table_Name           => "Delay_Check");
 
    C_Scope : Entity_Id;
-   --  Top level scope of current scope. We need to compute this only
-   --  once at the outer level, i.e. for a call to Check_Elab_Call from
-   --  outside this unit.
+   --  Top level scope of current scope. Compute this only once at the outer
+   --  level, i.e. for a call to Check_Elab_Call from outside this unit.
 
    Outer_Level_Sloc : Source_Ptr;
    --  Save Sloc value for outer level call node for comparisons of source
@@ -149,9 +148,9 @@ package body Sem_Elab is
 
    Delaying_Elab_Checks : Boolean := True;
    --  This is set True till the compilation is complete, including the
-   --  insertion of all instance bodies. Then when Check_Elab_Calls is
-   --  called, the delay table is used to make the delayed calls and
-   --  this flag is reset to False, so that the calls are processed
+   --  insertion of all instance bodies. Then when Check_Elab_Calls is called,
+   --  the delay table is used to make the delayed calls and this flag is reset
+   --  to False, so that the calls are processed
 
    -----------------------
    -- Local Subprograms --
@@ -177,16 +176,15 @@ package body Sem_Elab is
       Outer_Scope       : Entity_Id;
       Inter_Unit_Only   : Boolean;
       Generate_Warnings : Boolean := True);
-   --  This is the internal recursive routine that is called to check for
-   --  a possible elaboration error. The argument N is a subprogram call
-   --  or generic instantiation to be checked, and E is the entity of
-   --  the called subprogram, or instantiated generic unit. The flag
-   --  Outer_Scope is the outer level scope for the original call.
-   --  Inter_Unit_Only is set if the call is only to be checked in the
-   --  case where it is to another unit (and skipped if within a unit).
-   --  Generate_Warnings is set to False to suppress warning messages
-   --  about missing pragma Elaborate_All's. These messages are not
-   --  wanted for inner calls in the dynamic model.
+   --  This is the internal recursive routine that is called to check for a
+   --  possible elaboration error. The argument N is a subprogram call or
+   --  generic instantiation to be checked, and E is the entity of the called
+   --  subprogram, or instantiated generic unit. The flag Outer_Scope is the
+   --  outer level scope for the original call. Inter_Unit_Only is set if the
+   --  call is only to be checked in the case where it is to another unit (and
+   --  skipped if within a unit). Generate_Warnings is set to False to suppress
+   --  warning messages about missing pragma Elaborate_All's. These messages
+   --  are not wanted for inner calls in the dynamic model.
 
    procedure Check_Bad_Instantiation (N : Node_Id);
    --  N is a node for an instantiation (if called with any other node kind,
@@ -207,14 +205,14 @@ package body Sem_Elab is
       E           : Entity_Id;
       Outer_Scope : Entity_Id;
       Orig_Ent    : Entity_Id);
-   --  N is a function call or procedure statement call node and E is
-   --  the entity of the called function, which is within the current
-   --  compilation unit (where subunits count as part of the parent).
-   --  This call checks if this call, or any call within any accessed
-   --  body could cause an ABE, and if so, outputs a warning. Orig_Ent
-   --  differs from E only in the case of renamings, and points to the
-   --  original name of the entity. This is used for error messages.
-   --  Outer_Scope is the outer level scope for the original call.
+   --  N is a function call or procedure statement call node and E is the
+   --  entity of the called function, which is within the current compilation
+   --  unit (where subunits count as part of the parent). This call checks if
+   --  this call, or any call within any accessed body could cause an ABE, and
+   --  if so, outputs a warning. Orig_Ent differs from E only in the case of
+   --  renamings, and points to the original name of the entity. This is used
+   --  for error messages. Outer_Scope is the outer level scope for the
+   --  original call.
 
    procedure Check_Internal_Call_Continue
      (N           : Node_Id;
@@ -224,10 +222,10 @@ package body Sem_Elab is
    --  The processing for Check_Internal_Call is divided up into two phases,
    --  and this represents the second phase. The second phase is delayed if
    --  Delaying_Elab_Calls is set to True. In this delayed case, the first
-   --  phase makes an entry in the Delay_Check table, which is processed
-   --  when Check_Elab_Calls is called. N, E and Orig_Ent are as for the call
-   --  to Check_Internal_Call. Outer_Scope is the outer level scope for
-   --  the original call.
+   --  phase makes an entry in the Delay_Check table, which is processed when
+   --  Check_Elab_Calls is called. N, E and Orig_Ent are as for the call to
+   --  Check_Internal_Call. Outer_Scope is the outer level scope for the
+   --  original call.
 
    procedure Set_Elaboration_Constraint
     (Call : Node_Id;
@@ -268,16 +266,16 @@ package body Sem_Elab is
    --  inevitable, given the optional body semantics of Ada).
 
    procedure Insert_Elab_Check (N : Node_Id; C : Node_Id := Empty);
-   --  Given code for an elaboration check (or unconditional raise if
-   --  the check is not needed), inserts the code in the appropriate
-   --  place. N is the call or instantiation node for which the check
-   --  code is required. C is the test whose failure triggers the raise.
+   --  Given code for an elaboration check (or unconditional raise if the check
+   --  is not needed), inserts the code in the appropriate place. N is the call
+   --  or instantiation node for which the check code is required. C is the
+   --  test whose failure triggers the raise.
 
    procedure Output_Calls (N : Node_Id);
-   --  Outputs chain of calls stored in the Elab_Call table. The caller
-   --  has already generated the main warning message, so the warnings
-   --  generated are all continuation messages. The argument is the
-   --  call node at which the messages are to be placed.
+   --  Outputs chain of calls stored in the Elab_Call table. The caller has
+   --  already generated the main warning message, so the warnings generated
+   --  are all continuation messages. The argument is the call node at which
+   --  the messages are to be placed.
 
    function Same_Elaboration_Scope (Scop1, Scop2 : Entity_Id) return Boolean;
    --  Given two scopes, determine whether they are the same scope from an
@@ -288,17 +286,16 @@ package body Sem_Elab is
    --  to be the enclosing compilation unit of this scope.
 
    function Spec_Entity (E : Entity_Id) return Entity_Id;
-   --  Given a compilation unit entity, if it is a spec entity, it is
-   --  returned unchanged. If it is a body entity, then the spec for
-   --  the corresponding spec is returned
+   --  Given a compilation unit entity, if it is a spec entity, it is returned
+   --  unchanged. If it is a body entity, then the spec for the corresponding
+   --  spec is returned
 
    procedure Supply_Bodies (N : Node_Id);
    --  Given a node, N, that is either a subprogram declaration or a package
    --  declaration, this procedure supplies dummy bodies for the subprogram
    --  or for all subprograms in the package. If the given node is not one
    --  of these two possibilities, then Supply_Bodies does nothing. The
-   --  dummy body is supplied by setting the subprogram to be Imported with
-   --  convention Stubbed.
+   --  dummy body contains a single Raise statement.
 
    procedure Supply_Bodies (L : List_Id);
    --  Calls Supply_Bodies for all elements of the given list L
@@ -480,11 +477,10 @@ package body Sem_Elab is
       Decl : Node_Id;
 
       E_Scope : Entity_Id;
-      --  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.
+      --  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
@@ -531,8 +527,8 @@ package body Sem_Elab is
          return;
       end if;
 
-      --  Go to parent for derived subprogram, or to original subprogram
-      --  in the case of a renaming (Alias covers both these cases)
+      --  Go to parent for derived subprogram, or to original subprogram in the
+      --  case of a renaming (Alias covers both these cases).
 
       Ent := E;
       loop
@@ -646,16 +642,16 @@ package body Sem_Elab is
             return;
          end if;
 
-         --  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.
+         --  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 Is_Generic_Instance (Ent) and not Dynamic_Elaboration_Checks then
             return;
          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
+         --  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.
@@ -762,8 +758,8 @@ package body Sem_Elab is
          then
             E_Scope := Spec_Entity (Cunit_Entity (Unit_Caller));
 
-            --  If we don't get a spec entity, just ignore call. Not
-            --  quite clear why this check is necessary.
+            --  If we don't get a spec entity, just ignore call. Not quite
+            --  clear why this check is necessary. ???
 
             if No (E_Scope) then
                return;
@@ -775,16 +771,15 @@ package body Sem_Elab is
                E_Scope := Scope (E_Scope);
             end loop;
 
-         --  For the case N is not an instance, or a call within instance
-         --  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.
+         --  For the case N is not an instance, or a call within instance, 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.
 
          else
-            --  Loop to carefully follow renamings and derivations
-            --  one step outside the current unit, but not further.
+            --  Loop to carefully follow renamings and derivations one step
+            --  outside the current unit, but not further.
 
             if not Inst_Case
               and then Present (Alias (Ent))
@@ -879,7 +874,7 @@ package body Sem_Elab is
                if Inst_Case then
                   Elab_Warning
                     ("instantiation of& may raise Program_Error?",
-                     "instantiation of& during elaboration?", Ent);
+                     "info: instantiation of& during elaboration?", Ent);
 
                else
                   if Nkind (Name (N)) in N_Has_Entity
@@ -888,13 +883,13 @@ package body Sem_Elab is
                   then
                      Elab_Warning
                        ("implicit call to & may raise Program_Error?",
-                        "implicit call to & during elaboration?",
+                        "info: implicit call to & during elaboration?",
                         Ent);
 
                   else
                      Elab_Warning
                        ("call to & may raise Program_Error?",
-                        "call to & during elaboration?",
+                        "info: call to & during elaboration?",
                         Ent);
                   end if;
                end if;
@@ -904,12 +899,12 @@ package body Sem_Elab is
                if Nkind (N) in N_Subprogram_Instantiation then
                   Elab_Warning
                     ("\missing pragma Elaborate for&?",
-                     "\implicit pragma Elaborate for& generated?",
+                     "\info: implicit pragma Elaborate for& generated?",
                      W_Scope);
                else
                   Elab_Warning
                     ("\missing pragma Elaborate_All for&?",
-                     "\implicit pragma Elaborate_All for & generated?",
+                     "\info: implicit pragma Elaborate_All for & generated?",
                      W_Scope);
                end if;
             end Generate_Elab_Warnings;
@@ -936,8 +931,8 @@ package body Sem_Elab is
                --  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!)
+               --  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???
 
@@ -952,10 +947,10 @@ package body Sem_Elab is
          --  Case of static elaboration model
 
          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.
+            --  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)
@@ -1111,7 +1106,7 @@ package body Sem_Elab is
       function Get_Called_Ent return Entity_Id;
       --  Retrieve called entity. If this is a call to a protected subprogram,
       --  entity is a selected component. The callable entity may be absent,
-      --  in which case there is no check to perform.  This happens with
+      --  in which case there is no check to perform. This happens with
       --  non-analyzed calls in nested generics.
 
       --------------------
@@ -1201,8 +1196,8 @@ package body Sem_Elab is
       --  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).
 
-      --  However, we have to check calls within component definitions (e.g., a
-      --  function call that determines an array component bound), so we
+      --  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);
@@ -1229,8 +1224,8 @@ package body Sem_Elab is
       if No (Outer_Scope) then
          Elab_Visited.Set_Last (0);
 
-         --  Nothing to do if current scope is Standard (this is a bit
-         --  odd, but it happens in the case of generic instantiations).
+         --  Nothing to do if current scope is Standard (this is a bit odd, but
+         --  it happens in the case of generic instantiations).
 
          C_Scope := Current_Scope;
 
@@ -1243,9 +1238,8 @@ package body Sem_Elab is
          From_Elab_Code := not In_Subprogram_Or_Concurrent_Unit;
          if From_Elab_Code then
 
-            --  Complain if call that comes from source in preelaborated
-            --  unit and we are not inside a subprogram (i.e. we are in
-            --  elab code)
+            --  Complain if call that comes from source in preelaborated unit
+            --  and we are not inside a subprogram (i.e. we are in elab code).
 
             if Comes_From_Source (N)
               and then In_Preelaborated_Unit
@@ -1456,9 +1450,9 @@ package body Sem_Elab is
 
       --  A call to an Init_Proc in elaboration code may bring additional
       --  dependencies, if some of the record components thereof have
-      --  initializations that are function calls that come from source.
-      --  We treat the current node as a call to each of these functions,
-      --  to check their elaboration impact.
+      --  initializations that are function calls that come from source. We
+      --  treat the current node as a call to each of these functions, to check
+      --  their elaboration impact.
 
       if Is_Init_Proc (Ent)
         and then From_Elab_Code
@@ -1521,9 +1515,9 @@ package body Sem_Elab is
       Pkg_Body : Entity_Id;
 
    begin
-      --  For record or array component, check prefix. If it is an access
-      --  type, then there is nothing to do (we do not know what is being
-      --  assigned), but otherwise this is an assignment to the prefix.
+      --  For record or array component, check prefix. If it is an access type,
+      --  then there is nothing to do (we do not know what is being assigned),
+      --  but otherwise this is an assignment to the prefix.
 
       if Nkind (N) = N_Indexed_Component
            or else
@@ -1712,10 +1706,10 @@ package body Sem_Elab is
 
    procedure Check_Elab_Calls is
    begin
-      --  If expansion is disabled, do not generate any checks. Also
-      --  skip checks if any subunits are missing because in either
-      --  case we lack the full information that we need, and no object
-      --  file will be created in any case.
+      --  If expansion is disabled, do not generate any checks. Also skip
+      --  checks if any subunits are missing because in either case we lack the
+      --  full information that we need, and no object file will be created in
+      --  any case.
 
       if not Expander_Active
         or else Is_Generic_Unit (Cunit_Entity (Main_Unit))
@@ -1822,11 +1816,11 @@ package body Sem_Elab is
          Set_C_Scope;
          Check_A_Call (N, Ent, Scope (Ent), Inter_Unit_Only => False);
 
-      --  If none of those cases holds, but Dynamic_Elaboration_Checks mode
-      --  is set, then we will do the check, but only in the inter-unit case
-      --  (this is to accommodate unguarded elaboration calls from other units
-      --  in which this same mode is set). We inhibit warnings in this case,
-      --  since this instantiation is not occurring in elaboration code.
+      --  If none of those cases holds, but Dynamic_Elaboration_Checks mode is
+      --  set, then we will do the check, but only in the inter-unit case (this
+      --  is to accommodate unguarded elaboration calls from other units in
+      --  which this same mode is set). We inhibit warnings in this case, since
+      --  this instantiation is not occurring in elaboration code.
 
       elsif Dynamic_Elaboration_Checks then
          Set_C_Scope;
@@ -1882,10 +1876,10 @@ package body Sem_Elab is
       elsif not Full_Analysis then
          return;
 
-      --  Nothing to do if within a default expression, since the call
-      --  is not actualy being made at this time.
+      --  Nothing to do if analyzing in special spec-expression mode, since the
+      --  call is not actualy being made at this time.
 
-      elsif In_Default_Expression then
+      elsif In_Spec_Expression then
          return;
 
       --  Nothing to do for call to intrinsic subprogram
@@ -1991,16 +1985,16 @@ package body Sem_Elab is
             Check_Elab_Instantiation (N, Outer_Scope);
             return OK;
 
-         --  Skip subprogram bodies that come from source (wait for
-         --  call to analyze these). The reason for the come from
-         --  source test is to avoid catching task bodies.
+         --  Skip subprogram bodies that come from source (wait for call to
+         --  analyze these). The reason for the come from source test is to
+         --  avoid catching task bodies.
 
-         --  For task bodies, we should really avoid these too, waiting
-         --  for the task activation, but that's too much trouble to
-         --  catch for now, so we go in unconditionally. This is not
-         --  so terrible, it means the error backtrace is not quite
-         --  complete, and we are too eager to scan bodies of tasks
-         --  that are unused, but this is hardly very significant!
+         --  For task bodies, we should really avoid these too, waiting for the
+         --  task activation, but that's too much trouble to catch for now, so
+         --  we go in unconditionally. This is not so terrible, it means the
+         --  error backtrace is not quite complete, and we are too eager to
+         --  scan bodies of tasks that are unused, but this is hardly very
+         --  significant!
 
          elsif Nkind (N) = N_Subprogram_Body
            and then Comes_From_Source (N)
@@ -2051,8 +2045,8 @@ package body Sem_Elab is
          end if;
       end if;
 
-      --  If the body appears after the outer level call or
-      --  instantiation then we have an error case handled below.
+      --  If the body appears after the outer level call or instantiation then
+      --  we have an error case handled below.
 
       if Earlier_In_Extended_Unit (Outer_Level_Sloc, Sloc (Sbody))
         and then not In_Task_Activation
@@ -2065,8 +2059,8 @@ package body Sem_Elab is
       elsif Inst_Case then
          return;
 
-      --  Otherwise we have a call, so we trace through the called
-      --  body to see if it has any problems ..
+      --  Otherwise we have a call, so we trace through the called body to see
+      --  if it has any problems.
 
       else
          pragma Assert (Nkind (Sbody) = N_Subprogram_Body);
@@ -2083,9 +2077,9 @@ package body Sem_Elab is
             Write_Eol;
          end if;
 
-         --  Now traverse declarations and statements of subprogram body.
-         --  Note that we cannot simply Traverse (Sbody), since traverse
-         --  does not normally visit subprogram bodies.
+         --  Now traverse declarations and statements of subprogram body. Note
+         --  that we cannot simply Traverse (Sbody), since traverse does not
+         --  normally visit subprogram bodies.
 
          declare
             Decl : Node_Id;
@@ -2103,11 +2097,11 @@ package body Sem_Elab is
          return;
       end if;
 
-      --  Here is the case of calling a subprogram where the body has
-      --  not yet been encountered, a warning message is needed.
+      --  Here is the case of calling a subprogram where the body has not yet
+      --  been encountered, a warning message is needed.
 
-      --  If we have nothing in the call stack, then this is at the
-      --  outer level, and the ABE is bound to occur.
+      --  If we have nothing in the call stack, then this is at the outer
+      --  level, and the ABE is bound to occur.
 
       if Elab_Call.Last = 0 then
          if Inst_Case then
@@ -2477,8 +2471,8 @@ package body Sem_Elab is
                        and then Present (Parameter_Associations (Call))
                        and then Is_Controlled (Etype (First_Actual (Call)));
    begin
-      --  If the unit is mentioned in a with_clause of the current
-      --  unit, it is visible, and we can set the elaboration flag.
+      --  If the unit is mentioned in a with_clause of the current unit, it is
+      --  visible, and we can set the elaboration flag.
 
       if Is_Immediately_Visible (Scop)
         or else (Is_Child_Unit (Scop) and then Is_Visible_Child_Unit (Scop))
@@ -2505,9 +2499,9 @@ package body Sem_Elab is
          return;
       end if;
 
-      --  If the unit is not in the context, there must be an intermediate
-      --  unit that is, on which we need to place to elaboration flag. This
-      --  happens with init proc calls.
+      --  If the unit is not in the context, there must be an intermediate unit
+      --  that is, on which we need to place to elaboration flag. This happens
+      --  with init proc calls.
 
       if Is_Init_Proc (Subp)
         or else Init_Call
@@ -2561,30 +2555,29 @@ package body Sem_Elab is
 
       function Find_Body_In (E : Entity_Id; N : Node_Id) return Node_Id;
       --  Determine if the list of nodes headed by N and linked by Next
-      --  contains a package body for the package spec entity E, and if
-      --  so return the package body. If not, then returns Empty.
+      --  contains a package body for the package spec entity E, and if so
+      --  return the package body. If not, then returns Empty.
 
       function Load_Package_Body (Nam : Unit_Name_Type) return Node_Id;
       --  This procedure is called load the unit whose name is given by Nam.
       --  This unit is being loaded to see whether it contains an optional
-      --  generic body. The returned value is the loaded unit, which is
-      --  always a package body (only package bodies can contain other
-      --  entities in the sense in which Has_Generic_Body is interested).
-      --  We only attempt to load bodies if we are generating code. If we
-      --  are in semantics check only mode, then it would be wrong to load
-      --  bodies that are not required from a semantic point of view, so
-      --  in this case we return Empty. The result is that the caller may
-      --  incorrectly decide that a generic spec does not have a body when
-      --  in fact it does, but the only harm in this is that some warnings
-      --  on elaboration problems may be lost in semantic checks only mode,
-      --  which is not big loss. We also return Empty if we go for a body
-      --  and it is not there.
+      --  generic body. The returned value is the loaded unit, which is always
+      --  a package body (only package bodies can contain other entities in the
+      --  sense in which Has_Generic_Body is interested). We only attempt to
+      --  load bodies if we are generating code. If we are in semantics check
+      --  only mode, then it would be wrong to load bodies that are not
+      --  required from a semantic point of view, so in this case we return
+      --  Empty. The result is that the caller may incorrectly decide that a
+      --  generic spec does not have a body when in fact it does, but the only
+      --  harm in this is that some warnings on elaboration problems may be
+      --  lost in semantic checks only mode, which is not big loss. We also
+      --  return Empty if we go for a body and it is not there.
 
       function Locate_Corresponding_Body (PE : Entity_Id) return Node_Id;
       --  PE is the entity for a package spec. This function locates the
-      --  corresponding package body, returning Empty if none is found.
-      --  The package body returned is fully parsed but may not yet be
-      --  analyzed, so only syntactic fields should be referenced.
+      --  corresponding package body, returning Empty if none is found. The
+      --  package body returned is fully parsed but may not yet be analyzed,
+      --  so only syntactic fields should be referenced.
 
       ------------------
       -- Find_Body_In --
@@ -2666,17 +2659,17 @@ package body Sem_Elab is
       begin
          if Is_Library_Level_Entity (PE) then
 
-            --  If package is a library unit that requires a body, we have
-            --  no choice but to go after that body because it might contain
-            --  an optional body for the original generic package.
+            --  If package is a library unit that requires a body, we have no
+            --  choice but to go after that body because it might contain an
+            --  optional body for the original generic package.
 
             if Unit_Requires_Body (PE) then
 
-               --  Load the body. Note that we are a little careful here to
-               --  use Spec to get the unit number, rather than PE or Decl,
-               --  since in the case where the package is itself a library
-               --  level instantiation, Spec will properly reference the
-               --  generic template, which is what we really want.
+               --  Load the body. Note that we are a little careful here to use
+               --  Spec to get the unit number, rather than PE or Decl, since
+               --  in the case where the package is itself a library level
+               --  instantiation, Spec will properly reference the generic
+               --  template, which is what we really want.
 
                return
                  Load_Package_Body
@@ -3041,8 +3034,55 @@ package body Sem_Elab is
          declare
             Ent : constant Entity_Id := Defining_Unit_Name (Specification (N));
          begin
-            Set_Is_Imported (Ent);
-            Set_Convention  (Ent, Convention_Stubbed);
+
+            --  Internal subprograms will already have a generated body, so
+            --  there is no need to provide a stub for them.
+
+            if No (Corresponding_Body (N)) then
+               declare
+                  Loc : constant Source_Ptr := Sloc (N);
+                  B : Node_Id;
+                  Formals : constant List_Id :=
+                     Copy_Parameter_List (Ent);
+                  Nam  : constant Entity_Id :=
+                    Make_Defining_Identifier (Loc, Chars (Ent));
+                  Spec : Node_Id;
+                  Stats : constant List_Id :=
+                    New_List
+                      (Make_Raise_Program_Error (Loc,
+                         Reason => PE_Access_Before_Elaboration));
+               begin
+                  if Ekind (Ent) = E_Function then
+                     Spec :=
+                        Make_Function_Specification (Loc,
+                          Defining_Unit_Name => Nam,
+                          Parameter_Specifications => Formals,
+                          Result_Definition =>
+                            New_Copy_Tree
+                              (Result_Definition (Specification (N))));
+
+                     --  We cannot reliably make a return statement for this
+                     --  body, but none is needed because the call raises
+                     --  program error.
+
+                     Set_Return_Present (Ent);
+
+                  else
+                     Spec :=
+                        Make_Procedure_Specification (Loc,
+                          Defining_Unit_Name => Nam,
+                          Parameter_Specifications => Formals);
+                  end if;
+
+                  B := Make_Subprogram_Body (Loc,
+                          Specification => Spec,
+                          Declarations => New_List,
+                          Handled_Statement_Sequence =>
+                            Make_Handled_Sequence_Of_Statements (Loc,  Stats));
+                  Insert_After (N, B);
+                  Analyze (B);
+               end;
+            end if;
          end;
 
       elsif Nkind (N) = N_Package_Declaration then
@@ -3075,22 +3115,17 @@ package body Sem_Elab is
 
    function Within (E1, E2 : Entity_Id) return Boolean is
       Scop : Entity_Id;
-
    begin
       Scop := E1;
       loop
          if Scop = E2 then
             return True;
-
          elsif Scop = Standard_Standard then
             return False;
-
          else
             Scop := Scope (Scop);
          end if;
       end loop;
-
-      raise Program_Error;
    end Within;
 
    --------------------------