Subversion Repositories openrisc_2011-10-31

------------------------------------------------------------------------------

--                                                                          --

--                         GNAT COMPILER COMPONENTS                         --

--                                                                          --

--                             S E M _ C H 1 0                              --

--                                                                          --

--                                 B o d y                                  --

--                                                                          --

--          Copyright (C) 1992-2009, 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- --

-- ware  Foundation;  either version 3,  or (at your option) any later ver- --

-- sion.  GNAT is distributed in the hope that it will be useful, but WITH- --

-- OUT ANY WARRANTY;  without even the  implied warranty of MERCHANTABILITY --

-- or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License --

-- for  more details.  You should have  received  a copy of the GNU General --

-- Public License  distributed with GNAT; see file COPYING3.  If not, go to --

-- http://www.gnu.org/licenses for a complete copy of the license.          --

--                                                                          --

-- GNAT was originally developed  by the GNAT team at  New York University. --

-- Extensive contributions were provided by Ada Core Technologies Inc.      --

--                                                                          --

------------------------------------------------------------------------------

with Atree;    use Atree;

with Debug;    use Debug;

with Einfo;    use Einfo;

with Errout;   use Errout;

with Exp_Util; use Exp_Util;

with Elists;   use Elists;

with Fname;    use Fname;

with Fname.UF; use Fname.UF;

with Freeze;   use Freeze;

with Impunit;  use Impunit;

with Inline;   use Inline;

with Lib;      use Lib;

with Lib.Load; use Lib.Load;

with Lib.Xref; use Lib.Xref;

with Namet;    use Namet;

with Nlists;   use Nlists;

with Nmake;    use Nmake;

with Opt;      use Opt;

with Output;   use Output;

with Par_SCO;  use Par_SCO;

with Restrict; use Restrict;

with Rident;   use Rident;

with Rtsfind;  use Rtsfind;

with Sem;      use Sem;

with Sem_Ch3;  use Sem_Ch3;

with Sem_Ch6;  use Sem_Ch6;

with Sem_Ch7;  use Sem_Ch7;

with Sem_Ch8;  use Sem_Ch8;

with Sem_Dist; use Sem_Dist;

with Sem_Prag; use Sem_Prag;

with Sem_Util; use Sem_Util;

with Sem_Warn; use Sem_Warn;

with Stand;    use Stand;

with Sinfo;    use Sinfo;

with Sinfo.CN; use Sinfo.CN;

with Sinput;   use Sinput;

with Snames;   use Snames;

with Style;    use Style;

with Stylesw;  use Stylesw;

with Tbuild;   use Tbuild;

with Uname;    use Uname;

package body Sem_Ch10 is

   -----------------------

   -- Local Subprograms --

   -----------------------

   procedure Analyze_Context (N : Node_Id);

   --  Analyzes items in the context clause of compilation unit

   procedure Build_Limited_Views (N : Node_Id);

   --  Build and decorate the list of shadow entities for a package mentioned

   --  in a limited_with clause. If the package was not previously analyzed

   --  then it also performs a basic decoration of the real entities. This is

   --  required to do not pass non-decorated entities to the back-end.

   --  Implements Ada 2005 (AI-50217).

   procedure Check_Body_Needed_For_SAL (Unit_Name : Entity_Id);

   --  Check whether the source for the body of a compilation unit must be

   --  included in a standalone library.

   procedure Check_Private_Child_Unit (N : Node_Id);

   --  If a with_clause mentions a private child unit, the compilation

   --  unit must be a member of the same family, as described in 10.1.2.

   procedure Check_Stub_Level (N : Node_Id);

   --  Verify that a stub is declared immediately within a compilation unit,

   --  and not in an inner frame.

   procedure Expand_With_Clause (Item : Node_Id; Nam : Node_Id; N : Node_Id);

   --  When a child unit appears in a context clause, the implicit withs on

   --  parents are made explicit, and with clauses are inserted in the context

   --  clause before the one for the child. If a parent in the with_clause

   --  is a renaming, the implicit with_clause is on the renaming whose name

   --  is mentioned in the with_clause, and not on the package it renames.

   --  N is the compilation unit whose list of context items receives the

   --  implicit with_clauses.

   function Get_Parent_Entity (Unit : Node_Id) return Entity_Id;

   --  Get defining entity of parent unit of a child unit. In most cases this

   --  is the defining entity of the unit, but for a child instance whose

   --  parent needs a body for inlining, the instantiation node of the parent

   --  has not yet been rewritten as a package declaration, and the entity has

   --  to be retrieved from the Instance_Spec of the unit.

   function Has_With_Clause

     (C_Unit     : Node_Id;

      Pack       : Entity_Id;

      Is_Limited : Boolean := False) return Boolean;

   --  Determine whether compilation unit C_Unit contains a [limited] with

   --  clause for package Pack. Use the flag Is_Limited to designate desired

   --  clause kind.

   procedure Implicit_With_On_Parent (Child_Unit : Node_Id; N : Node_Id);

   --  If the main unit is a child unit, implicit withs are also added for

   --  all its ancestors.

   function In_Chain (E : Entity_Id) return Boolean;

   --  Check that the shadow entity is not already in the homonym chain, for

   --  example through a limited_with clause in a parent unit.

   procedure Install_Context_Clauses (N : Node_Id);

   --  Subsidiary to Install_Context and Install_Parents. Process only with_

   --  and use_clauses for current unit and its library unit if any.

   procedure Install_Limited_Context_Clauses (N : Node_Id);

   --  Subsidiary to Install_Context. Process only limited with_clauses for

   --  current unit. Implements Ada 2005 (AI-50217).

   procedure Install_Limited_Withed_Unit (N : Node_Id);

   --  Place shadow entities for a limited_with package in the visibility

   --  structures for the current compilation. Implements Ada 2005 (AI-50217).

   procedure Install_Withed_Unit

     (With_Clause     : Node_Id;

      Private_With_OK : Boolean := False);

   --  If the unit is not a child unit, make unit immediately visible. The

   --  caller ensures that the unit is not already currently installed. The

   --  flag Private_With_OK is set true in Install_Private_With_Clauses, which

   --  is called when compiling the private part of a package, or installing

   --  the private declarations of a parent unit.

   procedure Install_Parents (Lib_Unit : Node_Id; Is_Private : Boolean);

   --  This procedure establishes the context for the compilation of a child

   --  unit. If Lib_Unit is a child library spec then the context of the parent

   --  is installed, and the parent itself made immediately visible, so that

   --  the child unit is processed in the declarative region of the parent.

   --  Install_Parents makes a recursive call to itself to ensure that all

   --  parents are loaded in the nested case. If Lib_Unit is a library body,

   --  the only effect of Install_Parents is to install the private decls of

   --  the parents, because the visible parent declarations will have been

   --  installed as part of the context of the corresponding spec.

   procedure Install_Siblings (U_Name : Entity_Id; N : Node_Id);

   --  In the compilation of a child unit, a child of any of the  ancestor

   --  units is directly visible if it is visible, because the parent is in

   --  an enclosing scope. Iterate over context to find child units of U_Name

   --  or of some ancestor of it.

   function Is_Child_Spec (Lib_Unit : Node_Id) return Boolean;

   --  Lib_Unit is a library unit which may be a spec or a body. Is_Child_Spec

   --  returns True if Lib_Unit is a library spec which is a child spec, i.e.

   --  a library spec that has a parent. If the call to Is_Child_Spec returns

   --  True, then Parent_Spec (Lib_Unit) is non-Empty and points to the

   --  compilation unit for the parent spec.

   --

   --  Lib_Unit can also be a subprogram body that acts as its own spec. If the

   --  Parent_Spec is non-empty, this is also a child unit.

   procedure Remove_Context_Clauses (N : Node_Id);

   --  Subsidiary of previous one. Remove use_ and with_clauses

   procedure Remove_Limited_With_Clause (N : Node_Id);

   --  Remove from visibility the shadow entities introduced for a package

   --  mentioned in a limited_with clause. Implements Ada 2005 (AI-50217).

   procedure Remove_Parents (Lib_Unit : Node_Id);

   --  Remove_Parents checks if Lib_Unit is a child spec. If so then the parent

   --  contexts established by the corresponding call to Install_Parents are

   --  removed. Remove_Parents contains a recursive call to itself to ensure

   --  that all parents are removed in the nested case.

   procedure Remove_Unit_From_Visibility (Unit_Name : Entity_Id);

   --  Reset all visibility flags on unit after compiling it, either as a

   --  main unit or as a unit in the context.

   procedure Unchain (E : Entity_Id);

   --  Remove single entity from visibility list

   procedure Analyze_Proper_Body (N : Node_Id; Nam : Entity_Id);

   --  Common processing for all stubs (subprograms, tasks, packages, and

   --  protected cases). N is the stub to be analyzed. Once the subunit

   --  name is established, load and analyze. Nam is the non-overloadable

   --  entity for which the proper body provides a completion. Subprogram

   --  stubs are handled differently because they can be declarations.

   procedure sm;

   --  A dummy procedure, for debugging use, called just before analyzing the

   --  main unit (after dealing with any context clauses).

   --------------------------

   -- Limited_With_Clauses --

   --------------------------

   --  Limited_With clauses are the mechanism chosen for Ada05 to support

   --  mutually recursive types declared in different units. A limited_with

   --  clause that names package P in the context of unit U makes the types

   --  declared in the visible part of P available within U, but with the

   --  restriction that these types can only be used as incomplete types.

   --  The limited_with clause does not impose a semantic dependence on P,

   --  and it is possible for two packages to have limited_with_clauses on

   --  each other without creating an elaboration circularity.

   --  To support this feature, the analysis of a limited_with clause must

   --  create an abbreviated view of the package, without performing any

   --  semantic analysis on it. This "package abstract" contains shadow

   --  types that are in one-one correspondence with the real types in the

   --  package, and that have the properties of incomplete types.

   --  The implementation creates two element lists: one to chain the shadow

   --  entities, and one to chain the corresponding type entities in the tree

   --  of the package. Links between corresponding entities in both chains

   --  allow the compiler to select the proper view of a given type, depending

   --  on the context. Note that in contrast with the handling of private

   --  types, the limited view and the non-limited view of a type are treated

   --  as separate entities, and no entity exchange needs to take place, which

   --  makes the implementation must simpler than could be feared.

   ------------------------------

   -- Analyze_Compilation_Unit --

   ------------------------------

   procedure Analyze_Compilation_Unit (N : Node_Id) is

      Unit_Node     : constant Node_Id := Unit (N);

      Lib_Unit      : Node_Id          := Library_Unit (N);

      Spec_Id       : Entity_Id;

      Main_Cunit    : constant Node_Id := Cunit (Main_Unit);

      Par_Spec_Name : Unit_Name_Type;

      Unum          : Unit_Number_Type;

      procedure Check_Redundant_Withs

        (Context_Items      : List_Id;

         Spec_Context_Items : List_Id := No_List);

      --  Determine whether the context list of a compilation unit contains

      --  redundant with clauses. When checking body clauses against spec

      --  clauses, set Context_Items to the context list of the body and

      --  Spec_Context_Items to that of the spec. Parent packages are not

      --  examined for documentation purposes.

      procedure Generate_Parent_References (N : Node_Id; P_Id : Entity_Id);

      --  Generate cross-reference information for the parents of child units.

      --  N is a defining_program_unit_name, and P_Id is the immediate parent.

      ---------------------------

      -- Check_Redundant_Withs --

      ---------------------------

      procedure Check_Redundant_Withs

        (Context_Items      : List_Id;

         Spec_Context_Items : List_Id := No_List)

      is

         Clause : Node_Id;

         procedure Process_Body_Clauses

          (Context_List      : List_Id;

           Clause            : Node_Id;

           Used              : in out Boolean;

           Used_Type_Or_Elab : in out Boolean);

         --  Examine the context clauses of a package body, trying to match

         --  the name entity of Clause with any list element. If the match

         --  occurs on a use package clause, set Used to True, for a use

         --  type clause, pragma Elaborate or pragma Elaborate_All, set

         --  Used_Type_Or_Elab to True.

         procedure Process_Spec_Clauses

          (Context_List : List_Id;

           Clause       : Node_Id;

           Used         : in out Boolean;

           Withed       : in out Boolean;

           Exit_On_Self : Boolean := False);

         --  Examine the context clauses of a package spec, trying to match

         --  the name entity of Clause with any list element. If the match

         --  occurs on a use package clause, set Used to True, for a with

         --  package clause other than Clause, set Withed to True. Limited

         --  with clauses, implicitly generated with clauses and withs

         --  having pragmas Elaborate or Elaborate_All applied to them are

         --  skipped. Exit_On_Self is used to control the search loop and

         --  force an exit whenever Clause sees itself in the search.

         --------------------------

         -- Process_Body_Clauses --

         --------------------------

         procedure Process_Body_Clauses

          (Context_List      : List_Id;

           Clause            : Node_Id;

           Used              : in out Boolean;

           Used_Type_Or_Elab : in out Boolean)

         is

            Nam_Ent   : constant Entity_Id := Entity (Name (Clause));

            Cont_Item : Node_Id;

            Prag_Unit : Node_Id;

            Subt_Mark : Node_Id;

            Use_Item  : Node_Id;

            function Same_Unit (N : Node_Id; P : Entity_Id) return Boolean;

            --  In an expanded name in a use clause, if the prefix is a

            --  renamed package, the entity is set to the original package

            --  as a result, when checking whether the package appears in a

            --  previous with_clause, the renaming has to be taken into

            --  account, to prevent spurious or incorrect warnings. The

            --  common case is the use of Text_IO.

            ---------------

            -- Same_Unit --

            ---------------

            function Same_Unit (N : Node_Id; P : Entity_Id) return Boolean is

            begin

               return Entity (N) = P

                 or else

                   (Present (Renamed_Object (P))

                     and then Entity (N) = Renamed_Object (P));

            end Same_Unit;

         --  Start of processing for Process_Body_Clauses

         begin

            Used := False;

            Used_Type_Or_Elab := False;

            Cont_Item := First (Context_List);

            while Present (Cont_Item) loop

               --  Package use clause

               if Nkind (Cont_Item) = N_Use_Package_Clause

                 and then not Used

               then

                  --  Search through use clauses

                  Use_Item := First (Names (Cont_Item));

                  while Present (Use_Item) and then not Used loop

                     --  Case of a direct use of the one we are looking for

                     if Entity (Use_Item) = Nam_Ent then

                        Used := True;

                     --  Handle nested case, as in "with P; use P.Q.R"

                     else

                        declare

                           UE : Node_Id;

                        begin

                           --  Loop through prefixes looking for match

                           UE := Use_Item;

                           while Nkind (UE) = N_Expanded_Name loop

                              if Same_Unit (Prefix (UE), Nam_Ent) then

                                 Used := True;

                                 exit;

                              end if;

                              UE := Prefix (UE);

                           end loop;

                        end;

                     end if;

                     Next (Use_Item);

                  end loop;

               --  USE TYPE clause

               elsif Nkind (Cont_Item) = N_Use_Type_Clause

                 and then not Used_Type_Or_Elab

               then

                  Subt_Mark := First (Subtype_Marks (Cont_Item));

                  while Present (Subt_Mark)

                    and then not Used_Type_Or_Elab

                  loop

                     if Same_Unit (Prefix (Subt_Mark), Nam_Ent) then

                        Used_Type_Or_Elab := True;

                     end if;

                     Next (Subt_Mark);

                  end loop;

               --  Pragma Elaborate or Elaborate_All

               elsif Nkind (Cont_Item) = N_Pragma

                 and then

                   (Pragma_Name (Cont_Item) = Name_Elaborate

                      or else

                    Pragma_Name (Cont_Item) = Name_Elaborate_All)

                 and then not Used_Type_Or_Elab

               then

                  Prag_Unit :=

                    First (Pragma_Argument_Associations (Cont_Item));

                  while Present (Prag_Unit)

                    and then not Used_Type_Or_Elab

                  loop

                     if Entity (Expression (Prag_Unit)) = Nam_Ent then

                        Used_Type_Or_Elab := True;

                     end if;

                     Next (Prag_Unit);

                  end loop;

               end if;

               Next (Cont_Item);

            end loop;

         end Process_Body_Clauses;

         --------------------------

         -- Process_Spec_Clauses --

         --------------------------

         procedure Process_Spec_Clauses

          (Context_List : List_Id;

           Clause       : Node_Id;

           Used         : in out Boolean;

           Withed       : in out Boolean;

           Exit_On_Self : Boolean := False)

         is

            Nam_Ent   : constant Entity_Id := Entity (Name (Clause));

            Cont_Item : Node_Id;

            Use_Item  : Node_Id;

         begin

            Used := False;

            Withed := False;

            Cont_Item := First (Context_List);

            while Present (Cont_Item) loop

               --  Stop the search since the context items after Cont_Item

               --  have already been examined in a previous iteration of

               --  the reverse loop in Check_Redundant_Withs.

               if Exit_On_Self

                 and Cont_Item = Clause

               then

                  exit;

               end if;

               --  Package use clause

               if Nkind (Cont_Item) = N_Use_Package_Clause

                 and then not Used

               then

                  Use_Item := First (Names (Cont_Item));

                  while Present (Use_Item) and then not Used loop

                     if Entity (Use_Item) = Nam_Ent then

                        Used := True;

                     end if;

                     Next (Use_Item);

                  end loop;

               --  Package with clause. Avoid processing self, implicitly

               --  generated with clauses or limited with clauses. Note

               --  that we examine with clauses having pragmas Elaborate

               --  or Elaborate_All applied to them due to cases such as:

               --

               --     with Pack;

               --     with Pack;

               --     pragma Elaborate (Pack);

               --

               --  In this case, the second with clause is redundant since

               --  the pragma applies only to the first "with Pack;".

               elsif Nkind (Cont_Item) = N_With_Clause

                 and then not Implicit_With (Cont_Item)

                 and then not Limited_Present (Cont_Item)

                 and then Cont_Item /= Clause

                 and then Entity (Name (Cont_Item)) = Nam_Ent

               then

                  Withed := True;

               end if;

               Next (Cont_Item);

            end loop;

         end Process_Spec_Clauses;

      --  Start of processing for Check_Redundant_Withs

      begin

         Clause := Last (Context_Items);

         while Present (Clause) loop

            --  Avoid checking implicitly generated with clauses, limited

            --  with clauses or withs that have pragma Elaborate or

            --  Elaborate_All applied.

            if Nkind (Clause) = N_With_Clause

              and then not Implicit_With (Clause)

              and then not Limited_Present (Clause)

              and then not Elaborate_Present (Clause)

            then

               --  Package body-to-spec check

               if Present (Spec_Context_Items) then

                  declare

                     Used_In_Body      : Boolean := False;

                     Used_In_Spec      : Boolean := False;

                     Used_Type_Or_Elab : Boolean := False;

                     Withed_In_Spec    : Boolean := False;

                  begin

                     Process_Spec_Clauses

                      (Context_List => Spec_Context_Items,

                       Clause       => Clause,

                       Used         => Used_In_Spec,

                       Withed       => Withed_In_Spec);

                     Process_Body_Clauses

                      (Context_List      => Context_Items,

                       Clause            => Clause,

                       Used              => Used_In_Body,

                       Used_Type_Or_Elab => Used_Type_Or_Elab);

                     --  "Type Elab" refers to the presence of either a use

                     --  type clause, pragmas Elaborate or Elaborate_All.

                     --  +---------------+---------------------------+------+

                     --  | Spec          | Body                      | Warn |

                     --  +--------+------+--------+------+-----------+------+

                     --  | Withed | Used | Withed | Used | Type Elab |      |

                     --  |   X    |      |   X    |      |           |  X   |

                     --  |   X    |      |   X    |  X   |           |      |

                     --  |   X    |      |   X    |      |     X     |      |

                     --  |   X    |      |   X    |  X   |     X     |      |

                     --  |   X    |  X   |   X    |      |           |  X   |

                     --  |   X    |  X   |   X    |      |     X     |      |

                     --  |   X    |  X   |   X    |  X   |           |  X   |

                     --  |   X    |  X   |   X    |  X   |     X     |      |

                     --  +--------+------+--------+------+-----------+------+

                     if (Withed_In_Spec

                           and then not Used_Type_Or_Elab)

                             and then

                               ((not Used_In_Spec

                                   and then not Used_In_Body)

                                     or else

                                       Used_In_Spec)

                     then

                        Error_Msg_N ("?redundant with clause in body", Clause);

                     end if;

                     Used_In_Body := False;

                     Used_In_Spec := False;

                     Used_Type_Or_Elab := False;

                     Withed_In_Spec := False;

                  end;

               --  Standalone package spec or body check

               else

                  declare

                     Dont_Care : Boolean := False;

                     Withed    : Boolean := False;

                  begin

                     --  The mechanism for examining the context clauses of a

                     --  package spec can be applied to package body clauses.

                     Process_Spec_Clauses

                      (Context_List => Context_Items,

                       Clause       => Clause,

                       Used         => Dont_Care,

                       Withed       => Withed,

                       Exit_On_Self => True);

                     if Withed then

                        Error_Msg_N ("?redundant with clause", Clause);

                     end if;

                  end;

               end if;

            end if;

            Prev (Clause);

         end loop;

      end Check_Redundant_Withs;

      --------------------------------

      -- Generate_Parent_References --

      --------------------------------

      procedure Generate_Parent_References (N : Node_Id; P_Id : Entity_Id) is

         Pref   : Node_Id;

         P_Name : Entity_Id := P_Id;

      begin

         Pref := Name (Parent (Defining_Entity (N)));

         if Nkind (Pref) = N_Expanded_Name then

            --  Done already, if the unit has been compiled indirectly as

            --  part of the closure of its context because of inlining.

            return;

         end if;

         while Nkind (Pref) = N_Selected_Component loop

            Change_Selected_Component_To_Expanded_Name (Pref);

            Set_Entity (Pref, P_Name);

            Set_Etype (Pref, Etype (P_Name));

            Generate_Reference (P_Name, Pref, 'r');

            Pref   := Prefix (Pref);

            P_Name := Scope (P_Name);

         end loop;

         --  The guard here on P_Name is to handle the error condition where

         --  the parent unit is missing because the file was not found.

         if Present (P_Name) then

            Set_Entity (Pref, P_Name);

            Set_Etype (Pref, Etype (P_Name));

            Generate_Reference (P_Name, Pref, 'r');

            Style.Check_Identifier (Pref, P_Name);

         end if;

      end Generate_Parent_References;

   --  Start of processing for Analyze_Compilation_Unit

   begin

      Process_Compilation_Unit_Pragmas (N);

      --  If the unit is a subunit whose parent has not been analyzed (which

      --  indicates that the main unit is a subunit, either the current one or

      --  one of its descendents) then the subunit is compiled as part of the

      --  analysis of the parent, which we proceed to do. Basically this gets

      --  handled from the top down and we don't want to do anything at this

      --  level (i.e. this subunit will be handled on the way down from the

      --  parent), so at this level we immediately return. If the subunit

      --  ends up not analyzed, it means that the parent did not contain a

      --  stub for it, or that there errors were detected in some ancestor.

      if Nkind (Unit_Node) = N_Subunit

        and then not Analyzed (Lib_Unit)

      then

         Semantics (Lib_Unit);

         if not Analyzed (Proper_Body (Unit_Node)) then

            if Serious_Errors_Detected > 0 then

               Error_Msg_N ("subunit not analyzed (errors in parent unit)", N);

            else

               Error_Msg_N ("missing stub for subunit", N);

            end if;

         end if;

         return;

      end if;

      --  Analyze context (this will call Sem recursively for with'ed units)

      --  To detect circularities among with-clauses that are not caught during

      --  loading, we set the Context_Pending flag on the current unit. If the

      --  flag is already set there is a potential circularity.

      --  We exclude predefined units from this check because they are known

      --  to be safe. We also exclude package bodies that are present because

      --  circularities between bodies are harmless (and necessary).

      if Context_Pending (N) then

         declare

            Circularity : Boolean := True;

         begin

            if Is_Predefined_File_Name

                 (Unit_File_Name (Get_Source_Unit (Unit (N))))

            then

               Circularity := False;

            else

               for U in Main_Unit + 1 .. Last_Unit loop

                  if Nkind (Unit (Cunit (U))) = N_Package_Body

                    and then not Analyzed (Cunit (U))

                  then

                     Circularity := False;

                     exit;

                  end if;

               end loop;

            end if;

            if Circularity then

               Error_Msg_N

                 ("circular dependency caused by with_clauses", N);

               Error_Msg_N

                 ("\possibly missing limited_with clause"

                  & " in one of the following", N);

               for U in Main_Unit .. Last_Unit loop

                  if Context_Pending (Cunit (U)) then

                     Error_Msg_Unit_1 := Get_Unit_Name (Unit (Cunit (U)));

                     Error_Msg_N ("\unit$", N);

                  end if;

               end loop;

               raise Unrecoverable_Error;

            end if;

         end;

      else

         Set_Context_Pending (N);

      end if;

      Analyze_Context (N);

      Set_Context_Pending (N, False);

      --  If the unit is a package body, the spec is already loaded and must be

      --  analyzed first, before we analyze the body.

      if Nkind (Unit_Node) = N_Package_Body then

         --  If no Lib_Unit, then there was a serious previous error, so just

         --  ignore the entire analysis effort

         if No (Lib_Unit) then

            return;

         else

            Semantics (Lib_Unit);

            Check_Unused_Withs (Get_Cunit_Unit_Number (Lib_Unit));

            --  Verify that the library unit is a package declaration

            if not Nkind_In (Unit (Lib_Unit), N_Package_Declaration,

                                              N_Generic_Package_Declaration)

            then

               Error_Msg_N

                 ("no legal package declaration for package body", N);

               return;

            --  Otherwise, the entity in the declaration is visible. Update the

            --  version to reflect dependence of this body on the spec.

            else

               Spec_Id := Defining_Entity (Unit (Lib_Unit));

               Set_Is_Immediately_Visible (Spec_Id, True);

               Version_Update (N, Lib_Unit);

               if Nkind (Defining_Unit_Name (Unit_Node)) =

                                             N_Defining_Program_Unit_Name

               then

                  Generate_Parent_References (Unit_Node, Scope (Spec_Id));

               end if;

            end if;

         end if;

      --  If the unit is a subprogram body, then we similarly need to analyze

      --  its spec. However, things are a little simpler in this case, because

      --  here, this analysis is done only for error checking and consistency

      --  purposes, so there's nothing else to be done.

      elsif Nkind (Unit_Node) = N_Subprogram_Body then

         if Acts_As_Spec (N) then

            --  If the subprogram body is a child unit, we must create a

            --  declaration for it, in order to properly load the parent(s).

            --  After this, the original unit does not acts as a spec, because

            --  there is an explicit one. If this unit appears in a context

            --  clause, then an implicit with on the parent will be added when

            --  installing the context. If this is the main unit, there is no

            --  Unit_Table entry for the declaration (it has the unit number

            --  of the main unit) and code generation is unaffected.

            Unum := Get_Cunit_Unit_Number (N);

            Par_Spec_Name := Get_Parent_Spec_Name (Unit_Name (Unum));

            if Par_Spec_Name /= No_Unit_Name then

               Unum :=

                 Load_Unit

                   (Load_Name  => Par_Spec_Name,

                    Required   => True,

                    Subunit    => False,

                    Error_Node => N);

               if Unum /= No_Unit then

                  --  Build subprogram declaration and attach parent unit to it

                  --  This subprogram declaration does not come from source,