sem_ch10.adb (Analyze_Compilation_Unit): if a unit in the context is a generic subpro...
authorEd Schonberg <schonberg@adacore.com>
Wed, 26 Mar 2008 07:41:53 +0000 (08:41 +0100)
committerArnaud Charlet <charlet@gcc.gnu.org>
Wed, 26 Mar 2008 07:41:53 +0000 (08:41 +0100)
2008-03-26  Ed Schonberg  <schonberg@adacore.com>

* sem_ch10.adb (Analyze_Compilation_Unit): if a unit in the context is
a generic subprogram that is imported, do not attempt to compile
non-existent body.

* sem_ch12.adb (Instantiate_Subprogram_Body): if the generic is
imported, do not generate a raise_program_error for the non-existent
body.
(Pre_Analyze_Actuals): If an error is detected during pre-analysis,
perform minimal name resolution on the generic to avoid spurious
warnings.
(Find_Actual_Type): the designated type of the actual in a child unit
may be declared in a parent unit without being an actual.

From-SVN: r133575

gcc/ada/sem_ch10.adb
gcc/ada/sem_ch12.adb

index cc8fcb390632583be51aa576eb4853941153e7dc..665c1efb861fc552a97c568a7de0aa19d18e1379 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2008, 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- --
@@ -387,9 +387,9 @@ package body Sem_Ch10 is
 
                elsif Nkind (Cont_Item) = N_Pragma
                  and then
-                   (Chars (Cont_Item) = Name_Elaborate
+                   (Pragma_Name (Cont_Item) = Name_Elaborate
                       or else
-                    Chars (Cont_Item) = Name_Elaborate_All)
+                    Pragma_Name (Cont_Item) = Name_Elaborate_All)
                  and then not Used_Type_Or_Elab
                then
                   Prag_Unit :=
@@ -759,7 +759,7 @@ package body Sem_Ch10 is
 
                      Set_Acts_As_Spec (N, False);
                      Set_Is_Child_Unit (Defining_Entity (Unit_Node));
-                     Set_Needs_Debug_Info (Defining_Entity (Unit (Lib_Unit)));
+                     Set_Debug_Info_Needed (Defining_Entity (Unit (Lib_Unit)));
                      Set_Comes_From_Source_Default (SCS);
                   end;
                end if;
@@ -910,7 +910,6 @@ package body Sem_Ch10 is
 
             Add_Stub_Constructs (N);
          end if;
-
       end if;
 
       --  Remove unit from visibility, so that environment is clean for
@@ -1005,8 +1004,13 @@ package body Sem_Ch10 is
                then
                   Nam := Entity (Name (Item));
 
+                  --  Compile generic subprogram, unless it is intrinsic or
+                  --  imported so no body is required, or generic package body
+                  --  if the package spec requires a body.
+
                   if (Is_Generic_Subprogram (Nam)
-                       and then not Is_Intrinsic_Subprogram (Nam))
+                       and then not Is_Intrinsic_Subprogram (Nam)
+                       and then not Is_Imported (Nam))
                     or else (Ekind (Nam) = E_Generic_Package
                               and then Unit_Requires_Body (Nam))
                   then
@@ -1237,7 +1241,7 @@ package body Sem_Ch10 is
       Item := First (Context_Items (N));
       while Present (Item)
         and then Nkind (Item) = N_Pragma
-        and then Chars (Item) in Configuration_Pragma_Names
+        and then Pragma_Name (Item) in Configuration_Pragma_Names
       loop
          Analyze (Item);
          Next (Item);
@@ -1732,7 +1736,6 @@ package body Sem_Ch10 is
       else
          Optional_Subunit;
       end if;
-
    end Analyze_Proper_Body;
 
    ----------------------------------
@@ -2693,20 +2696,21 @@ package body Sem_Ch10 is
    begin
       New_Nodes_OK := New_Nodes_OK + 1;
       Withn :=
-        Make_With_Clause (Loc, Name => Build_Unit_Name (Nam));
+        Make_With_Clause (Loc,
+          Name => Build_Unit_Name (Nam));
 
       P := Parent (Unit_Declaration_Node (Ent));
-      Set_Library_Unit          (Withn, P);
-      Set_Corresponding_Spec    (Withn, Ent);
-      Set_First_Name            (Withn, True);
-      Set_Implicit_With         (Withn, True);
+      Set_Library_Unit       (Withn, P);
+      Set_Corresponding_Spec (Withn, Ent);
+      Set_First_Name         (Withn, True);
+      Set_Implicit_With      (Withn, True);
 
       --  If the unit is a package declaration, a private_with_clause on a
       --  child unit implies that the implicit with on the parent is also
       --  private.
 
       if Nkind (Unit (N)) = N_Package_Declaration then
-         Set_Private_Present    (Withn, Private_Present (Item));
+         Set_Private_Present (Withn, Private_Present (Item));
       end if;
 
       Prepend (Withn, Context_Items (N));
@@ -2729,13 +2733,10 @@ package body Sem_Ch10 is
       if Nkind (Unit) = N_Package_Body
         and then Nkind (Original_Node (Unit)) = N_Package_Instantiation
       then
-         return
-           Defining_Entity
-             (Specification (Instance_Spec (Original_Node (Unit))));
-
+         return Defining_Entity
+                 (Specification (Instance_Spec (Original_Node (Unit))));
       elsif Nkind (Unit) = N_Package_Instantiation then
          return Defining_Entity (Specification (Instance_Spec (Unit)));
-
       else
          return Defining_Entity (Unit);
       end if;
@@ -2890,7 +2891,6 @@ package body Sem_Ch10 is
       end if;
 
       Install_Limited_Context_Clauses (N);
-
    end Install_Context;
 
    -----------------------------
@@ -2913,7 +2913,7 @@ package body Sem_Ch10 is
       Item := First (Context_Items (N));
       while Present (Item)
         and then Nkind (Item) = N_Pragma
-        and then Chars (Item) in Configuration_Pragma_Names
+        and then Pragma_Name (Item) in Configuration_Pragma_Names
       loop
          Next (Item);
       end loop;
@@ -3713,6 +3713,7 @@ package body Sem_Ch10 is
       Item : Node_Id;
       Id   : Entity_Id;
       Prev : Entity_Id;
+
    begin
       --  Iterate over explicit with clauses, and check whether the scope of
       --  each entity is an ancestor of the current unit, in which case it is
@@ -3950,8 +3951,8 @@ package body Sem_Ch10 is
             while Present (Item) loop
                if Nkind (Item) = N_With_Clause
                  and then not Limited_Present (Item)
-                 and then Nkind (Unit (Library_Unit (Item)))
-                            = N_Package_Declaration
+                 and then Nkind (Unit (Library_Unit (Item))) =
+                                                  N_Package_Declaration
                then
                   Decl :=
                     First (Visible_Declarations
@@ -4599,13 +4600,13 @@ package body Sem_Ch10 is
       Unum : constant Unit_Number_Type := Get_Source_Unit (Library_Unit (N));
       P    : constant Entity_Id        := Cunit_Entity (Unum);
 
-      Spec        : Node_Id;            --  To denote a package specification
-      Lim_Typ     : Entity_Id;          --  To denote shadow entities
-      Comp_Typ    : Entity_Id;          --  To denote real entities
+      Spec     : Node_Id;            --  To denote a package specification
+      Lim_Typ  : Entity_Id;          --  To denote shadow entities
+      Comp_Typ : Entity_Id;          --  To denote real entities
 
-      Lim_Header  : Entity_Id;          --  Package entity
-      Last_Lim_E  : Entity_Id := Empty; --  Last limited entity built
-      Last_Pub_Lim_E : Entity_Id;       --  To set the first private entity
+      Lim_Header     : Entity_Id;          --  Package entity
+      Last_Lim_E     : Entity_Id := Empty; --  Last limited entity built
+      Last_Pub_Lim_E : Entity_Id;          --  To set the first private entity
 
       procedure Decorate_Incomplete_Type
         (E    : Entity_Id;
@@ -4805,8 +4806,8 @@ package body Sem_Ch10 is
 
                Set_Non_Limited_View (Lim_Typ, Comp_Typ);
 
-            elsif Nkind (Decl) = N_Private_Type_Declaration
-              or else Nkind (Decl) = N_Incomplete_Type_Declaration
+            elsif Nkind_In (Decl, N_Private_Type_Declaration,
+                                  N_Incomplete_Type_Declaration)
             then
                Comp_Typ := Defining_Identifier (Decl);
 
@@ -4879,7 +4880,7 @@ package body Sem_Ch10 is
                   Decorate_Package_Specification (Lim_Typ);
                   Set_Scope (Lim_Typ, Scope);
 
-                  Set_Chars (Lim_Typ, Chars (Comp_Typ));
+                  Set_Chars  (Lim_Typ, Chars (Comp_Typ));
                   Set_Parent (Lim_Typ, Parent (Comp_Typ));
                   Set_From_With_Type (Lim_Typ);
 
@@ -4958,8 +4959,9 @@ package body Sem_Ch10 is
 
       --  Build the header of the limited_view
 
-      Lim_Header := Make_Defining_Identifier (Sloc (N),
-                      Chars => New_Internal_Name (Id_Char => 'Z'));
+      Lim_Header :=
+        Make_Defining_Identifier (Sloc (N),
+          Chars => New_Internal_Name (Id_Char => 'Z'));
       Set_Ekind (Lim_Header, E_Package);
       Set_Is_Internal (Lim_Header);
       Set_Limited_View (P, Lim_Header);
@@ -5410,7 +5412,6 @@ package body Sem_Ch10 is
          if Nkind (Item) = N_With_Clause
            and then Private_Present (Item)
          then
-
             --  If private_with_clause is redundant, remove it from
             --  context, as a small optimization to subsequent handling
             --  of private_with clauses in other nested packages..
@@ -5418,7 +5419,6 @@ package body Sem_Ch10 is
             if In_Regular_With_Clause (Entity (Name (Item))) then
                declare
                   Nxt : constant Node_Id := Next (Item);
-
                begin
                   Remove (Item);
                   Item := Nxt;
@@ -5451,7 +5451,6 @@ package body Sem_Ch10 is
       P : constant Entity_Id := Scope (Unit_Name);
 
    begin
-
       if Debug_Flag_I then
          Write_Str ("remove unit ");
          Write_Name (Chars (Unit_Name));
index 4a830603f129ae7fee183130db8f738b69cc655b..a2019a6e427d65caeb969d80e2de69d5246cb5e2 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2007, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2008, 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- --
@@ -434,15 +434,17 @@ package body Sem_Ch12 is
 
    function Find_Actual_Type
      (Typ       : Entity_Id;
-      Gen_Scope : Entity_Id) return Entity_Id;
+      Gen_Type  : Entity_Id) return Entity_Id;
    --  When validating the actual types of a child instance, check whether
    --  the formal is a formal type of the parent unit, and retrieve the current
    --  actual for it. Typ is the entity in the analyzed formal type declaration
    --  (component or index type of an array type, or designated type of an
-   --  access formal) and Gen_Scope is the scope of the analyzed formal array
+   --  access formal) and Gen_Type is the enclosing analyzed formal array
    --  or access type. The desired actual may be a formal of a parent, or may
    --  be declared in a formal package of a parent. In both cases it is a
    --  generic actual type because it appears within a visible instance.
+   --  Finally, it may be declared in a parent unit without being a formal
+   --  of that unit, in which case it must be retrieved by visibility.
    --  Ambiguities may still arise if two homonyms are declared in two formal
    --  packages, and the prefix of the formal type may be needed to resolve
    --  the ambiguity in the instance ???
@@ -1066,6 +1068,7 @@ package body Sem_Ch12 is
 
       procedure Set_Analyzed_Formal is
          Kind : Node_Kind;
+
       begin
          while Present (Analyzed_Formal) loop
             Kind := Nkind (Analyzed_Formal);
@@ -1081,12 +1084,9 @@ package body Sem_Ch12 is
                         (Defining_Unit_Name (Specification (Analyzed_Formal)));
 
                when N_Formal_Package_Declaration =>
-                  exit when
-                    Kind = N_Formal_Package_Declaration
-                      or else
-                    Kind = N_Generic_Package_Declaration
-                      or else
-                    Kind = N_Package_Declaration;
+                  exit when Nkind_In (Kind, N_Formal_Package_Declaration,
+                                            N_Generic_Package_Declaration,
+                                            N_Package_Declaration);
 
                when N_Use_Package_Clause | N_Use_Type_Clause => exit;
 
@@ -1097,10 +1097,10 @@ package body Sem_Ch12 is
 
                   exit when
                     Kind not in N_Formal_Subprogram_Declaration
-                      and then Kind /= N_Subprogram_Declaration
-                      and then Kind /= N_Freeze_Entity
-                      and then Kind /= N_Null_Statement
-                      and then Kind /= N_Itype_Reference
+                      and then not Nkind_In (Kind, N_Subprogram_Declaration,
+                                                   N_Freeze_Entity,
+                                                   N_Null_Statement,
+                                                   N_Itype_Reference)
                       and then Chars (Defining_Identifier (Formal)) =
                                Chars (Defining_Identifier (Analyzed_Formal));
             end case;
@@ -1123,6 +1123,7 @@ package body Sem_Ch12 is
          while Present (Actual) loop
             if Nkind (Actual) = N_Others_Choice then
                Others_Present := True;
+
                if Present (Next (Actual)) then
                   Error_Msg_N ("others must be last association", Actual);
                end if;
@@ -1181,7 +1182,7 @@ package body Sem_Ch12 is
          --  to the outer instantiation.
 
          if Nkind (Named) /= N_Others_Choice
-           and then  Present (Explicit_Generic_Actual_Parameter (Named))
+           and then Present (Explicit_Generic_Actual_Parameter (Named))
          then
             Num_Actuals := Num_Actuals + 1;
          end if;
@@ -1474,9 +1475,9 @@ package body Sem_Ch12 is
       if Nkind (Def) = N_Constrained_Array_Definition then
          DSS := First (Discrete_Subtype_Definitions (Def));
          while Present (DSS) loop
-            if Nkind (DSS) = N_Subtype_Indication
-              or else Nkind (DSS) = N_Range
-              or else Nkind (DSS) = N_Attribute_Reference
+            if Nkind_In (DSS, N_Subtype_Indication,
+                              N_Range,
+                              N_Attribute_Reference)
             then
                Error_Msg_N ("only a subtype mark is allowed in a formal", DSS);
             end if;
@@ -1499,8 +1500,8 @@ package body Sem_Ch12 is
       elsif Is_Internal (Component_Type (T))
         and then Present (Subtype_Indication (Component_Definition (Def)))
         and then Nkind (Original_Node
-                        (Subtype_Indication (Component_Definition (Def))))
-          = N_Subtype_Indication
+                         (Subtype_Indication (Component_Definition (Def)))) =
+                                                         N_Subtype_Indication
       then
          Error_Msg_N
            ("in a formal, a subtype indication can only be "
@@ -2377,7 +2378,6 @@ package body Sem_Ch12 is
             end if;
 
          elsif Nkind (Def) = N_Indexed_Component then
-
             if  Nkind (Prefix (Def)) /= N_Selected_Component then
                Error_Msg_N ("expect valid subprogram name as default", Def);
                return;
@@ -3124,7 +3124,7 @@ package body Sem_Ch12 is
                   Inline_Now := True;
 
                --  In configurable_run_time mode we force the inlining of
-               --  predefined subprogram marked Inline_Always, to minimize
+               --  predefined subprograms marked Inline_Always, to minimize
                --  the use of the run-time library.
 
                elsif Is_Predefined_File_Name
@@ -3194,10 +3194,11 @@ package body Sem_Ch12 is
                begin
                   if Nkind (Decl) = N_Formal_Package_Declaration
                     or else (Nkind (Decl) = N_Package_Declaration
-                      and then Is_List_Member (Decl)
-                      and then Present (Next (Decl))
-                      and then
-                        Nkind (Next (Decl)) = N_Formal_Package_Declaration)
+                               and then Is_List_Member (Decl)
+                               and then Present (Next (Decl))
+                               and then
+                                 Nkind (Next (Decl)) =
+                                                N_Formal_Package_Declaration)
                   then
                      Needs_Body := False;
                   end if;
@@ -3825,7 +3826,7 @@ package body Sem_Ch12 is
 
          Set_Instance_Spec (N, Pack_Decl);
          Set_Is_Generic_Instance (Pack_Id);
-         Set_Needs_Debug_Info (Pack_Id);
+         Set_Debug_Info_Needed (Pack_Id);
 
          --  Case of not a compilation unit
 
@@ -3875,7 +3876,7 @@ package body Sem_Ch12 is
          end if;
 
          Set_Is_Generic_Instance (Anon_Id);
-         Set_Needs_Debug_Info    (Anon_Id);
+         Set_Debug_Info_Needed   (Anon_Id);
          Act_Decl_Id := New_Copy (Anon_Id);
 
          Set_Parent            (Act_Decl_Id, Parent (Anon_Id));
@@ -4207,15 +4208,15 @@ package body Sem_Ch12 is
    -------------------------
 
    function Get_Associated_Node (N : Node_Id) return Node_Id is
-      Assoc : Node_Id := Associated_Node (N);
+      Assoc : Node_Id;
 
    begin
+      Assoc := Associated_Node (N);
+
       if Nkind (Assoc) /= Nkind (N) then
          return Assoc;
 
-      elsif Nkind (Assoc) = N_Aggregate
-        or else Nkind (Assoc) = N_Extension_Aggregate
-      then
+      elsif Nkind_In (Assoc, N_Aggregate, N_Extension_Aggregate) then
          return Assoc;
 
       else
@@ -4235,15 +4236,11 @@ package body Sem_Ch12 is
 
          if (Nkind (Assoc) = N_Identifier or else Nkind (Assoc) in N_Op)
            and then Present (Associated_Node (Assoc))
-           and then (Nkind (Associated_Node (Assoc)) = N_Function_Call
-                       or else
-                     Nkind (Associated_Node (Assoc)) = N_Explicit_Dereference
-                       or else
-                     Nkind (Associated_Node (Assoc)) = N_Integer_Literal
-                       or else
-                     Nkind (Associated_Node (Assoc)) = N_Real_Literal
-                       or else
-                     Nkind (Associated_Node (Assoc)) = N_String_Literal)
+           and then (Nkind_In (Associated_Node (Assoc), N_Function_Call,
+                                                        N_Explicit_Dereference,
+                                                        N_Integer_Literal,
+                                                        N_Real_Literal,
+                                                        N_String_Literal))
          then
             Assoc := Associated_Node (Assoc);
          end if;
@@ -4396,9 +4393,9 @@ package body Sem_Ch12 is
          if Kind = N_Formal_Type_Declaration then
             return;
 
-         elsif Kind = N_Formal_Object_Declaration
+         elsif Nkind_In (Kind, N_Formal_Object_Declaration,
+                               N_Formal_Package_Declaration)
            or else Kind in N_Formal_Subprogram_Declaration
-           or else Kind = N_Formal_Package_Declaration
          then
             null;
 
@@ -5625,10 +5622,10 @@ package body Sem_Ch12 is
 
       --  Special casing for identifiers and other entity names and operators
 
-      elsif     Nkind (New_N) = N_Identifier
-        or else Nkind (New_N) = N_Character_Literal
-        or else Nkind (New_N) = N_Expanded_Name
-        or else Nkind (New_N) = N_Operator_Symbol
+      elsif Nkind_In (New_N, N_Identifier,
+                             N_Character_Literal,
+                             N_Expanded_Name,
+                             N_Operator_Symbol)
         or else Nkind (New_N) in N_Op
       then
          if not Instantiating then
@@ -5673,20 +5670,19 @@ package body Sem_Ch12 is
 
             elsif No (Ent)
               or else
-                not (Nkind (Ent) = N_Defining_Identifier
-                       or else
-                     Nkind (Ent) = N_Defining_Character_Literal
-                       or else
-                     Nkind (Ent) = N_Defining_Operator_Symbol)
+                not Nkind_In (Ent, N_Defining_Identifier,
+                                   N_Defining_Character_Literal,
+                                   N_Defining_Operator_Symbol)
               or else No (Scope (Ent))
               or else
                 (Scope (Ent) = Current_Instantiated_Parent.Gen_Id
                   and then not Is_Child_Unit (Ent))
-              or else (Scope_Depth (Scope (Ent)) >
+              or else
+                (Scope_Depth (Scope (Ent)) >
                              Scope_Depth (Current_Instantiated_Parent.Gen_Id)
-                         and then
-                       Get_Source_Unit (Ent) =
-                       Get_Source_Unit (Current_Instantiated_Parent.Gen_Id))
+                  and then
+                    Get_Source_Unit (Ent) =
+                    Get_Source_Unit (Current_Instantiated_Parent.Gen_Id))
             then
                Set_Associated_Node (New_N, Empty);
             end if;
@@ -5702,6 +5698,7 @@ package body Sem_Ch12 is
 
             declare
                Assoc : constant Node_Id := Get_Associated_Node (N);
+
             begin
                if Present (Assoc) then
                   if Nkind (Assoc) = Nkind (N) then
@@ -5711,9 +5708,9 @@ package body Sem_Ch12 is
                   elsif Nkind (Assoc) = N_Function_Call then
                      Set_Entity (New_N, Entity (Name (Assoc)));
 
-                  elsif (Nkind (Assoc) = N_Defining_Identifier
-                          or else Nkind (Assoc) = N_Defining_Character_Literal
-                          or else Nkind (Assoc) = N_Defining_Operator_Symbol)
+                  elsif Nkind_In (Assoc, N_Defining_Identifier,
+                                         N_Defining_Character_Literal,
+                                         N_Defining_Operator_Symbol)
                     and then Expander_Active
                   then
                      --  Inlining case: we are copying a tree that contains
@@ -5902,9 +5899,7 @@ package body Sem_Ch12 is
             Set_Assignment_OK (Name (New_N), True);
          end if;
 
-      elsif Nkind (N) = N_Aggregate
-        or else Nkind (N) = N_Extension_Aggregate
-      then
+      elsif Nkind_In (N, N_Aggregate, N_Extension_Aggregate) then
          if not Instantiating then
             Set_Associated_Node (N, New_N);
 
@@ -6029,22 +6024,20 @@ package body Sem_Ch12 is
         and then Instantiating
       then
          declare
-            Prag_Id : constant Pragma_Id := Get_Pragma_Id (Chars (N));
-
+            Prag_Id : constant Pragma_Id := Get_Pragma_Id (N);
          begin
             if Prag_Id = Pragma_Ident
               or else Prag_Id = Pragma_Comment
             then
                New_N := Make_Null_Statement (Sloc (N));
-
             else
                Copy_Descendants;
             end if;
          end;
 
-      elsif Nkind (N) = N_Integer_Literal
-        or else Nkind (N) = N_Real_Literal
-        or else Nkind (N) = N_String_Literal
+      elsif Nkind_In (N, N_Integer_Literal,
+                         N_Real_Literal,
+                         N_String_Literal)
       then
          --  No descendant fields need traversing
 
@@ -6145,20 +6138,34 @@ package body Sem_Ch12 is
    ----------------------
 
    function Find_Actual_Type
-     (Typ       : Entity_Id;
-      Gen_Scope : Entity_Id) return Entity_Id
+     (Typ      : Entity_Id;
+      Gen_Type : Entity_Id) return Entity_Id
    is
-      T : Entity_Id;
+      Gen_Scope : constant Entity_Id := Scope (Gen_Type);
+      T         : Entity_Id;
 
    begin
+      --  Special processing only applies to child units
+
       if not Is_Child_Unit (Gen_Scope) then
          return Get_Instance_Of (Typ);
 
+      --  If designated or component type is itself a formal of the child unit,
+      --  its instance is available.
+
+      elsif Scope (Typ) = Gen_Scope then
+         return Get_Instance_Of (Typ);
+
+      --  If the array or access type is not declared in the parent unit,
+      --  no special processing needed.
+
       elsif not Is_Generic_Type (Typ)
-        or else Scope (Typ) = Gen_Scope
+        and then Scope (Gen_Scope) /= Scope (Typ)
       then
          return Get_Instance_Of (Typ);
 
+      --  Otherwise, retrieve designated or component type by visibility
+
       else
          T := Current_Entity (Typ);
          while Present (T) loop
@@ -6397,7 +6404,7 @@ package body Sem_Ch12 is
            or else
              (Nkind (Enc_I) = N_Package_Body
                and then
-             In_Same_Declarative_Part (Freeze_Node (Par), Parent (Enc_I)))
+                 In_Same_Declarative_Part (Freeze_Node (Par), Parent (Enc_I)))
          then
             --  The enclosing package may contain several instances. Rather
             --  than computing the earliest point at which to insert its
@@ -6511,8 +6518,8 @@ package body Sem_Ch12 is
          if Nkind (Package_Instantiation (A)) = N_Package_Instantiation then
             return Package_Instantiation (A);
 
-         elsif Nkind (Original_Node (Package_Instantiation (A)))
-                 = N_Package_Instantiation
+         elsif Nkind (Original_Node (Package_Instantiation (A))) =
+                                                   N_Package_Instantiation
          then
             return Original_Node (Package_Instantiation (A));
          end if;
@@ -6554,8 +6561,8 @@ package body Sem_Ch12 is
 
       else
          Inst := Next (Decl);
-         while Nkind (Inst) /= N_Package_Instantiation
-           and then Nkind (Inst) /= N_Formal_Package_Declaration
+         while not Nkind_In (Inst, N_Package_Instantiation,
+                                   N_Formal_Package_Declaration)
          loop
             Next (Inst);
          end loop;
@@ -6677,11 +6684,11 @@ package body Sem_Ch12 is
          if Nod = Decls then
             return True;
 
-         elsif Nkind (Nod) = N_Subprogram_Body
-           or else Nkind (Nod) = N_Package_Body
-           or else Nkind (Nod) = N_Task_Body
-           or else Nkind (Nod) = N_Protected_Body
-           or else Nkind (Nod) = N_Block_Statement
+         elsif Nkind_In (Nod, N_Subprogram_Body,
+                              N_Package_Body,
+                              N_Task_Body,
+                              N_Protected_Body,
+                              N_Block_Statement)
          then
             return False;
 
@@ -6690,6 +6697,7 @@ package body Sem_Ch12 is
 
          elsif Nkind (Nod) = N_Compilation_Unit then
             return False;
+
          else
             Nod := Parent (Nod);
          end if;
@@ -6728,7 +6736,7 @@ package body Sem_Ch12 is
             --  might produce false positives in rare cases, but guarantees
             --  that we produce all the instance bodies we will need.
 
-            if (Nkind (Nam) = N_Identifier
+            if (Is_Entity_Name (Nam)
                  and then Chars (Nam) = Chars (E))
               or else (Nkind (Nam) = N_Selected_Component
                         and then Chars (Selector_Name (Nam)) = Chars (E))
@@ -6895,6 +6903,7 @@ package body Sem_Ch12 is
    --  Start of processing for Install_Body
 
    begin
+
       --  If the body is a subunit, the freeze point is the corresponding
       --  stub in the current compilation, not the subunit itself.
 
@@ -6919,8 +6928,8 @@ package body Sem_Ch12 is
 
       Must_Delay :=
         (Gen_Unit = Act_Unit
-          and then ((Nkind (Gen_Unit) = N_Package_Declaration)
-                      or else Nkind (Gen_Unit) = N_Generic_Package_Declaration
+          and then (Nkind_In (Gen_Unit, N_Package_Declaration,
+                                        N_Generic_Package_Declaration)
                       or else (Gen_Unit = Body_Unit
                                 and then True_Sloc (N) < Sloc (Orig_Body)))
           and then Is_In_Main_Unit (Gen_Unit)
@@ -7827,10 +7836,10 @@ package body Sem_Ch12 is
          end if;
 
          if (Present (Act_E) and then Is_Overloadable (Act_E))
-           or else Nkind (Act) = N_Attribute_Reference
-           or else Nkind (Act) = N_Indexed_Component
-           or else Nkind (Act) = N_Character_Literal
-           or else Nkind (Act) = N_Explicit_Dereference
+           or else Nkind_In (Act, N_Attribute_Reference,
+                                  N_Indexed_Component,
+                                  N_Character_Literal,
+                                  N_Explicit_Dereference)
          then
             return;
          end if;
@@ -7900,10 +7909,10 @@ package body Sem_Ch12 is
          Nam := Actual;
 
       elsif Present (Default_Name (Formal)) then
-         if Nkind (Default_Name (Formal)) /= N_Attribute_Reference
-           and then Nkind (Default_Name (Formal)) /= N_Selected_Component
-           and then Nkind (Default_Name (Formal)) /= N_Indexed_Component
-           and then Nkind (Default_Name (Formal)) /= N_Character_Literal
+         if not Nkind_In (Default_Name (Formal), N_Attribute_Reference,
+                                                 N_Selected_Component,
+                                                 N_Indexed_Component,
+                                                 N_Character_Literal)
            and then Present (Entity (Default_Name (Formal)))
          then
             Nam := New_Occurrence_Of (Entity (Default_Name (Formal)), Loc);
@@ -8297,7 +8306,7 @@ package body Sem_Ch12 is
                --  a child unit.
 
                if Nkind (Actual) = N_Aggregate then
-                     Pre_Analyze_And_Resolve (Actual, Typ);
+                  Pre_Analyze_And_Resolve (Actual, Typ);
                end if;
 
                if Is_Limited_Type (Typ)
@@ -8385,8 +8394,8 @@ package body Sem_Ch12 is
       if Ada_Version >= Ada_05
         and then Present (Actual_Decl)
         and then
-          (Nkind (Actual_Decl) = N_Formal_Object_Declaration
-             or else Nkind (Actual_Decl) = N_Object_Declaration)
+          Nkind_In (Actual_Decl, N_Formal_Object_Declaration,
+                                 N_Object_Declaration)
         and then Nkind (Analyzed_Formal) = N_Formal_Object_Declaration
         and then Has_Null_Exclusion (Actual_Decl)
         and then not Has_Null_Exclusion (Analyzed_Formal)
@@ -8685,8 +8694,24 @@ package body Sem_Ch12 is
       Scope_Suppress           := Body_Info.Scope_Suppress;
 
       if No (Gen_Body_Id) then
-         Load_Parent_Of_Generic (Inst_Node, Specification (Gen_Decl));
-         Gen_Body_Id := Corresponding_Body (Gen_Decl);
+
+         --  For imported generic subprogram, no body to compile, complete
+         --  the spec entity appropriately.
+
+         if Is_Imported (Gen_Unit) then
+            Set_Is_Imported (Anon_Id);
+            Set_First_Rep_Item (Anon_Id, First_Rep_Item (Gen_Unit));
+            Set_Interface_Name (Anon_Id, Interface_Name (Gen_Unit));
+            Set_Convention     (Anon_Id, Convention     (Gen_Unit));
+            Set_Has_Completion (Anon_Id);
+            return;
+
+         --  For other cases, commpile the body
+
+         else
+            Load_Parent_Of_Generic (Inst_Node, Specification (Gen_Decl));
+            Gen_Body_Id := Corresponding_Body (Gen_Decl);
+         end if;
       end if;
 
       Instantiation_Node := Inst_Node;
@@ -9011,8 +9036,8 @@ package body Sem_Ch12 is
 
       procedure Validate_Access_Type_Instance is
          Desig_Type : constant Entity_Id :=
-                        Find_Actual_Type
-                          (Designated_Type (A_Gen_T), Scope (A_Gen_T));
+                        Find_Actual_Type (Designated_Type (A_Gen_T), A_Gen_T);
+         Desig_Act  : Entity_Id;
 
       begin
          if not Is_Access_Type (Act_T) then
@@ -9046,9 +9071,19 @@ package body Sem_Ch12 is
          --  by an access type declaration (and not by a subtype declaration)
          --  must match.
 
-         if not Subtypes_Match
-           (Desig_Type, Designated_Type (Base_Type (Act_T)))
+         Desig_Act := Designated_Type (Base_Type (Act_T));
+
+         --  The designated type may have been introduced through a limited_
+         --  with clause, in which case retrieve the non-limited view.
+
+         if Ekind (Desig_Act) = E_Incomplete_Type
+           and then From_With_Type (Desig_Act)
          then
+            Desig_Act := Available_View (Desig_Act);
+         end if;
+
+         if not Subtypes_Match
+           (Desig_Type, Desig_Act) then
             Error_Msg_NE
               ("designated type of actual does not match that of formal &",
                  Actual, Gen_T);
@@ -9155,7 +9190,7 @@ package body Sem_Ch12 is
             end if;
 
             if not Subtypes_Match
-              (Find_Actual_Type (Etype (I1), Scope (A_Gen_T)), T2)
+                     (Find_Actual_Type (Etype (I1), A_Gen_T), T2)
             then
                Error_Msg_NE
                  ("index types of actual do not match those of formal &",
@@ -9167,9 +9202,9 @@ package body Sem_Ch12 is
             Next_Index (I2);
          end loop;
 
-         if not Subtypes_Match (
-            Find_Actual_Type (Component_Type (A_Gen_T), Scope (A_Gen_T)),
-            Component_Type (Act_T))
+         if not Subtypes_Match
+                  (Find_Actual_Type (Component_Type (A_Gen_T), A_Gen_T),
+                   Component_Type (Act_T))
          then
             Error_Msg_NE
               ("component subtype of actual does not match that of formal &",
@@ -9184,7 +9219,6 @@ package body Sem_Ch12 is
               ("actual must have aliased components to match formal type &",
                Actual, Gen_T);
          end if;
-
       end Validate_Array_Type_Instance;
 
       -----------------------------------------------
@@ -10151,9 +10185,9 @@ package body Sem_Ch12 is
       else
          Kind := Nkind (Parent (E));
          return
-           Kind = N_Formal_Object_Declaration
-             or else Kind = N_Formal_Package_Declaration
-             or else Kind = N_Formal_Type_Declaration
+           Nkind_In (Kind, N_Formal_Object_Declaration,
+                           N_Formal_Package_Declaration,
+                           N_Formal_Type_Declaration)
              or else
                (Is_Formal_Subprogram (E)
                  and then
@@ -10670,6 +10704,20 @@ package body Sem_Ch12 is
             end if;
 
             if Errs /= Serious_Errors_Detected then
+
+               --  Do a minimal analysis of the generic, to prevent spurious
+               --  warnings complaining about the generic being unreferenced,
+               --  before abandoning the instantiation.
+
+               Analyze (Name (N));
+
+               if Is_Entity_Name (Name (N))
+                 and then Etype (Name (N)) /= Any_Type
+               then
+                  Generate_Reference  (Entity (Name (N)), Name (N));
+                  Set_Is_Instantiated (Entity (Name (N)));
+               end if;
+
                Abandon_Instantiation (Act);
             end if;
          end if;
@@ -10772,12 +10820,12 @@ package body Sem_Ch12 is
          Restore_Private_Views (Empty);
       end if;
 
-      Current_Instantiated_Parent  := Saved.Instantiated_Parent;
-      Exchanged_Views              := Saved.Exchanged_Views;
-      Hidden_Entities              := Saved.Hidden_Entities;
-      Current_Sem_Unit             := Saved.Current_Sem_Unit;
-      Parent_Unit_Visible          := Saved.Parent_Unit_Visible;
-      Instance_Parent_Unit         := Saved.Instance_Parent_Unit;
+      Current_Instantiated_Parent := Saved.Instantiated_Parent;
+      Exchanged_Views             := Saved.Exchanged_Views;
+      Hidden_Entities             := Saved.Hidden_Entities;
+      Current_Sem_Unit            := Saved.Current_Sem_Unit;
+      Parent_Unit_Visible         := Saved.Parent_Unit_Visible;
+      Instance_Parent_Unit        := Saved.Instance_Parent_Unit;
 
       Restore_Opt_Config_Switches (Saved.Switches);
 
@@ -10816,7 +10864,6 @@ package body Sem_Ch12 is
             return;
 
          elsif Present (Associated_Formal_Package (Formal)) then
-
             Ent := First_Entity (Formal);
             while Present (Ent) loop
                exit when Ekind (Ent) = E_Package
@@ -10890,8 +10937,8 @@ package body Sem_Ch12 is
 
             --  An unusual case of aliasing: the actual may also be directly
             --  visible in the generic, and be private there, while it is fully
-            --  visible in the context of the instance. The internal subtype is
-            --  private in the instance, but has full visibility like its
+            --  visible in the context of the instance. The internal subtype
+            --  is private in the instance, but has full visibility like its
             --  parent in the enclosing scope. This enforces the invariant that
             --  the privacy status of all private dependents of a type coincide
             --  with that of the parent type. This can only happen when a
@@ -10915,8 +10962,8 @@ package body Sem_Ch12 is
 
             --  If the actual is itself a formal package for the enclosing
             --  generic, or the actual for such a formal package, it remains
-            --  visible on exit from the instance, and therefore nothing
-            --  needs to be done either, except to keep it accessible.
+            --  visible on exit from the instance, and therefore nothing needs
+            --  to be done either, except to keep it accessible.
 
             if Is_Package
               and then Renamed_Object (E) = Pack_Id
@@ -11033,7 +11080,7 @@ package body Sem_Ch12 is
       ---------------
 
       function Is_Global (E : Entity_Id) return Boolean is
-         Se  : Entity_Id := Scope (E);
+         Se : Entity_Id;
 
          function Is_Instance_Node (Decl : Node_Id) return Boolean;
          --  Determine whether the parent node of a reference to a child unit
@@ -11064,13 +11111,15 @@ package body Sem_Ch12 is
 
          elsif Is_Child_Unit (E)
            and then (Is_Instance_Node (Parent (N2))
-             or else (Nkind (Parent (N2)) = N_Expanded_Name
-                       and then N2 = Selector_Name (Parent (N2))
-                       and then Is_Instance_Node (Parent (Parent (N2)))))
+                      or else (Nkind (Parent (N2)) = N_Expanded_Name
+                                and then N2 = Selector_Name (Parent (N2))
+                                and then
+                                  Is_Instance_Node (Parent (Parent (N2)))))
          then
             return True;
 
          else
+            Se := Scope (E);
             while Se /= Gen_Scope loop
                if Se = Standard_Standard then
                   return True;
@@ -11153,9 +11202,10 @@ package body Sem_Ch12 is
          ------------------
 
          function Top_Ancestor (E : Entity_Id) return Entity_Id is
-            Par : Entity_Id := E;
+            Par : Entity_Id;
 
          begin
+            Par := E;
             while Is_Child_Unit (Par) loop
                Par := Scope (Par);
             end loop;
@@ -11241,8 +11291,7 @@ package body Sem_Ch12 is
          --  its value. Otherwise the folding will happen in any instantiation,
 
          elsif Nkind (Parent (N)) = N_Selected_Component
-           and then (Nkind (Parent (N2)) = N_Integer_Literal
-                      or else Nkind (Parent (N2)) = N_Real_Literal)
+           and then Nkind_In (Parent (N2), N_Integer_Literal, N_Real_Literal)
          then
             if Present (Entity (Original_Node (Parent (N2))))
               and then Is_Global (Entity (Original_Node (Parent (N2))))
@@ -11504,9 +11553,7 @@ package body Sem_Ch12 is
          if N = Empty then
             null;
 
-         elsif Nkind (N) = N_Character_Literal
-           or else Nkind (N) = N_Operator_Symbol
-         then
+         elsif Nkind_In (N, N_Character_Literal, N_Operator_Symbol) then
             if Nkind (N) = Nkind (Get_Associated_Node (N)) then
                Reset_Entity (N);
 
@@ -11545,9 +11592,9 @@ package body Sem_Ch12 is
                      Set_Etype (N, Empty);
                   end if;
 
-               elsif Nkind (N2) = N_Integer_Literal
-                 or else Nkind (N2) = N_Real_Literal
-                 or else Nkind (N2) = N_String_Literal
+               elsif Nkind_In (N2, N_Integer_Literal,
+                                   N_Real_Literal,
+                                   N_String_Literal)
                then
                   if Present (Original_Node (N2))
                     and then Nkind (Original_Node (N2)) = Nkind (N)
@@ -11588,8 +11635,7 @@ package body Sem_Ch12 is
                end if;
             end if;
 
-            --  Complete the check on operands, if node has not been
-            --  constant-folded.
+            --  Complete operands check if node has not been constant-folded
 
             if Nkind (N) in N_Op then
                Save_Entity_Descendants (N);
@@ -11624,10 +11670,7 @@ package body Sem_Ch12 is
                      Set_Etype (N, Empty);
                   end if;
 
-               elsif
-                 (Nkind (N2) = N_Integer_Literal
-                    or else
-                  Nkind (N2) = N_Real_Literal)
+               elsif Nkind_In (N2, N_Integer_Literal, N_Real_Literal)
                  and then Is_Entity_Name (Original_Node (N2))
                then
                   --  Name resolves to named number that is constant-folded,
@@ -11712,10 +11755,7 @@ package body Sem_Ch12 is
                --  traversal, so it needs direct access to node fields.
 
             begin
-               if Nkind (N) = N_Aggregate
-                    or else
-                  Nkind (N) = N_Extension_Aggregate
-               then
+               if Nkind_In (N, N_Aggregate, N_Extension_Aggregate) then
                   N2 := Get_Associated_Node (N);
 
                   if No (N2) then
@@ -11723,10 +11763,10 @@ package body Sem_Ch12 is
                   else
                      Typ := Etype (N2);
 
-                     --  In an instance within a generic, use the name of
-                     --  the actual and not the original generic parameter.
-                     --  If the actual is global in the current generic it
-                     --  must be preserved for its instantiation.
+                     --  In an instance within a generic, use the name of the
+                     --  actual and not the original generic parameter. If the
+                     --  actual is global in the current generic it must be
+                     --  preserved for its instantiation.
 
                      if Nkind (Parent (Typ)) = N_Subtype_Declaration
                        and then
@@ -11759,8 +11799,8 @@ package body Sem_Ch12 is
 
                      if Nkind (N2) = Nkind (N)
                        and then
-                         (Nkind (Parent (N2)) = N_Procedure_Call_Statement
-                           or else Nkind (Parent (N2)) = N_Function_Call)
+                         Nkind_In (Parent (N2), N_Procedure_Call_Statement,
+                                                N_Function_Call)
                        and then Comes_From_Source (Typ)
                      then
                         if Is_Immediately_Visible (Scope (Typ)) then