[Ada] fix bugs in handling of generics

Arnaud Charlet charlet@adacore.com
Tue Oct 31 20:01:00 GMT 2006


Tested on i686-linux, committed on trunk.

When a formal package P is declared as an instance of a generic package
G without a box, we must check that the parameters of the actual instance
I match those given in the declaration for P. The validation is performed
by constructing I2, a new instance of G, using the formal part of P, ana-
lyzing I2 in the context of the current instance, and verifying that its
actuals match the actuals of I. If G itself comes from  a prior formal
parameter, its identity in the instance must be retrieved from the current
instance mapping, and it is this identity that must be used in the
declaration of I2.
gnat.dg/env_compile_capacity.adb will now compile quietly.

Also improve the tree structure in some cases for better ASIS use.

AI-317 extends the functionality of formal packages, by allowing them
to be specified with a partial list of actuals, rather the all-or-none
approach of Ada 95. A formal package can be specified with a box (<>)
or individual generic associations can carry a box while others have
real actuals. The visibility rules for for generic formals of formal
packages generalize those of Ada95, namely a formal is visible in the
enclosing generic if it is specified with a box, explicitly or implicitly.
gnat.dg/layered_instance.adb will now compile quietly.

Finally, when a formal type is a derived type the analysis of its declaration
introduces a subtype if the parent is constrained. If the parent itself
is a derived type the ultimate ancestor may be unconstrained, but the
legality check must be performed against the given formal, to prevent
spurious errors.
See gnat.dg/specs/formal_type.ads

2006-10-31  Ed Schonberg  <schonberg@adacore.com>
	    Hristian Kirtchev  <kirtchev@adacore.com>
        
        * sem_ch12.ads, sem_ch12.adb (Save_References): If node is an operator
	that has been constant-folded, preserve information of original tree,
	for ASIS uses.
	(Analyze_Formal_Derived_Type): Set the limited present flag of the newly
	generated private extension declaration if the formal derived type is
	synchronized. Carry synchronized present over to the generated private
	extension.
	(Validate_Derived_Type_Instance): Ensure that the actual of a
	synchronized formal derived type is a synchronized tagged type.
	(Instantiate_Formal_Package): When creating the instantiation used to
	validate the actual package of a formal declared without a box, check
	whether the formal itself depends on a prior actual.
	(Instantiate_Formal_Subprogram): Create new entities for the defining
	identifiers of the formals in the renaming declaration, for ASIS use.
	(Instantiate_Formal_Subprogram, Instantiate_Formal_Type): When creating
	a renaming declaration or a subtype declaration for an actual in an
	instance, capture location information of declaration in generic, for
	ASIS use.
	(Instantiate_Formal_Package): Add comments on needed additional tests.
	AI-317 (partial parametrization) is fully implemented.
	(Validate_Private_Type_Instance): Add check for actual which
	must have preelaborable initialization
	Use new // insertion for some continuation messages
	(Analyze_Formal_Object_Declaration): Change usage of Expression to
	Default_Expression. Add type retrieval when the declaration has an
	access definition. Update premature usage of incomplete type check.
	(Check_Access_Definition): New subsidiary routine. Check whether the
	current compilation version is Ada 05 and the supplied node has an
	access definition.
	(Instantiate object): Alphabetize local variables. Handle the creation
	of new renaming declarations with respect to the kind of definition
	used - either an access definition or a subtype mark. Guard against
	unnecessary error message in the context of anonymous access types after
	they have been resolved. Add check for required null exclusion in a
	formal object declaration.
	(Switch_View): A private subtype of a non-private type needs to be
	switched (the base type can have been switched without its private
	dependents because of the last branch of Check_Private_View.
	(Check_Private_View): Do not recompute Base_Type (T), instead use cached
	value from BT.
	(Instantiate_Type): Emit an error message whenever a class-wide type of
	a tagged incomplete type is used as a generic actual.
	(Find_Actual_Type): Extend routine to handle a component type in a child
	unit that is imported from a formal package in a parent.
	(Validate_Derived_Type_Instance): Check that analyzed formal and actual
	agree on constrainedness, rather than checking against ultimate ancestor
	(Instantiate_Subprogram_Body): Create a cross-reference link to the
	generic body, for navigation purposes.

-------------- next part --------------
Index: sem_ch12.ads
===================================================================
--- sem_ch12.ads	(revision 118179)
+++ sem_ch12.ads	(working copy)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2005, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2006, 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- --
@@ -126,4 +126,18 @@ package Sem_Ch12 is
    procedure Initialize;
    --  Initializes internal data structures
 
+   procedure Check_Private_View (N : Node_Id);
+   --  Check whether the type of a generic entity has a different view between
+   --  the point of generic analysis and the point of instantiation. If the
+   --  view has changed, then at the point of instantiation we restore the
+   --  correct view to perform semantic analysis of the instance, and reset
+   --  the current view after instantiation. The processing is driven by the
+   --  current private status of the type of the node, and Has_Private_View,
+   --  a flag that is set at the point of generic compilation. If view and
+   --  flag are inconsistent then the type is updated appropriately.
+   --
+   --  This subprogram is used in Check_Generic_Actuals and Copy_Generic_Node,
+   --  and is exported here for the purpose of front-end inlining (see Exp_Ch6.
+   --  Expand_Inlined_Call.Process_Formals).
+
 end Sem_Ch12;
Index: sem_ch12.adb
===================================================================
--- sem_ch12.adb	(revision 118179)
+++ sem_ch12.adb	(working copy)
@@ -78,13 +78,13 @@ package body Sem_Ch12 is
 
    ----------------------------------------------------------
    -- Implementation of Generic Analysis and Instantiation --
-   -----------------------------------------------------------
+   ----------------------------------------------------------
 
-   --  GNAT implements generics by macro expansion. No attempt is made to
-   --  share generic instantiations (for now). Analysis of a generic definition
-   --  does not perform any expansion action, but the expander must be called
-   --  on the tree for each instantiation, because the expansion may of course
-   --  depend on the generic actuals. All of this is best achieved as follows:
+   --  GNAT implements generics by macro expansion. No attempt is made to share
+   --  generic instantiations (for now). Analysis of a generic definition does
+   --  not perform any expansion action, but the expander must be called on the
+   --  tree for each instantiation, because the expansion may of course depend
+   --  on the generic actuals. All of this is best achieved as follows:
    --
    --  a) Semantic analysis of a generic unit is performed on a copy of the
    --  tree for the generic unit. All tree modifications that follow analysis
@@ -93,7 +93,7 @@ package body Sem_Ch12 is
    --  the generic, and propagate them to each instance (recall that name
    --  resolution is done on the generic declaration: generics are not really
    --  macros!). This is summarized in the following diagram:
-   --
+
    --              .-----------.               .----------.
    --              |  semantic |<--------------|  generic |
    --              |    copy   |               |    unit  |
@@ -108,13 +108,13 @@ package body Sem_Ch12 is
    --                                          |__|  |          |
    --                                             |__| instance |
    --                                                |__________|
-   --
+
    --  b) Each instantiation copies the original tree, and inserts into it a
    --  series of declarations that describe the mapping between generic formals
    --  and actuals. For example, a generic In OUT parameter is an object
    --  renaming of the corresponing actual, etc. Generic IN parameters are
    --  constant declarations.
-   --
+
    --  c) In order to give the right visibility for these renamings, we use
    --  a different scheme for package and subprogram instantiations. For
    --  packages, the list of renamings is inserted into the package
@@ -154,16 +154,16 @@ package body Sem_Ch12 is
 
    --  Visibility within nested generic units requires special handling.
    --  Consider the following scheme:
-   --
+
    --  type Global is ...         --  outside of generic unit.
    --  generic ...
    --  package Outer is
    --     ...
    --     type Semi_Global is ... --  global to inner.
-   --
+
    --     generic ...                                         -- 1
    --     procedure inner (X1 : Global;  X2 : Semi_Global);
-   --
+
    --     procedure in2 is new inner (...);                   -- 4
    --  end Outer;
 
@@ -221,31 +221,78 @@ package body Sem_Ch12 is
    -- Detection of Instantiation Circularities --
    ----------------------------------------------
 
-   --  If we have a chain of instantiations that is circular, this is a
-   --  static error which must be detected at compile time. The detection
-   --  of these circularities is carried out at the point that we insert
-   --  a generic instance spec or body. If there is a circularity, then
-   --  the analysis of the offending spec or body will eventually result
-   --  in trying to load the same unit again, and we detect this problem
-   --  as we analyze the package instantiation for the second time.
-
-   --  At least in some cases after we have detected the circularity, we
-   --  get into trouble if we try to keep going. The following flag is
-   --  set if a circularity is detected, and used to abandon compilation
-   --  after the messages have been posted.
+   --  If we have a chain of instantiations that is circular, this is static
+   --  error which must be detected at compile time. The detection of these
+   --  circularities is carried out at the point that we insert a generic
+   --  instance spec or body. If there is a circularity, then the analysis of
+   --  the offending spec or body will eventually result in trying to load the
+   --  same unit again, and we detect this problem as we analyze the package
+   --  instantiation for the second time.
+
+   --  At least in some cases after we have detected the circularity, we get
+   --  into trouble if we try to keep going. The following flag is set if a
+   --  circularity is detected, and used to abandon compilation after the
+   --  messages have been posted.
 
    Circularity_Detected : Boolean := False;
    --  This should really be reset on encountering a new main unit, but in
    --  practice we are not using multiple main units so it is not critical.
 
+   -------------------------------------------------
+   -- Formal packages and partial parametrization --
+   -------------------------------------------------
+
+   --  When compiling a generic, a formal package is a local instantiation. If
+   --  declared with a box, its generic formals are visible in the enclosing
+   --  generic. If declared with a partial list of actuals, those actuals that
+   --  are defaulted (covered by an Others clause, or given an explicit box
+   --  initialization) are also visible in the enclosing generic, while those
+   --  that have a corresponding actual are not.
+
+   --  In our source model of instantiation, the same visibility must be
+   --  present in the spec and body of an instance: the names of the formals
+   --  that are defaulted must be made visible within the instance, and made
+   --  invisible (hidden) after the instantiation is complete, so that they
+   --  are not accessible outside of the instance.
+
+   --  In a generic, a formal package is treated like a special instantiation.
+   --  Our Ada95 compiler handled formals with and without box in different
+   --  ways. With partial parametrization, we use a single model for both.
+   --  We create a package declaration that consists of the specification of
+   --  the generic package, and a set of declarations that map the actuals
+   --  into local renamings, just as we do for bona fide instantiations. For
+   --  defaulted parameters and formals with a box, we copy directly the
+   --  declarations of the formal into this local package. The result is a
+   --  a package whose visible declarations may include generic formals. This
+   --  package is only used for type checking and visibility analysis, and
+   --  never reaches the back-end, so it can freely violate the placement
+   --  rules for generic formal declarations.
+
+   --  The list of declarations (renamings and copies of formals) is built
+   --  by Analyze_Associations, just as for regular instantiations.
+
+   --  At the point of instantiation, conformance checking must be applied only
+   --  to those parameters that were specified in the formal. We perform this
+   --  checking by creating another internal instantiation, this one including
+   --  only the renamings and the formals (the rest of the package spec is not
+   --  relevant to conformance checking). We can then traverse two lists: the
+   --  list of actuals in the instance that corresponds to the formal package,
+   --  and the list of actuals produced for this bogus instantiation. We apply
+   --  the conformance rules to those actuals that are not defaulted (i.e.
+   --  which still appear as generic formals.
+
+   --  When we compile an instance body we must make the right parameters
+   --  visible again. The predicate Is_Generic_Formal indicates which of the
+   --  formals should have its Is_Hidden flag reset.
+
    -----------------------
    -- Local subprograms --
    -----------------------
 
    procedure Abandon_Instantiation (N : Node_Id);
    pragma No_Return (Abandon_Instantiation);
-   --  Posts an error message "instantiation abandoned" at the indicated
-   --  node and then raises the exception Instantiation_Error to do it.
+   --  Posts an error message "instantiation abandoned" at the indicated node
+   --  and then raises the exception Instantiation_Error to do it.
 
    procedure Analyze_Formal_Array_Type
      (T   : in out Entity_Id;
@@ -286,12 +333,12 @@ package body Sem_Ch12 is
      (N   : Node_Id;
       T   : Entity_Id;
       Def : Node_Id);
-   --  This needs comments???
+   --  Creates a new private type, which does not require completion
 
    procedure Analyze_Generic_Formal_Part (N : Node_Id);
 
    procedure Analyze_Generic_Access_Type (T : Entity_Id; Def : Node_Id);
-   --  This needs comments ???
+   --  Create a new access type with the given designated type
 
    function Analyze_Associations
      (I_Node  : Node_Id;
@@ -321,6 +368,10 @@ package body Sem_Ch12 is
    --  nodes or subprogram body and declaration nodes depending on the case).
    --  On return, the node N has been rewritten with the actual body.
 
+   procedure Check_Access_Definition (N : Node_Id);
+   --  Subsidiary routine to null exclusion processing. Perform an assertion
+   --  check on Ada version and the presence of an access definition in N.
+
    procedure Check_Formal_Packages (P_Id : Entity_Id);
    --  Apply the following to all formal packages in generic associations
 
@@ -345,16 +396,6 @@ package body Sem_Ch12 is
    --  instance, we need to make an explicit test that it is not hidden by
    --  a child instance of the same name and parent.
 
-   procedure Check_Private_View (N : Node_Id);
-   --  Check whether the type of a generic entity has a different view between
-   --  the point of generic analysis and the point of instantiation. If the
-   --  view has changed, then at the point of instantiation we restore the
-   --  correct view to perform semantic analysis of the instance, and reset
-   --  the current view after instantiation. The processing is driven by the
-   --  current private status of the type of the node, and Has_Private_View,
-   --  a flag that is set at the point of generic compilation. If view and
-   --  flag are inconsistent then the type is updated appropriately.
-
    procedure Check_Generic_Actuals
      (Instance      : Entity_Id;
       Is_Formal_Box : Boolean);
@@ -393,8 +434,14 @@ package body Sem_Ch12 is
    --  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) and Gen_Scope is the scope of
-   --  the analyzed formal array type.
+   --  (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
+   --  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.
+   --  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 ???
 
    function In_Same_Declarative_Part
      (F_Node : Node_Id;
@@ -410,6 +457,12 @@ package body Sem_Ch12 is
    --  Used to determine whether its body should be elaborated to allow
    --  front-end inlining.
 
+   function Is_Generic_Formal (E : Entity_Id) return Boolean;
+   --  Utility to determine whether a given entity is declared by means of
+   --  of a formal parameter declaration. Used to set properly the visiblity
+   --  of generic formals of a generic package declared with a box or with
+   --  partial parametrization.
+
    procedure Set_Instance_Env
      (Gen_Unit : Entity_Id;
       Act_Unit : Entity_Id);
@@ -531,6 +584,15 @@ package body Sem_Ch12 is
    --  apply these rules is to repeat the instantiation of the formal package
    --  in the context of the enclosing instance, and compare the generic
    --  associations of this instantiation with those of the actual package.
+   --  This internal instantiation only needs to contain the renamings of the
+   --  formals: the visible and private declarations themselves need not be
+   --  created.
+
+   --  In Ada2005, the formal package may be only partially parametrized. In
+   --  that case the visibility step must make visible those actuals whose
+   --  corresponding formals were given with a box. A final complication
+   --  involves inherited operations from formal derived types, which must be
+   --  visible if the type is.
 
    function Is_In_Main_Unit (N : Node_Id) return Boolean;
    --  Test if given node is in the main unit
@@ -768,7 +830,7 @@ package body Sem_Ch12 is
 
    procedure Abandon_Instantiation (N : Node_Id) is
    begin
-      Error_Msg_N ("instantiation abandoned!", N);
+      Error_Msg_N ("\instantiation abandoned!", N);
       raise Instantiation_Error;
    end Abandon_Instantiation;
 
@@ -783,7 +845,7 @@ package body Sem_Ch12 is
    is
       Actual_Types : constant Elist_Id  := New_Elmt_List;
       Assoc        : constant List_Id   := New_List;
-      Defaults     : constant Elist_Id  := New_Elmt_List;
+      Default_Actuals : constant Elist_Id  := New_Elmt_List;
       Gen_Unit     : constant Entity_Id := Defining_Entity (Parent (F_Copy));
       Actuals         : List_Id;
       Actual          : Node_Id;
@@ -794,11 +856,26 @@ package body Sem_Ch12 is
       Match           : Node_Id;
       Named           : Node_Id;
       First_Named     : Node_Id := Empty;
+
+      Default_Formals : constant List_Id := New_List;
+      --  If an Other_Choice is present, some of the formals may be defaulted.
+      --  To simplify the treatement of visibility in an instance, we introduce
+      --  individual defaults for each such formal. These defaults are
+      --  appended to the list of associations and replace the Others_Choice.
+
       Found_Assoc     : Node_Id;
+      --  Association for the current formal being match. Empty if there are
+      --  no remaining actuals, or if there is no named association with the
+      --  name of the formal.
+
       Is_Named_Assoc  : Boolean;
       Num_Matched     : Int := 0;
       Num_Actuals     : Int := 0;
 
+      Others_Present  : Boolean := False;
+      --  In Ada 2005, indicates partial parametrization of of a formal
+      --  package. As usual an others association must be last in the list.
+
       function Matching_Actual
         (F   : Entity_Id;
          A_F : Entity_Id) return Node_Id;
@@ -808,6 +885,21 @@ package body Sem_Ch12 is
       --  A_F is the corresponding entity in the analyzed generic,which is
       --  placed on the selector name for ASIS use.
 
+      --  In Ada 2005, a named association may be given with a box, in which
+      --  case Matching_Actual sets Found_Assoc to the generic association,
+      --  but return Empty for the actual itself. In this case the code below
+      --  creates a corresponding declaration for the formal.
+
+      function Partial_Parametrization return Boolean;
+      --  Ada 2005: if no match is found for a given formal, check if the
+      --  association for it includes a box, or whether the associations
+      --  include an Others clause.
+
+      procedure Process_Default (F : Entity_Id);
+      --  Add a copy of the declaration of generic formal  F to the list of
+      --  associations, and add an explicit box association for F  if there
+      --  is none yet, and the default comes from an Others_Choice.
+
       procedure Set_Analyzed_Formal;
       --  Find the node in the generic copy that corresponds to a given formal.
       --  The semantic information on this node is used to perform legality
@@ -825,8 +917,8 @@ package body Sem_Ch12 is
         (F   : Entity_Id;
          A_F : Entity_Id) return Node_Id
       is
-         Found : Node_Id;
          Prev  : Node_Id;
+         Act   : Node_Id;
 
       begin
          Is_Named_Assoc := False;
@@ -834,13 +926,14 @@ package body Sem_Ch12 is
          --  End of list of purely positional parameters
 
          if No (Actual) then
-            Found := Empty;
+            Found_Assoc := Empty;
+            Act         := Empty;
 
          --  Case of positional parameter corresponding to current formal
 
          elsif No (Selector_Name (Actual)) then
-            Found := Explicit_Generic_Actual_Parameter (Actual);
             Found_Assoc := Actual;
+            Act :=  Explicit_Generic_Actual_Parameter (Actual);
             Num_Matched := Num_Matched + 1;
             Next (Actual);
 
@@ -849,16 +942,17 @@ package body Sem_Ch12 is
 
          else
             Is_Named_Assoc := True;
-            Found := Empty;
-            Prev  := Empty;
+            Found_Assoc := Empty;
+            Act         := Empty;
+            Prev        := Empty;
 
             while Present (Actual) loop
                if Chars (Selector_Name (Actual)) = Chars (F) then
-                  Found := Explicit_Generic_Actual_Parameter (Actual);
                   Set_Entity (Selector_Name (Actual), A_F);
                   Set_Etype  (Selector_Name (Actual), Etype (A_F));
                   Generate_Reference (A_F, Selector_Name (Actual));
                   Found_Assoc := Actual;
+                  Act :=  Explicit_Generic_Actual_Parameter (Actual);
                   Num_Matched := Num_Matched + 1;
                   exit;
                end if;
@@ -885,9 +979,41 @@ package body Sem_Ch12 is
             Actual := First_Named;
          end if;
 
-         return Found;
+         return Act;
       end Matching_Actual;
 
+      -----------------------------
+      -- Partial_Parametrization --
+      -----------------------------
+
+      function Partial_Parametrization return Boolean is
+      begin
+         return Others_Present
+          or else (Present (Found_Assoc) and then Box_Present (Found_Assoc));
+      end Partial_Parametrization;
+
+      ---------------------
+      -- Process_Default --
+      ---------------------
+
+      procedure Process_Default (F : Entity_Id)  is
+         Loc     : constant Source_Ptr := Sloc (I_Node);
+         Default : Node_Id;
+
+      begin
+         Append (Copy_Generic_Node (F, Empty, True), Assoc);
+
+         if No (Found_Assoc) then
+            Default :=
+               Make_Generic_Association (Loc,
+               Selector_Name                     =>
+                 New_Occurrence_Of (Defining_Identifier (F), Loc),
+               Explicit_Generic_Actual_Parameter => Empty);
+            Set_Box_Present (Default);
+            Append (Default, Default_Formals);
+         end if;
+      end Process_Default;
+
       -------------------------
       -- Set_Analyzed_Formal --
       -------------------------
@@ -912,7 +1038,9 @@ package body Sem_Ch12 is
                   exit when
                     Kind = N_Formal_Package_Declaration
                       or else
-                    Kind = N_Generic_Package_Declaration;
+                    Kind = N_Generic_Package_Declaration
+                      or else
+                    Kind = N_Package_Declaration;
 
                when N_Use_Package_Clause | N_Use_Type_Clause => exit;
 
@@ -933,20 +1061,37 @@ package body Sem_Ch12 is
 
             Next (Analyzed_Formal);
          end loop;
-
       end Set_Analyzed_Formal;
 
    --  Start of processing for Analyze_Associations
 
    begin
-      --  If named associations are present, save the first named association
-      --  (it may of course be Empty) to facilitate subsequent name search.
-
       Actuals := Generic_Associations (I_Node);
 
       if Present (Actuals) then
-         First_Named := First (Actuals);
 
+         --  check for an Others choice, indicating a partial parametrization
+         --  for a formal package.
+
+         Actual := First (Actuals);
+         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;
+
+               Remove (Actual);
+               exit;
+            end if;
+
+            Next (Actual);
+         end loop;
+
+         --  If named associations are present, save first named association
+         --  (it may of course be Empty) to facilitate subsequent name search.
+
+         First_Named := First (Actuals);
          while Present (First_Named)
            and then No (Selector_Name (First_Named))
          loop
@@ -997,9 +1142,13 @@ package body Sem_Ch12 is
                       Defining_Identifier (Formal),
                       Defining_Identifier (Analyzed_Formal));
 
-                  Append_List
-                    (Instantiate_Object (Formal, Match, Analyzed_Formal),
-                     Assoc);
+                  if No (Match) and then Partial_Parametrization then
+                     Process_Default (Formal);
+                  else
+                     Append_List
+                       (Instantiate_Object (Formal, Match, Analyzed_Formal),
+                        Assoc);
+                  end if;
 
                when N_Formal_Type_Declaration =>
                   Match :=
@@ -1008,13 +1157,19 @@ package body Sem_Ch12 is
                       Defining_Identifier (Analyzed_Formal));
 
                   if No (Match) then
-                     Error_Msg_Sloc := Sloc (Gen_Unit);
-                     Error_Msg_NE
-                       ("missing actual&",
-                         Instantiation_Node, Defining_Identifier (Formal));
-                     Error_Msg_NE ("\in instantiation of & declared#",
-                         Instantiation_Node, Gen_Unit);
-                     Abandon_Instantiation (Instantiation_Node);
+                     if Partial_Parametrization then
+                        Process_Default (Formal);
+
+                     else
+                        Error_Msg_Sloc := Sloc (Gen_Unit);
+                        Error_Msg_NE
+                          ("missing actual&",
+                            Instantiation_Node,
+                              Defining_Identifier (Formal));
+                        Error_Msg_NE ("\in instantiation of & declared#",
+                            Instantiation_Node, Gen_Unit);
+                        Abandon_Instantiation (Instantiation_Node);
+                     end if;
 
                   else
                      Analyze (Match);
@@ -1082,12 +1237,15 @@ package body Sem_Ch12 is
                     Instantiate_Formal_Subprogram
                       (Formal, Match, Analyzed_Formal));
 
-                  if No (Match)
-                    and then Box_Present (Formal)
-                  then
-                     Append_Elmt
-                       (Defining_Unit_Name (Specification (Last (Assoc))),
-                         Defaults);
+                  if No (Match) then
+                     if  Partial_Parametrization then
+                        Process_Default (Formal);
+
+                     elsif Box_Present (Formal) then
+                        Append_Elmt
+                          (Defining_Unit_Name (Specification (Last (Assoc))),
+                            Default_Actuals);
+                     end if;
                   end if;
 
                when N_Formal_Package_Declaration =>
@@ -1097,14 +1255,19 @@ package body Sem_Ch12 is
                       Defining_Identifier (Original_Node (Analyzed_Formal)));
 
                   if No (Match) then
-                     Error_Msg_Sloc := Sloc (Gen_Unit);
-                     Error_Msg_NE
-                       ("missing actual&",
-                         Instantiation_Node, Defining_Identifier (Formal));
-                     Error_Msg_NE ("\in instantiation of & declared#",
-                         Instantiation_Node, Gen_Unit);
+                     if Partial_Parametrization then
+                        Process_Default (Formal);
 
-                     Abandon_Instantiation (Instantiation_Node);
+                     else
+                        Error_Msg_Sloc := Sloc (Gen_Unit);
+                        Error_Msg_NE
+                          ("missing actual&",
+                            Instantiation_Node, Defining_Identifier (Formal));
+                        Error_Msg_NE ("\in instantiation of & declared#",
+                            Instantiation_Node, Gen_Unit);
+
+                        Abandon_Instantiation (Instantiation_Node);
+                     end if;
 
                   else
                      Analyze (Match);
@@ -1114,15 +1277,21 @@ package body Sem_Ch12 is
                         Assoc);
                   end if;
 
-               --  For use type and use package appearing in the context
-               --  clause, we have already copied them, so we can just
+               --  For use type and use package appearing in the generic
+               --  part, we have already copied them, so we can just
                --  move them where they belong (we mustn't recopy them
                --  since this would mess up the Sloc values).
 
                when N_Use_Package_Clause |
                     N_Use_Type_Clause    =>
-                  Remove (Formal);
-                  Append (Formal, Assoc);
+                  if Nkind (Original_Node (I_Node)) =
+                    N_Formal_Package_Declaration
+                  then
+                     Append (New_Copy_Tree (Formal), Assoc);
+                  else
+                     Remove (Formal);
+                     Append (Formal, Assoc);
+                  end if;
 
                when others =>
                   raise Program_Error;
@@ -1174,7 +1343,7 @@ package body Sem_Ch12 is
          New_D : Node_Id;
 
       begin
-         Elmt := First_Elmt (Defaults);
+         Elmt := First_Elmt (Default_Actuals);
          while Present (Elmt) loop
             if No (Actuals) then
                Actuals := New_List;
@@ -1193,6 +1362,14 @@ package body Sem_Ch12 is
          end loop;
       end;
 
+      --  If this is a formal package. normalize the parameter list by
+      --  adding explicit box asssociations for the formals that are covered
+      --  by an Others_Choice.
+
+      if not Is_Empty_List (Default_Formals) then
+         Append_List (Default_Formals, Formals);
+      end if;
+
       return Assoc;
    end Analyze_Associations;
 
@@ -1311,9 +1488,11 @@ package body Sem_Ch12 is
    -------------------------------------------
 
    procedure Analyze_Formal_Derived_Interface_Type
-     (T : Entity_Id;
+     (T   : Entity_Id;
       Def : Node_Id)
    is
+      Ifaces_List : Elist_Id;
+
    begin
       Enter_Name (T);
       Set_Ekind  (T, E_Record_Type);
@@ -1321,9 +1500,17 @@ package body Sem_Ch12 is
       Analyze (Subtype_Indication (Def));
       Analyze_Interface_Declaration (T, Def);
       Make_Class_Wide_Type (T);
-      Set_Primitive_Operations (T, New_Elmt_List);
       Analyze_List (Interface_List (Def));
-      Collect_Interfaces (Def, T);
+
+      --  Ada 2005 (AI-251): Collect the list of progenitors that are not
+      --  already covered by the parents.
+
+      Collect_Abstract_Interfaces
+        (T                         => T,
+         Ifaces_List               => Ifaces_List,
+         Exclude_Parent_Interfaces => True);
+
+      Set_Abstract_Interfaces (T, Ifaces_List);
    end Analyze_Formal_Derived_Interface_Type;
 
    ---------------------------------
@@ -1348,10 +1535,12 @@ package body Sem_Ch12 is
              Defining_Identifier           => T,
              Discriminant_Specifications   => Discriminant_Specifications (N),
              Unknown_Discriminants_Present => Unk_Disc,
-             Subtype_Indication            => Subtype_Mark (Def));
+             Subtype_Indication            => Subtype_Mark (Def),
+             Interface_List                => Interface_List (Def));
 
-         Set_Abstract_Present (New_N, Abstract_Present (Def));
-         Set_Limited_Present  (New_N, Limited_Present  (Def));
+         Set_Abstract_Present     (New_N, Abstract_Present     (Def));
+         Set_Limited_Present      (New_N, Limited_Present      (Def));
+         Set_Synchronized_Present (New_N, Synchronized_Present (Def));
 
       else
          New_N :=
@@ -1366,7 +1555,7 @@ package body Sem_Ch12 is
          Set_Abstract_Present
            (Type_Definition (New_N), Abstract_Present (Def));
          Set_Limited_Present
-           (Type_Definition (New_N), Limited_Present (Def));
+           (Type_Definition (New_N), Limited_Present  (Def));
       end if;
 
       Rewrite (N, New_N);
@@ -1516,7 +1705,7 @@ package body Sem_Ch12 is
    ---------------------------------------
 
    procedure Analyze_Formal_Object_Declaration (N : Node_Id) is
-      E  : constant Node_Id := Expression (N);
+      E  : constant Node_Id := Default_Expression (N);
       Id : constant Node_Id := Defining_Identifier (N);
       K  : Entity_Kind;
       T  : Node_Id;
@@ -1537,11 +1726,33 @@ package body Sem_Ch12 is
          K := E_Generic_In_Parameter;
       end if;
 
-      Find_Type (Subtype_Mark (N));
-      T  := Entity (Subtype_Mark (N));
+      if Present (Subtype_Mark (N)) then
+         Find_Type (Subtype_Mark (N));
+         T := Entity (Subtype_Mark (N));
+
+      --  Ada 2005 (AI-423): Formal object with an access definition
+
+      else
+         Check_Access_Definition (N);
+         T := Access_Definition
+                (Related_Nod => N,
+                 N           => Access_Definition (N));
+      end if;
 
       if Ekind (T) = E_Incomplete_Type then
-         Error_Msg_N ("premature usage of incomplete type", Subtype_Mark (N));
+         declare
+            Error_Node : Node_Id;
+
+         begin
+            if Present (Subtype_Mark (N)) then
+               Error_Node := Subtype_Mark (N);
+            else
+               Check_Access_Definition (N);
+               Error_Node := Access_Definition (N);
+            end if;
+
+            Error_Msg_N ("premature usage of incomplete type", Error_Node);
+         end;
       end if;
 
       if K = E_Generic_In_Parameter then
@@ -1666,6 +1877,110 @@ package body Sem_Ch12 is
       Renaming         : Node_Id;
       Parent_Instance  : Entity_Id;
       Renaming_In_Par  : Entity_Id;
+      No_Associations  : Boolean := False;
+
+      function Build_Local_Package return Node_Id;
+      --  The formal package is rewritten so that its parameters are replaced
+      --  with corresponding declarations. For parameters with bona fide
+      --  associations these declarations are created by Analyze_Associations
+      --  as for aa regular instantiation. For boxed parameters, we preserve
+      --  the formal declarations and analyze them, in order to introduce
+      --  entities of the right kind in the environment of the formal.
+
+      -------------------------
+      -- Build_Local_Package --
+      -------------------------
+
+      function Build_Local_Package return Node_Id is
+         Decls     : List_Id;
+         Pack_Decl : Node_Id;
+
+      begin
+         --  Within the formal, the name of the generic package is a renaming
+         --  of the formal (as for a regular instantiation).
+
+         Pack_Decl :=
+           Make_Package_Declaration (Loc,
+             Specification =>
+               Copy_Generic_Node
+                 (Specification (Original_Node (Gen_Decl)),
+                    Empty, Instantiating => True));
+
+         Renaming := Make_Package_Renaming_Declaration (Loc,
+             Defining_Unit_Name =>
+               Make_Defining_Identifier (Loc, Chars (Gen_Unit)),
+             Name => New_Occurrence_Of (Formal, Loc));
+
+         if Nkind (Gen_Id) = N_Identifier
+           and then Chars (Gen_Id) = Chars (Pack_Id)
+         then
+            Error_Msg_NE
+              ("& is hidden within declaration of instance", Gen_Id, Gen_Unit);
+         end if;
+
+         --  If the formal is declared with a box, or with an others choice,
+         --  create corresponding declarations for all entities in the formal
+         --  part, so that names with the proper types are available in the
+         --  specification of the formal package.
+
+         if No_Associations then
+            declare
+               Formal_Decl : Node_Id;
+
+            begin
+               --  TBA : for a formal package, need to recurse
+
+               Decls := New_List;
+               Formal_Decl :=
+                 First
+                   (Generic_Formal_Declarations (Original_Node (Gen_Decl)));
+               while Present (Formal_Decl) loop
+                  Append_To
+                    (Decls, Copy_Generic_Node (Formal_Decl, Empty, True));
+                  Next (Formal_Decl);
+               end loop;
+            end;
+
+         --  If generic associations are present, use Analyze_Associations to
+         --  create the proper renaming declarations.
+
+         else
+            declare
+               Act_Tree : constant Node_Id :=
+                            Copy_Generic_Node
+                              (Original_Node (Gen_Decl), Empty,
+                               Instantiating => True);
+
+            begin
+               Generic_Renamings.Set_Last (0);
+               Generic_Renamings_HTable.Reset;
+               Instantiation_Node := N;
+
+               Decls :=
+                 Analyze_Associations
+                   (Original_Node (N),
+                      Generic_Formal_Declarations (Act_Tree),
+                      Generic_Formal_Declarations (Gen_Decl));
+            end;
+         end if;
+
+         Append (Renaming, To => Decls);
+
+         --  Add generated declarations ahead of local declarations in
+         --  the package.
+
+         if No (Visible_Declarations (Specification (Pack_Decl))) then
+            Set_Visible_Declarations (Specification (Pack_Decl), Decls);
+         else
+            Insert_List_Before
+              (First (Visible_Declarations (Specification (Pack_Decl))),
+                 Decls);
+         end if;
+
+         return Pack_Decl;
+      end Build_Local_Package;
+
+   --  Start of processing for Analyze_Formal_Package
 
    begin
       Text_IO_Kludge (Gen_Id);
@@ -1714,107 +2029,114 @@ package body Sem_Ch12 is
          end if;
       end if;
 
-      --  The formal package is treated like a regular instance, but only
-      --  the specification needs to be instantiated, to make entities visible.
+      if Box_Present (N)
+        or else No (Generic_Associations (N))
+        or else Nkind (First (Generic_Associations (N))) = N_Others_Choice
+      then
+         No_Associations := True;
+      end if;
 
-      if not Box_Present (N) then
-         Hidden_Entities := New_Elmt_List;
-         Analyze_Package_Instantiation (N);
+      --  If there are no generic associations, the generic parameters
+      --  appear as local entities and are instantiated like them. We copy
+      --  the generic package declaration as if it were an instantiation,
+      --  and analyze it like a regular package, except that we treat the
+      --  formals as additional visible components.
 
-         if Parent_Installed then
-            Remove_Parent;
-         end if;
+      Gen_Decl := Unit_Declaration_Node (Gen_Unit);
 
-      else
-         --  If there are no generic associations, the generic parameters
-         --  appear as local entities and are instantiated like them. We copy
-         --  the generic package declaration as if it were an instantiation,
-         --  and analyze it like a regular package, except that we treat the
-         --  formals as additional visible components.
+      if In_Extended_Main_Source_Unit (N) then
+         Set_Is_Instantiated (Gen_Unit);
+         Generate_Reference  (Gen_Unit, N);
+      end if;
 
-         Gen_Decl := Unit_Declaration_Node (Gen_Unit);
+      Formal := New_Copy (Pack_Id);
+      Create_Instantiation_Source (N, Gen_Unit, False, S_Adjustment);
 
-         if In_Extended_Main_Source_Unit (N) then
-            Set_Is_Instantiated (Gen_Unit);
-            Generate_Reference  (Gen_Unit, N);
-         end if;
+      --  Make local generic without formals. The formals will be replaced
+      --  with internal declarations..
 
-         Formal := New_Copy (Pack_Id);
-         Create_Instantiation_Source (N, Gen_Unit, False, S_Adjustment);
+      New_N := Build_Local_Package;
+      Rewrite (N, New_N);
+      Set_Defining_Unit_Name (Specification (New_N), Formal);
+      Set_Generic_Parent (Specification (N), Gen_Unit);
+      Set_Instance_Env (Gen_Unit, Formal);
+      Set_Is_Generic_Instance (Formal);
+
+      Enter_Name (Formal);
+      Set_Ekind  (Formal, E_Package);
+      Set_Etype  (Formal, Standard_Void_Type);
+      Set_Inner_Instances (Formal, New_Elmt_List);
+      New_Scope  (Formal);
 
-         New_N :=
-           Copy_Generic_Node
-             (Original_Node (Gen_Decl), Empty, Instantiating => True);
-         Rewrite (N, New_N);
-         Set_Defining_Unit_Name (Specification (New_N), Formal);
-         Set_Generic_Parent (Specification (N), Gen_Unit);
-         Set_Instance_Env (Gen_Unit, Formal);
-
-         Enter_Name (Formal);
-         Set_Ekind  (Formal, E_Generic_Package);
-         Set_Etype  (Formal, Standard_Void_Type);
-         Set_Inner_Instances (Formal, New_Elmt_List);
-         New_Scope  (Formal);
+      if Is_Child_Unit (Gen_Unit)
+        and then Parent_Installed
+      then
+         --  Similarly, we have to make the name of the formal visible in
+         --  the parent instance, to resolve properly fully qualified names
+         --  that may appear in the generic unit. The parent instance has
+         --  been placed on the scope stack ahead of the current scope.
+
+         Parent_Instance := Scope_Stack.Table (Scope_Stack.Last - 1).Entity;
+
+         Renaming_In_Par :=
+           Make_Defining_Identifier (Loc, Chars (Gen_Unit));
+         Set_Ekind (Renaming_In_Par, E_Package);
+         Set_Etype (Renaming_In_Par, Standard_Void_Type);
+         Set_Scope (Renaming_In_Par, Parent_Instance);
+         Set_Parent (Renaming_In_Par, Parent (Formal));
+         Set_Renamed_Object (Renaming_In_Par, Formal);
+         Append_Entity (Renaming_In_Par, Parent_Instance);
+      end if;
 
-         --  Within the formal, the name of the generic package is a renaming
-         --  of the formal (as for a regular instantiation).
+      Analyze (Specification (N));
 
-         Renaming := Make_Package_Renaming_Declaration (Loc,
-             Defining_Unit_Name =>
-               Make_Defining_Identifier (Loc, Chars (Gen_Unit)),
-             Name => New_Reference_To (Formal, Loc));
+      --  The formals for which associations are provided are not visible
+      --  outside of the formal package. The others are still declared by
+      --  a formal parameter declaration.
 
-         if Present (Visible_Declarations (Specification (N))) then
-            Prepend (Renaming, To => Visible_Declarations (Specification (N)));
-         elsif Present (Private_Declarations (Specification (N))) then
-            Prepend (Renaming, To => Private_Declarations (Specification (N)));
-         end if;
+      if not No_Associations then
+         declare
+            E : Entity_Id;
 
-         if Is_Child_Unit (Gen_Unit)
-           and then Parent_Installed
-         then
-            --  Similarly, we have to make the name of the formal visible in
-            --  the parent instance, to resolve properly fully qualified names
-            --  that may appear in the generic unit. The parent instance has
-            --  been placed on the scope stack ahead of the current scope.
+         begin
+            E := First_Entity (Formal);
+            while Present (E) loop
+               exit when Ekind (E) = E_Package
+                 and then Renamed_Entity (E) = Formal;
 
-            Parent_Instance := Scope_Stack.Table (Scope_Stack.Last - 1).Entity;
+               if not Is_Generic_Formal (E) then
+                  Set_Is_Hidden (E);
+               end if;
 
-            Renaming_In_Par :=
-              Make_Defining_Identifier (Loc, Chars (Gen_Unit));
-            Set_Ekind (Renaming_In_Par, E_Package);
-            Set_Etype (Renaming_In_Par, Standard_Void_Type);
-            Set_Scope (Renaming_In_Par, Parent_Instance);
-            Set_Parent (Renaming_In_Par, Parent (Formal));
-            Set_Renamed_Object (Renaming_In_Par, Formal);
-            Append_Entity (Renaming_In_Par, Parent_Instance);
-         end if;
+               Next_Entity (E);
+            end loop;
+         end;
+      end if;
 
-         Analyze_Generic_Formal_Part (N);
-         Analyze (Specification (N));
-         End_Package_Scope (Formal);
+      End_Package_Scope (Formal);
 
-         if Parent_Installed then
-            Remove_Parent;
-         end if;
+      if Parent_Installed then
+         Remove_Parent;
+      end if;
 
-         Restore_Env;
+      Restore_Env;
 
-         --  Inside the generic unit, the formal package is a regular
-         --  package, but no body is needed for it. Note that after
-         --  instantiation, the defining_unit_name we need is in the
-         --  new tree and not in the original. (see Package_Instantiation).
-         --  A generic formal package is an instance, and can be used as
-         --  an actual for an inner instance.
-
-         Set_Ekind (Formal, E_Package);
-         Set_Has_Completion (Formal, True);
-
-         Set_Ekind (Pack_Id, E_Package);
-         Set_Etype (Pack_Id, Standard_Void_Type);
-         Set_Scope (Pack_Id, Scope (Formal));
-         Set_Has_Completion (Pack_Id, True);
-      end if;
+      --  Inside the generic unit, the formal package is a regular
+      --  package, but no body is needed for it. Note that after
+      --  instantiation, the defining_unit_name we need is in the
+      --  new tree and not in the original. (see Package_Instantiation).
+      --  A generic formal package is an instance, and can be used as
+      --  an actual for an inner instance.
+
+      Set_Has_Completion (Formal, True);
+
+      --  Add semantic information to the original defining identifier.
+      --  for ASIS use.
+
+      Set_Ekind (Pack_Id, E_Package);
+      Set_Etype (Pack_Id, Standard_Void_Type);
+      Set_Scope (Pack_Id, Scope (Formal));
+      Set_Has_Completion (Pack_Id, True);
    end Analyze_Formal_Package;
 
    ---------------------------------
@@ -2374,10 +2696,6 @@ package body Sem_Ch12 is
    -- Analyze_Package_Instantiation --
    -----------------------------------
 
-   --  Note: this procedure is also used for formal package declarations, in
-   --  which case the argument N is an N_Formal_Package_Declaration node.
-   --  This should really be noted in the spec! ???
-
    procedure Analyze_Package_Instantiation (N : Node_Id) is
       Loc    : constant Source_Ptr := Sloc (N);
       Gen_Id : constant Node_Id    := Name (N);
@@ -2925,9 +3243,6 @@ package body Sem_Ch12 is
                end if;
             end if;
 
-            --  There is a problem with inlining here
-            --  More comments needed??? what problem
-
             Set_Unit (Parent (N), Act_Decl);
             Set_Parent_Spec (Act_Decl, Parent_Spec (N));
             Set_Package_Instantiation (Act_Decl_Id, N);
@@ -3852,6 +4167,18 @@ package body Sem_Ch12 is
       Build_Elaboration_Entity (Decl_Cunit, New_Main);
    end Build_Instance_Compilation_Unit_Nodes;
 
+   -----------------------------
+   -- Check_Access_Definition --
+   -----------------------------
+
+   procedure Check_Access_Definition (N : Node_Id) is
+   begin
+      pragma Assert
+        (Ada_Version >= Ada_05
+           and then Present (Access_Definition (N)));
+      null;
+   end Check_Access_Definition;
+
    -----------------------------------
    -- Check_Formal_Package_Instance --
    -----------------------------------
@@ -3892,8 +4219,19 @@ package body Sem_Ch12 is
       --------------------
 
       procedure Check_Mismatch (B : Boolean) is
+         Kind : constant Node_Kind := Nkind (Parent (E2));
+
       begin
-         if B then
+         if Kind = N_Formal_Type_Declaration then
+            return;
+
+         elsif Kind = N_Formal_Object_Declaration
+           or else Kind in N_Formal_Subprogram_Declaration
+           or else Kind = N_Formal_Package_Declaration
+         then
+            null;
+
+         elsif B then
             Error_Msg_NE
               ("actual for & in actual instance does not match formal",
                Parent (Actual_Pack), E1);
@@ -3990,6 +4328,9 @@ package body Sem_Ch12 is
             --  Itypes generated for other parameters need not be checked,
             --  the check will be performed on the parameters themselves.
 
+            --  If E2 is a formal type declaration, it is a defaulted
+            --  parameter and needs no checking.
+
             if not Is_Itype (E1)
               and then not Is_Itype (E2)
             then
@@ -4086,7 +4427,8 @@ package body Sem_Ch12 is
          elsif Is_Overloadable (E1) then
 
             --  Verify that the names of the  entities match.
-            --  What if actual is an attribute ???
+            --  Note that actuals that are attributes are rewritten
+            --  as subprograms.
 
             Check_Mismatch
               (Ekind (E2) /= Ekind (E1) or else (Alias (E1)) /= Alias (E2));
@@ -4128,6 +4470,12 @@ package body Sem_Ch12 is
             elsif not Box_Present (Parent (Associated_Formal_Package (E))) then
                Formal_P := Next_Entity (E);
                Check_Formal_Package_Instance (Formal_P, E);
+
+               --  After checking, remove the internal validating package. It
+               --  is only needed for semantic checks, and as it may contain
+               --  generic formal declarations it should not reach gigi.
+
+               Remove (Unit_Declaration_Node (Formal_P));
             end if;
          end if;
 
@@ -4287,9 +4635,14 @@ package body Sem_Ch12 is
             elsif Denotes_Formal_Package (E) then
                null;
 
-            elsif Present (Associated_Formal_Package (E)) then
+            elsif Present (Associated_Formal_Package (E))
+              and then not Is_Generic_Formal (E)
+            then
                if Box_Present (Parent (Associated_Formal_Package (E))) then
                   Check_Generic_Actuals (Renamed_Object (E), True);
+
+               else
+                  Check_Generic_Actuals (Renamed_Object (E), False);
                end if;
 
                Set_Is_Hidden (E, False);
@@ -4301,8 +4654,13 @@ package body Sem_Ch12 is
          elsif Is_Wrapper_Package (Instance) then
             Set_Is_Hidden (E, False);
 
-         else
-            Set_Is_Hidden (E, not Is_Formal_Box);
+         --  If the formal package is declared with a box, or if the formal
+         --  parameter is defaulted, it is visible in the body.
+
+         elsif Is_Formal_Box
+           or else Is_Visible_Formal (E)
+         then
+            Set_Is_Hidden (E, False);
          end if;
 
          Next_Entity (E);
@@ -4743,15 +5101,21 @@ package body Sem_Ch12 is
          then
             Switch_View (T);
 
-         --  Finally, a non-private subtype may have a private base type,
-         --  which must be exchanged for consistency. This can happen when
-         --  instantiating a package body, when the scope stack is empty
-         --  but in fact the subtype and the base type are declared in an
-         --  enclosing scope.
+         --  Finally, a non-private subtype may have a private base type, which
+         --  must be exchanged for consistency. This can happen when
+         --  instantiating a package body, when the scope stack is empty but in
+         --  fact the subtype and the base type are declared in an enclosing
+         --  scope.
+
+         --  Note that in this case we introduce an inconsistency in the view
+         --  set, because we switch the base type BT, but there could be some
+         --  private dependent subtypes of BT which remain unswitched. Such
+         --  subtypes might need to be switched at a later point (see specific
+         --  provision for that case in Switch_View).
 
          elsif not Is_Private_Type (T)
            and then not Has_Private_View (N)
-           and then Is_Private_Type (Base_Type (T))
+           and then Is_Private_Type (BT)
            and then Present (Full_View (BT))
            and then not Is_Generic_Type (BT)
            and then not In_Open_Scopes (BT)
@@ -5465,7 +5829,9 @@ package body Sem_Ch12 is
       then
          return True;
 
-      elsif Nkind (Parent (Pack)) = N_Formal_Package_Declaration then
+      elsif Nkind (Original_Node (Unit_Declaration_Node (Pack))) =
+        N_Formal_Package_Declaration
+      then
          return True;
 
       elsif No (Par) then
@@ -5482,6 +5848,7 @@ package body Sem_Ch12 is
               or else Nkind (Parent (E)) /= N_Package_Renaming_Declaration
             then
                null;
+
             elsif Renamed_Object (E) = Par then
                return False;
 
@@ -5535,6 +5902,9 @@ package body Sem_Ch12 is
          while Present (T) loop
             if In_Open_Scopes (Scope (T)) then
                return T;
+
+            elsif Is_Generic_Actual_Type (T) then
+               return T;
             end if;
 
             T := Homonym (T);
@@ -5898,7 +6268,7 @@ package body Sem_Ch12 is
             return Unit (Parent (Decl));
          end if;
 
-      elsif Nkind (Decl) = N_Generic_Package_Declaration
+      elsif Nkind (Decl) = N_Package_Declaration
         and then Nkind (Original_Node (Decl)) = N_Formal_Package_Declaration
       then
          return Original_Node (Decl);
@@ -6874,6 +7244,7 @@ package body Sem_Ch12 is
             Ent := First_Entity (Formal);
             while Present (Ent) loop
                Set_Is_Hidden (Ent, False);
+               Set_Is_Visible_Formal (Ent);
                Set_Is_Potentially_Use_Visible
                  (Ent, Is_Potentially_Use_Visible (Formal));
 
@@ -6969,64 +7340,114 @@ package body Sem_Ch12 is
          --  handle checking of actual parameter associations for later
          --  formals that depend on actuals declared in the formal package.
 
-         if Box_Present (Formal) then
-            declare
-               Gen_Decl    : constant Node_Id :=
-                               Unit_Declaration_Node (Gen_Parent);
-               Formals     : constant List_Id :=
-                               Generic_Formal_Declarations (Gen_Decl);
-               Actual_Ent  : Entity_Id;
-               Formal_Node : Node_Id;
-               Formal_Ent  : Entity_Id;
+         --  In Ada 2005, partial parametrization requires that we make
+         --  visible the actuals corresponding to formals that were defaulted
+         --  in the formal package. There formals are identified because they
+         --  remain formal generics within the formal package, rather than
+         --  being renamings of the actuals supplied.
 
-            begin
-               if Present (Formals) then
-                  Formal_Node := First_Non_Pragma (Formals);
-               else
-                  Formal_Node := Empty;
-               end if;
+         declare
+            Gen_Decl    : constant Node_Id :=
+                            Unit_Declaration_Node (Gen_Parent);
+            Formals     : constant List_Id :=
+                            Generic_Formal_Declarations (Gen_Decl);
+            Actual_Ent  : Entity_Id;
+            Formal_Node : Node_Id;
+            Formal_Ent  : Entity_Id;
 
-               Actual_Ent := First_Entity (Actual_Pack);
+         begin
+            if Present (Formals) then
+               Formal_Node := First_Non_Pragma (Formals);
+            else
+               Formal_Node := Empty;
+            end if;
 
-               while Present (Actual_Ent)
-                 and then Actual_Ent /= First_Private_Entity (Actual_Pack)
-               loop
-                  Set_Is_Hidden (Actual_Ent, False);
-                  Set_Is_Potentially_Use_Visible
-                    (Actual_Ent, In_Use (Actual_Pack));
+            Actual_Ent := First_Entity (Actual_Pack);
+            while Present (Actual_Ent)
+              and then Actual_Ent /= First_Private_Entity (Actual_Pack)
+            loop
+               if Present (Formal_Node) then
+                  Formal_Ent := Get_Formal_Entity (Formal_Node);
 
-                  if Ekind (Actual_Ent) = E_Package then
-                     Process_Nested_Formal (Actual_Ent);
-                  end if;
+                  if Present (Formal_Ent) then
+                     Find_Matching_Actual (Formal_Node, Actual_Ent);
+                     Match_Formal_Entity
+                       (Formal_Node, Formal_Ent, Actual_Ent);
 
-                  if Present (Formal_Node) then
-                     Formal_Ent := Get_Formal_Entity (Formal_Node);
+                     if Box_Present (Formal)
+                       or else
+                         (Present (Formal_Node)
+                           and then Is_Generic_Formal (Formal_Ent))
+                     then
+                        --  This may make too many formal entities visible,
+                        --  but it's hard to build an example that exposes
+                        --  this excess visibility. If a reference in the
+                        --  generic resolved to a global variable then the
+                        --  extra visibility in an instance does not affect
+                        --  the captured entity. If the reference resolved
+                        --  to a local entity it will resolve again in the
+                        --  instance. Nevertheless, we should build tests
+                        --  to make sure that hidden entities in the generic
+                        --  remain hidden in the instance.
+
+                        Set_Is_Hidden (Actual_Ent, False);
+                        Set_Is_Visible_Formal (Actual_Ent);
+                        Set_Is_Potentially_Use_Visible
+                          (Actual_Ent, In_Use (Actual_Pack));
 
-                     if Present (Formal_Ent) then
-                        Find_Matching_Actual (Formal_Node, Actual_Ent);
-                        Match_Formal_Entity
-                          (Formal_Node, Formal_Ent, Actual_Ent);
+                        if Ekind (Actual_Ent) = E_Package then
+                           Process_Nested_Formal (Actual_Ent);
+                        end if;
                      end if;
+                  end if;
 
-                     Next_Non_Pragma (Formal_Node);
+                  Next_Non_Pragma (Formal_Node);
 
-                  else
-                     --  No further formals to match, but the generic
-                     --  part may contain inherited operation that are
-                     --  not hidden in the enclosing instance.
+               else
+                  --  No further formals to match, but the generic
+                  --  part may contain inherited operation that are
+                  --  not hidden in the enclosing instance.
 
-                     Next_Entity (Actual_Ent);
-                  end if;
+                  Next_Entity (Actual_Ent);
+               end if;
 
-               end loop;
-            end;
+            end loop;
+
+            --  Inherited subprograms generated by formal derived types are
+            --  also visible if the types are.
+
+            Actual_Ent := First_Entity (Actual_Pack);
+            while Present (Actual_Ent)
+              and then Actual_Ent /= First_Private_Entity (Actual_Pack)
+            loop
+               if Is_Overloadable (Actual_Ent)
+                 and then
+                   Nkind (Parent (Actual_Ent)) = N_Subtype_Declaration
+                 and then
+                   not Is_Hidden (Defining_Identifier (Parent (Actual_Ent)))
+               then
+                  Set_Is_Hidden (Actual_Ent, False);
+                  Set_Is_Potentially_Use_Visible
+                    (Actual_Ent, In_Use (Actual_Pack));
+               end if;
+
+               Next_Entity (Actual_Ent);
+            end loop;
+         end;
 
          --  If the formal is not declared with a box, reanalyze it as
-         --  an instantiation, to verify the matching rules of 12.7. The
-         --  actual checks are performed after the generic associations
-         --  been analyzed.
+         --  an abbreviated instantiation, to verify the matching rules
+         --  of 12.7. The actual checks are performed after the generic
+         --  associations have been analyzed, to guarantee the same
+         --  visibility for this instantiation and for the actuals.
+
+         --  In Ada 2005, the generic associations for the formal can include
+         --  defaulted parameters. These are ignored during check. This
+         --  internal instantiation is removed from the tree after conformance
+         --  checking, because it contains formal declarations for those
+         --  defaulted parameters, and those should not reach the back-end.
 
-         else
+         if not Box_Present (Formal) then
             declare
                I_Pack : constant Entity_Id :=
                           Make_Defining_Identifier (Sloc (Actual),
@@ -7038,7 +7459,9 @@ package body Sem_Ch12 is
                Append_To (Decls,
                  Make_Package_Instantiation (Sloc (Actual),
                    Defining_Unit_Name => I_Pack,
-                   Name => New_Occurrence_Of (Gen_Parent, Sloc (Actual)),
+                   Name =>
+                     New_Occurrence_Of
+                       (Get_Instance_Of (Gen_Parent), Sloc (Actual)),
                    Generic_Associations =>
                      Generic_Associations (Formal)));
             end;
@@ -7057,7 +7480,7 @@ package body Sem_Ch12 is
       Actual          : Node_Id;
       Analyzed_Formal : Node_Id) return Node_Id
    is
-      Loc        : Source_Ptr := Sloc (Instantiation_Node);
+      Loc        : Source_Ptr;
       Formal_Sub : constant Entity_Id :=
                      Defining_Unit_Name (Specification (Formal));
       Analyzed_S : constant Entity_Id :=
@@ -7136,11 +7559,34 @@ package body Sem_Ch12 is
    begin
       New_Spec := New_Copy_Tree (Specification (Formal));
 
+      --  The tree copy has created the proper instantiation sloc for the
+      --  new specification. Use this location for all other constructed
+      --  declarations.
+
+      Loc := Sloc (Defining_Unit_Name (New_Spec));
+
       --  Create new entity for the actual (New_Copy_Tree does not)
 
       Set_Defining_Unit_Name
         (New_Spec, Make_Defining_Identifier (Loc, Chars (Formal_Sub)));
 
+      --  Create new entities for the each of the formals in the
+      --  specification of the renaming declaration built for the actual.
+
+      if Present (Parameter_Specifications (New_Spec)) then
+         declare
+            F : Node_Id;
+         begin
+            F := First (Parameter_Specifications (New_Spec));
+            while Present (F) loop
+               Set_Defining_Identifier (F,
+                  Make_Defining_Identifier (Loc,
+                    Chars => Chars (Defining_Identifier (F))));
+               Next (F);
+            end loop;
+         end;
+      end if;
+
       --  Find entity of actual. If the actual is an attribute reference, it
       --  cannot be resolved here (its formal is missing) but is handled
       --  instead in Attribute_Renaming. If the actual is overloaded, it is
@@ -7332,18 +7778,28 @@ package body Sem_Ch12 is
       Actual          : Node_Id;
       Analyzed_Formal : Node_Id) return List_Id
    is
-      Formal_Id : constant Entity_Id  := Defining_Identifier (Formal);
-      Type_Id   : constant Node_Id    := Subtype_Mark (Formal);
-      Loc       : constant Source_Ptr := Sloc (Actual);
-      Act_Assoc : constant Node_Id    := Parent (Actual);
-      Orig_Ftyp : constant Entity_Id  :=
-                    Etype (Defining_Identifier (Analyzed_Formal));
-      List      : constant List_Id    := New_List;
-      Ftyp      : Entity_Id;
-      Decl_Node : Node_Id;
-      Subt_Decl : Node_Id := Empty;
+      Acc_Def     : Node_Id             := Empty;
+      Act_Assoc   : constant Node_Id    := Parent (Actual);
+      Actual_Decl : Node_Id             := Empty;
+      Formal_Id   : constant Entity_Id  := Defining_Identifier (Formal);
+      Decl_Node   : Node_Id;
+      Def         : Node_Id;
+      Ftyp        : Entity_Id;
+      List        : constant List_Id    := New_List;
+      Loc         : constant Source_Ptr := Sloc (Actual);
+      Orig_Ftyp   : constant Entity_Id  :=
+                      Etype (Defining_Identifier (Analyzed_Formal));
+      Subt_Decl   : Node_Id             := Empty;
+      Subt_Mark   : Node_Id             := Empty;
 
    begin
+      if Present (Subtype_Mark (Formal)) then
+         Subt_Mark := Subtype_Mark (Formal);
+      else
+         Check_Access_Definition (Formal);
+         Acc_Def := Access_Definition (Formal);
+      end if;
+
       --  Sloc for error message on missing actual
 
       Error_Msg_Sloc := Sloc (Scope (Defining_Identifier (Analyzed_Formal)));
@@ -7377,11 +7833,20 @@ package body Sem_Ch12 is
             Abandon_Instantiation (Instantiation_Node);
          end if;
 
-         Decl_Node :=
-           Make_Object_Renaming_Declaration (Loc,
-             Defining_Identifier => New_Copy (Formal_Id),
-             Subtype_Mark        => New_Copy_Tree (Type_Id),
-             Name                => Actual);
+         if Present (Subt_Mark) then
+            Decl_Node :=
+              Make_Object_Renaming_Declaration (Loc,
+                Defining_Identifier => New_Copy (Formal_Id),
+                Subtype_Mark        => New_Copy_Tree (Subt_Mark),
+                Name                => Actual);
+
+         else pragma Assert (Present (Acc_Def));
+            Decl_Node :=
+              Make_Object_Renaming_Declaration (Loc,
+                Defining_Identifier => New_Copy (Formal_Id),
+                Access_Definition   => New_Copy_Tree (Acc_Def),
+                Name                => Actual);
+         end if;
 
          Set_Corresponding_Generic_Association (Decl_Node, Act_Assoc);
 
@@ -7447,9 +7912,22 @@ package body Sem_Ch12 is
               ("actual for& must be a variable", Actual, Formal_Id);
 
          elsif Base_Type (Ftyp) /= Base_Type (Etype (Actual)) then
-            Error_Msg_NE (
-              "type of actual does not match type of&", Actual, Formal_Id);
 
+            --  Ada 2005 (AI-423): For a generic formal object of mode in
+            --  out, the type of the actual shall resolve to a specific
+            --  anonymous access type.
+
+            if Ada_Version < Ada_05
+              or else
+                Ekind (Base_Type (Ftyp)) /=
+                  E_Anonymous_Access_Type
+              or else
+                Ekind (Base_Type (Etype (Actual))) /=
+                  E_Anonymous_Access_Type
+            then
+               Error_Msg_NE ("type of actual does not match type of&",
+                             Actual, Formal_Id);
+            end if;
          end if;
 
          Note_Possible_Modification (Actual);
@@ -7475,17 +7953,23 @@ package body Sem_Ch12 is
       --  OUT not present
 
       else
-         --  The instantiation of a generic formal in-parameter
-         --  is a constant declaration. The actual is the expression for
+         --  The instantiation of a generic formal in-parameter is a
+         --  constant declaration. The actual is the expression for
          --  that declaration.
 
          if Present (Actual) then
+            if Present (Subt_Mark) then
+               Def := Subt_Mark;
+            else pragma Assert (Present (Acc_Def));
+               Def := Acc_Def;
+            end if;
 
-            Decl_Node := Make_Object_Declaration (Loc,
-              Defining_Identifier => New_Copy (Formal_Id),
-              Constant_Present => True,
-              Object_Definition => New_Copy_Tree (Type_Id),
-              Expression => Actual);
+            Decl_Node :=
+              Make_Object_Declaration (Loc,
+                Defining_Identifier => New_Copy (Formal_Id),
+                Constant_Present    => True,
+                Object_Definition   => New_Copy_Tree (Def),
+                Expression          => Actual);
 
             Set_Corresponding_Generic_Association (Decl_Node, Act_Assoc);
 
@@ -7532,16 +8016,23 @@ package body Sem_Ch12 is
                end if;
             end;
 
-         elsif Present (Expression (Formal)) then
+         elsif Present (Default_Expression (Formal)) then
 
             --  Use default to construct declaration
 
+            if Present (Subt_Mark) then
+               Def := Subt_Mark;
+            else pragma Assert (Present (Acc_Def));
+               Def := Acc_Def;
+            end if;
+
             Decl_Node :=
               Make_Object_Declaration (Sloc (Formal),
                 Defining_Identifier => New_Copy (Formal_Id),
                 Constant_Present    => True,
-                Object_Definition   => New_Copy (Type_Id),
-                Expression          => New_Copy_Tree (Expression (Formal)));
+                Object_Definition   => New_Copy (Def),
+                Expression          => New_Copy_Tree (Default_Expression
+                                        (Formal)));
 
             Append (Decl_Node, List);
             Set_Analyzed (Expression (Decl_Node), False);
@@ -7560,15 +8051,21 @@ package body Sem_Ch12 is
                --  Create dummy constant declaration so that instance can
                --  be analyzed, to minimize cascaded visibility errors.
 
+               if Present (Subt_Mark) then
+                  Def := Subt_Mark;
+               else pragma Assert (Present (Acc_Def));
+                  Def := Acc_Def;
+               end if;
+
                Decl_Node :=
                  Make_Object_Declaration (Loc,
                    Defining_Identifier => New_Copy (Formal_Id),
                    Constant_Present    => True,
-                   Object_Definition   => New_Copy (Type_Id),
+                   Object_Definition   => New_Copy (Def),
                    Expression          =>
                       Make_Attribute_Reference (Sloc (Formal_Id),
                         Attribute_Name => Name_First,
-                        Prefix         => New_Copy (Type_Id)));
+                        Prefix         => New_Copy (Def)));
 
                Append (Decl_Node, List);
 
@@ -7576,7 +8073,33 @@ package body Sem_Ch12 is
                Abandon_Instantiation (Instantiation_Node);
             end if;
          end if;
+      end if;
+
+      if Nkind (Actual) in N_Has_Entity then
+         Actual_Decl := Parent (Entity (Actual));
+      end if;
 
+      --  Ada 2005 (AI-423): For a formal object declaration with a null
+      --  exclusion or an access definition that has a null exclusion: If
+      --  the actual matching the formal object declaration denotes a generic
+      --  formal object of another generic unit G, and the instantiation
+      --  containing the actual occurs within the body of G or within the
+      --  body of a generic unit declared within the declarative region of G,
+      --  then the declaration of the formal object of G shall have a null
+      --  exclusion. Otherwise, the subtype of the actual matching the formal
+      --  object declaration shall exclude null.
+
+      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)
+        and then Nkind (Analyzed_Formal) = N_Formal_Object_Declaration
+        and then Has_Null_Exclusion (Actual_Decl)
+        and then not Has_Null_Exclusion (Analyzed_Formal)
+      then
+         Error_Msg_N ("null-exclusion required in formal object declaration",
+                      Analyzed_Formal);
       end if;
 
       return List;
@@ -7897,6 +8420,14 @@ package body Sem_Ch12 is
          Set_Has_Completion (Anon_Id);
          Check_Generic_Actuals (Pack_Id, False);
 
+         --  Generate a reference to link the visible subprogram instance to
+         --  the the generic body, which for navigation purposes is the only
+         --  available source for the instance.
+
+         Generate_Reference
+           (Related_Instance (Pack_Id),
+             Gen_Body_Id, 'b', Set_Ref => False, Force => True);
+
          --  If it is a child unit, make the parent instance (which is an
          --  instance of the parent of the generic) visible. The parent
          --  instance is the prefix of the name of the generic unit.
@@ -8074,13 +8605,14 @@ package body Sem_Ch12 is
       Analyzed_Formal : Node_Id;
       Actual_Decls    : List_Id) return Node_Id
    is
-      Loc       : constant Source_Ptr := Sloc (Actual);
       Gen_T     : constant Entity_Id  := Defining_Identifier (Formal);
       A_Gen_T   : constant Entity_Id  := Defining_Identifier (Analyzed_Formal);
       Ancestor  : Entity_Id := Empty;
       Def       : constant Node_Id    := Formal_Type_Definition (Formal);
       Act_T     : Entity_Id;
       Decl_Node : Node_Id;
+      Loc       : Source_Ptr;
+      Subt      : Entity_Id;
 
       procedure Validate_Array_Type_Instance;
       procedure Validate_Access_Subprogram_Instance;
@@ -8470,6 +9002,33 @@ package body Sem_Ch12 is
             Abandon_Instantiation (Actual);
          end if;
 
+         --  Ada 2005 (AI-443): Synchronized formal derived type ckecks. Note
+         --  that the formal type declaration has been rewritten as a private
+         --  extension.
+
+         if Ada_Version >= Ada_05
+           and then Nkind (Parent (A_Gen_T)) = N_Private_Extension_Declaration
+           and then Synchronized_Present (Parent (A_Gen_T))
+         then
+            --  The actual must be a synchronized tagged type
+
+            if not Is_Tagged_Type (Act_T) then
+               Error_Msg_N
+                 ("actual of synchronized type must be tagged", Actual);
+               Abandon_Instantiation (Actual);
+
+            elsif Nkind (Parent (Act_T)) = N_Full_Type_Declaration
+              and then Nkind (Type_Definition (Parent (Act_T))) =
+                         N_Derived_Type_Definition
+              and then not Synchronized_Present (Type_Definition
+                             (Parent (Act_T)))
+            then
+               Error_Msg_N
+                 ("actual of synchronized type must be synchronized", Actual);
+               Abandon_Instantiation (Actual);
+            end if;
+         end if;
+
          --  Perform atomic/volatile checks (RM C.6(12))
 
          if Is_Atomic (Act_T) and then not Is_Atomic (Ancestor) then
@@ -8508,11 +9067,15 @@ package body Sem_Ch12 is
                   Abandon_Instantiation (Actual);
                end if;
 
-            --  Ancestor is unconstrained
+            --  Ancestor is unconstrained, Check if generic formal and
+            --  actual agree on constrainedness. The check only applies
+            --  to array types and discriminated types.
 
             elsif Is_Constrained (Act_T) then
                if Ekind (Ancestor) = E_Access_Type
-                 or else Is_Composite_Type (Ancestor)
+                 or else
+                   (not Is_Constrained (A_Gen_T)
+                     and then Is_Composite_Type (A_Gen_T))
                then
                   Error_Msg_N
                     ("actual subtype must be unconstrained", Actual);
@@ -8628,11 +9191,18 @@ package body Sem_Ch12 is
            and then not Is_Limited_Type (A_Gen_T)
          then
             Error_Msg_NE
-              ("actual for non-limited  & cannot be a limited type", Actual,
+              ("actual for non-limited & cannot be a limited type", Actual,
                Gen_T);
             Explain_Limited_Type (Act_T, Actual);
             Abandon_Instantiation (Actual);
 
+         elsif Known_To_Have_Preelab_Init (A_Gen_T)
+           and then not Has_Preelaborable_Initialization (Act_T)
+         then
+            Error_Msg_NE
+              ("actual for & must have preelaborable initialization", Actual,
+               Gen_T);
+
          elsif Is_Indefinite_Subtype (Act_T)
             and then not Is_Indefinite_Subtype (A_Gen_T)
             and then Ada_Version >= Ada_95
@@ -8764,8 +9334,14 @@ package body Sem_Ch12 is
 
          --  Deal with error of using incomplete type as generic actual
 
-         if Ekind (Act_T) = E_Incomplete_Type then
-            if No (Underlying_Type (Act_T)) then
+         if Ekind (Act_T) = E_Incomplete_Type
+           or else (Is_Class_Wide_Type (Act_T)
+                      and then
+                         Ekind (Root_Type (Act_T)) = E_Incomplete_Type)
+         then
+            if Is_Class_Wide_Type (Act_T)
+              or else No (Underlying_Type (Act_T))
+            then
                Error_Msg_N ("premature use of incomplete type", Actual);
                Abandon_Instantiation (Actual);
             else
@@ -8890,9 +9466,16 @@ package body Sem_Ch12 is
 
       end case;
 
+      Subt := New_Copy (Gen_T);
+
+      --  Use adjusted sloc of subtype name as the location for other
+      --  nodes in the subtype declaration.
+
+      Loc  := Sloc (Subt);
+
       Decl_Node :=
         Make_Subtype_Declaration (Loc,
-          Defining_Identifier => New_Copy (Gen_T),
+          Defining_Identifier => Subt,
           Subtype_Indication  => New_Reference_To (Act_T, Loc));
 
       if Is_Private_Type (Act_T) then
@@ -8918,6 +9501,20 @@ package body Sem_Ch12 is
       return Decl_Node;
    end Instantiate_Type;
 
+   -----------------------
+   -- Is_Generic_Formal --
+   -----------------------
+
+   function Is_Generic_Formal (E : Entity_Id) return Boolean is
+      Kind : constant Node_Kind := Nkind (Parent (E));
+   begin
+      return
+        Kind = N_Formal_Object_Declaration
+          or else Kind = N_Formal_Package_Declaration
+          or else Kind in N_Formal_Subprogram_Declaration
+          or else Kind = N_Formal_Type_Declaration;
+   end Is_Generic_Formal;
+
    ---------------------
    -- Is_In_Main_Unit --
    ---------------------
@@ -9248,51 +9845,52 @@ package body Sem_Ch12 is
 
    begin
       Assoc := First (Generic_Associations (N));
-
       while Present (Assoc) loop
-         Act := Explicit_Generic_Actual_Parameter (Assoc);
+         if Nkind (Assoc) /= N_Others_Choice then
+            Act := Explicit_Generic_Actual_Parameter (Assoc);
 
-         --  Within a nested instantiation, a defaulted actual is an
-         --  empty association, so nothing to analyze. If the actual for
-         --  a subprogram is an attribute, analyze prefix only, because
-         --  actual is not a complete attribute reference.
-
-         --  If actual is an allocator, analyze expression only. The full
-         --  analysis can generate code, and if the instance is a compilation
-         --  unit we have to wait until the package instance is installed to
-         --  have a proper place to insert this code.
+            --  Within a nested instantiation, a defaulted actual is an empty
+            --  association, so nothing to analyze. If the subprogram actual
+            --  isan attribute, analyze prefix only, because actual is not a
+            --  complete attribute reference.
+
+            --  If actual is an allocator, analyze expression only. The full
+            --  analysis can generate code, and if instance is a compilation
+            --  unit we have to wait until the package instance is installed
+            --  to have a proper place to insert this code.
 
-         --  String literals may be operators, but at this point we do not
-         --  know whether the actual is a formal subprogram or a string.
+            --  String literals may be operators, but at this point we do not
+            --  know whether the actual is a formal subprogram or a string.
 
-         if No (Act) then
-            null;
+            if No (Act) then
+               null;
 
-         elsif Nkind (Act) = N_Attribute_Reference then
-            Analyze (Prefix (Act));
+            elsif Nkind (Act) = N_Attribute_Reference then
+               Analyze (Prefix (Act));
 
-         elsif Nkind (Act) = N_Explicit_Dereference then
-            Analyze (Prefix (Act));
+            elsif Nkind (Act) = N_Explicit_Dereference then
+               Analyze (Prefix (Act));
 
-         elsif Nkind (Act) = N_Allocator then
-            declare
-               Expr : constant Node_Id := Expression (Act);
+            elsif Nkind (Act) = N_Allocator then
+               declare
+                  Expr : constant Node_Id := Expression (Act);
 
-            begin
-               if Nkind (Expr) = N_Subtype_Indication then
-                  Analyze (Subtype_Mark (Expr));
-                  Analyze_List (Constraints (Constraint (Expr)));
-               else
-                  Analyze (Expr);
-               end if;
-            end;
+               begin
+                  if Nkind (Expr) = N_Subtype_Indication then
+                     Analyze (Subtype_Mark (Expr));
+                     Analyze_List (Constraints (Constraint (Expr)));
+                  else
+                     Analyze (Expr);
+                  end if;
+               end;
 
-         elsif Nkind (Act) /= N_Operator_Symbol then
-            Analyze (Act);
-         end if;
+            elsif Nkind (Act) /= N_Operator_Symbol then
+               Analyze (Act);
+            end if;
 
-         if Errs /= Serious_Errors_Detected then
-            Abandon_Instantiation (Act);
+            if Errs /= Serious_Errors_Detected then
+               Abandon_Instantiation (Act);
+            end if;
          end if;
 
          Next (Assoc);
@@ -9428,17 +10026,16 @@ package body Sem_Ch12 is
 
       procedure Restore_Nested_Formal (Formal : Entity_Id) is
          Ent : Entity_Id;
+
       begin
          if Present (Renamed_Object (Formal))
            and then Denotes_Formal_Package (Renamed_Object (Formal), True)
          then
             return;
 
-         elsif Present (Associated_Formal_Package (Formal))
-          and then Box_Present (Parent (Associated_Formal_Package (Formal)))
-         then
-            Ent := First_Entity (Formal);
+         elsif Present (Associated_Formal_Package (Formal)) then
 
+            Ent := First_Entity (Formal);
             while Present (Ent) loop
                exit when Ekind (Ent) = E_Package
                  and then Renamed_Entity (Ent) = Renamed_Entity (Formal);
@@ -9457,6 +10054,8 @@ package body Sem_Ch12 is
          end if;
       end Restore_Nested_Formal;
 
+   --  Start of processing for Restore_Private_Views
+
    begin
       M := First_Elmt (Exchanged_Views);
       while Present (M) loop
@@ -9473,7 +10072,6 @@ package body Sem_Ch12 is
            or else Ekind (Typ) = E_Record_Type_With_Private
          then
             Dep_Elmt := First_Elmt (Private_Dependents (Typ));
-
             while Present (Dep_Elmt) loop
                Dep_Typ := Node (Dep_Elmt);
 
@@ -9500,7 +10098,6 @@ package body Sem_Ch12 is
       --  types into subtypes of the actuals again.
 
       E := First_Entity (Pack_Id);
-
       while Present (E) loop
          Set_Is_Hidden (E, True);
 
@@ -10152,19 +10749,39 @@ package body Sem_Ch12 is
                  or else Nkind (N2) = N_Real_Literal
                  or else Nkind (N2) = N_String_Literal
                then
-                  --  Operation was constant-folded, perform the same
-                  --  replacement in generic.
+                  if Present (Original_Node (N2))
+                    and then Nkind (Original_Node (N2)) = Nkind (N)
+                  then
 
-                  Rewrite (N, New_Copy (N2));
-                  Set_Analyzed (N, False);
+                     --  Operation was constant-folded. Whenever possible,
+                     --  recover semantic information from unfolded node,
+                     --  for ASIS use.
+
+                     Set_Associated_Node (N, Original_Node (N2));
+
+                     if Nkind (N) = N_Op_Concat then
+                        Set_Is_Component_Left_Opnd (N,
+                          Is_Component_Left_Opnd  (Get_Associated_Node (N)));
+                        Set_Is_Component_Right_Opnd (N,
+                          Is_Component_Right_Opnd (Get_Associated_Node (N)));
+                     end if;
+
+                     Reset_Entity (N);
+
+                  else
+                     --  If original node is already modified, propagate
+                     --  constant-folding to template.
+
+                     Rewrite (N, New_Copy (N2));
+                     Set_Analyzed (N, False);
+                  end if;
 
                elsif Nkind (N2) = N_Identifier
                  and then Ekind (Entity (N2)) = E_Enumeration_Literal
                then
-                  --  Same if call was folded into a literal, but in this
-                  --  case retain the entity to avoid spurious ambiguities
-                  --  if id is overloaded at the point of instantiation or
-                  --  inlining.
+                  --  Same if call was folded into a literal, but in this case
+                  --  retain the entity to avoid spurious ambiguities if id is
+                  --  overloaded at the point of instantiation or inlining.
 
                   Rewrite (N, New_Copy (N2));
                   Set_Analyzed (N, False);
@@ -10181,9 +10798,9 @@ package body Sem_Ch12 is
          elsif Nkind (N) = N_Identifier then
             if Nkind (N) = Nkind (Get_Associated_Node (N)) then
 
-               --  If this is a discriminant reference, always save it.
-               --  It is used in the instance to find the corresponding
-               --  discriminant positionally rather than  by name.
+               --  If this is a discriminant reference, always save it. It is
+               --  used in the instance to find the corresponding discriminant
+               --  positionally rather than by name.
 
                Set_Original_Discriminant
                  (N, Original_Discriminant (Get_Associated_Node (N)));
@@ -10195,8 +10812,8 @@ package body Sem_Ch12 is
                if Nkind (N2) = N_Function_Call then
                   E := Entity (Name (N2));
 
-                  --  Name resolves to a call to parameterless function.
-                  --  If original entity is global, mark node as resolved.
+                  --  Name resolves to a call to parameterless function. If
+                  --  original entity is global, mark node as resolved.
 
                   if Present (E)
                     and then Is_Global (E)
@@ -10208,16 +10825,25 @@ package body Sem_Ch12 is
                   end if;
 
                elsif
-                 Nkind (N2) = N_Integer_Literal or else
-                 Nkind (N2) = N_Real_Literal    or else
-                 Nkind (N2) = N_String_Literal
+                 (Nkind (N2) = N_Integer_Literal
+                    or else
+                  Nkind (N2) = N_Real_Literal)
+                 and then Is_Entity_Name (Original_Node (N2))
                then
                   --  Name resolves to named number that is constant-folded,
-                  --  or to string literal from concatenation.
-                  --  Perform the same replacement in generic.
+                  --  We must preserve the original name for ASIS use, and
+                  --  undo the constant-folding, which will be repeated in
+                  --  each instance.
+
+                  Set_Associated_Node (N, Original_Node (N2));
+                  Reset_Entity (N);
+
+               elsif Nkind (N2) = N_String_Literal then
+
+                  --  Name resolves to string literal. Perform the same
+                  --  replacement in generic.
 
                   Rewrite (N, New_Copy (N2));
-                  Set_Analyzed (N, False);
 
                elsif Nkind (N2) = N_Explicit_Dereference then
 
@@ -10474,9 +11100,14 @@ package body Sem_Ch12 is
 
    begin
       --  T may be private but its base type may have been exchanged through
-      --  some other occurrence, in which case there is nothing to switch.
+      --  some other occurrence, in which case there is nothing to switch
+      --  besides T itself. Note that a private dependent subtype of a private
+      --  type might not have been switched even if the base type has been,
+      --  because of the last branch of Check_Private_View (see comment there).
 
       if not Is_Private_Type (BT) then
+         Prepend_Elmt (Full_View (T), Exchanged_Views);
+         Exchange_Declarations (T);
          return;
       end if;
 


More information about the Gcc-patches mailing list