sem_ch12.adb (Analyze_Associations): Diagnose use of an others association in an instance.

2007-04-20  Ed Schonberg  <schonberg@adacore.com>
	    Javier Miranda  <miranda@adacore.com>

	* sem_ch12.adb (Analyze_Associations): Diagnose use of an others
	association in an instance.
	(Copy_Generic_Node): If the node is a string literal, no need to copy
	its descendants.
	(Is_Generic_Formal): For a formal subprogram, the declaration is the
	grandparent of the entity.
	(Analyze_Formal_Interface_Type): Transform into a full type declaration,
	to simplify handling of formal interfaces that derive from other formal
	interfaces.
	(Instantiate_Subprogram_Body): The defining unit name of the body of
	the instance should be a defining identifier.
	(Install_Formal_Packages): make global to the package, for use in
	instantiations of child units.
	(Analyze_Package_Instantiation): Do not attempt to set information on an
	enclosing master of an entry when expansion is disabled.
	(Instantiate_Type): If the actual is a tagged synchronized type and the
	generic ancestor is an interface, create a generic actual for the
	corresponding record.
	(Analyze_Formal_Derived_Interface_Type): Rewrite as a derived type
	declaration, to ensure that the interface list is processed correctly.
	(Inline_Instance_Body): If enclosing scope is an instance body, remove
	its entities from visibiility as well.
	(Pre_Analyze_Actuals): if the actual is an allocator with  constraints
	given with a named association, analyze the expression only, not the
	discriminant association itself.
	(Reset_Entity): If the analysis of a selected component is transformed
	into an expanded name in the prefix of a call with parameters, do not
	transform the original node into an expanded name, to prevent visibility
	errors in the case of nested generics.
	(Check_Private_View): For an array type, check whether the index types
	may need exchanging.

From-SVN: r125431

1 files changed, 433 insertions, 188 deletions

diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index b9ceccd8..d3eb0f8 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2006, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2007, 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- --
@@ -305,7 +305,8 @@ package body Sem_Ch12 is
    --  The following procedures treat other kinds of formal parameters
 
    procedure Analyze_Formal_Derived_Interface_Type
-     (T   : Entity_Id;
+     (N   : Node_Id;
+      T   : Entity_Id;
       Def : Node_Id);
 
    procedure Analyze_Formal_Derived_Type
@@ -313,6 +314,11 @@ package body Sem_Ch12 is
       T   : Entity_Id;
       Def : Node_Id);
 
+   procedure Analyze_Formal_Interface_Type
+     (N   : Node_Id;
+      T   : Entity_Id;
+      Def : Node_Id);
+
    --  The following subprograms create abbreviated declarations for formal
    --  scalar types. We introduce an anonymous base of the proper class for
    --  each of them, and define the formals as constrained first subtypes of
@@ -323,7 +329,6 @@ package body Sem_Ch12 is
                                                 (T : Entity_Id; Def : Node_Id);
    procedure Analyze_Formal_Discrete_Type       (T : Entity_Id; Def : Node_Id);
    procedure Analyze_Formal_Floating_Type       (T : Entity_Id; Def : Node_Id);
-   procedure Analyze_Formal_Interface_Type      (T : Entity_Id; Def : Node_Id);
    procedure Analyze_Formal_Signed_Integer_Type (T : Entity_Id; Def : Node_Id);
    procedure Analyze_Formal_Modular_Type        (T : Entity_Id; Def : Node_Id);
    procedure Analyze_Formal_Ordinary_Fixed_Point_Type
@@ -527,6 +532,14 @@ package body Sem_Ch12 is
    --  Save_Env because data-structures for visibility handling must be
    --  initialized before call to Check_Generic_Child_Unit.
 
+   procedure Install_Formal_Packages (Par : Entity_Id);
+   --  If any of the formals of the parent are formal packages with box,
+   --  their formal parts are visible in the parent and thus in the child
+   --  unit as well. Analogous to what is done in Check_Generic_Actuals
+   --  for the unit itself. This procedure is also used in an instance, to
+   --  make visible the proper entities of the actual for a formal package
+   --  declared with a box.
+
    procedure Install_Parent (P : Entity_Id; In_Body : Boolean := False);
    --  When compiling an instance of a child unit the parent (which is
    --  itself an instance) is an enclosing scope that must be made
@@ -561,7 +574,7 @@ package body Sem_Ch12 is
      (Formal          : Node_Id;
       Actual          : Node_Id;
       Analyzed_Formal : Node_Id;
-      Actual_Decls    : List_Id) return Node_Id;
+      Actual_Decls    : List_Id) return List_Id;
 
    function Instantiate_Formal_Subprogram
      (Formal          : Node_Id;
@@ -927,7 +940,9 @@ package body Sem_Ch12 is
 
          --  End of list of purely positional parameters
 
-         if No (Actual) then
+         if No (Actual)
+           or else Nkind (Actual) = N_Others_Choice
+         then
             Found_Assoc := Empty;
             Act         := Empty;
 
@@ -1000,26 +1015,36 @@ package body Sem_Ch12 is
 
       procedure Process_Default (F : Entity_Id)  is
          Loc     : constant Source_Ptr := Sloc (I_Node);
+         Decl    : Node_Id;
          Default : Node_Id;
          Id      : Entity_Id;
 
       begin
-         --  Append copy of formal declaration to associations.
+         --  Append copy of formal declaration to associations, and create
+         --  new defining identifier for it.
 
-         Append (New_Copy_Tree (F), Assoc);
+         Decl := New_Copy_Tree (F);
 
-         if No (Found_Assoc) then
-            if Nkind (F) = N_Formal_Concrete_Subprogram_Declaration then
-               Id := Defining_Entity (F);
-            else
-               Id := Defining_Identifier (F);
-            end if;
+         if Nkind (F) = N_Formal_Concrete_Subprogram_Declaration then
+            Id :=
+               Make_Defining_Identifier (Sloc (Defining_Entity (F)),
+                 Chars => Chars (Defining_Entity (F)));
+            Set_Defining_Unit_Name (Specification (Decl), Id);
 
+         else
+            Id :=
+              Make_Defining_Identifier (Sloc (Defining_Entity (F)),
+                Chars => Chars (Defining_Identifier (F)));
+            Set_Defining_Identifier (Decl, Id);
+         end if;
+
+         Append (Decl, Assoc);
+
+         if No (Found_Assoc) then
             Default :=
                Make_Generic_Association (Loc,
-               Selector_Name                     =>
-                 New_Occurrence_Of (Id, Loc),
-               Explicit_Generic_Actual_Parameter => Empty);
+                 Selector_Name => New_Occurrence_Of (Id, Loc),
+                 Explicit_Generic_Actual_Parameter => Empty);
             Set_Box_Present (Default);
             Append (Default, Default_Formals);
          end if;
@@ -1092,8 +1117,28 @@ package body Sem_Ch12 is
                   Error_Msg_N ("others must be last association", Actual);
                end if;
 
-               Remove (Actual);
+               --  This subprogram is used both for formal packages and for
+               --  instantiations. For the latter, associations must all be
+               --  explicit.
+
+               if Nkind (I_Node) /= N_Formal_Package_Declaration
+                 and then Comes_From_Source (I_Node)
+               then
+                  Error_Msg_N
+                    ("others association not allowed in an instance",
+                      Actual);
+               end if;
+
+               --  In any case, nothing to do after the others association
+
                exit;
+
+            elsif Box_Present (Actual)
+              and then Comes_From_Source (I_Node)
+              and then Nkind (I_Node) /= N_Formal_Package_Declaration
+            then
+               Error_Msg_N
+                 ("box association not allowed in an instance", Actual);
             end if;
 
             Next (Actual);
@@ -1104,6 +1149,7 @@ package body Sem_Ch12 is
 
          First_Named := First (Actuals);
          while Present (First_Named)
+           and then Nkind (First_Named) /= N_Others_Choice
            and then No (Selector_Name (First_Named))
          loop
             Num_Actuals := Num_Actuals + 1;
@@ -1113,7 +1159,9 @@ package body Sem_Ch12 is
 
       Named := First_Named;
       while Present (Named) loop
-         if No (Selector_Name (Named)) then
+         if Nkind (Named) /= N_Others_Choice
+           and then  No (Selector_Name (Named))
+         then
             Error_Msg_N ("invalid positional actual after named one", Named);
             Abandon_Instantiation (Named);
          end if;
@@ -1122,7 +1170,9 @@ package body Sem_Ch12 is
          --  introduced for a default subprogram that turns out to be local
          --  to the outer instantiation.
 
-         if Present (Explicit_Generic_Actual_Parameter (Named)) then
+         if Nkind (Named) /= N_Others_Choice
+           and then  Present (Explicit_Generic_Actual_Parameter (Named))
+         then
             Num_Actuals := Num_Actuals + 1;
          end if;
 
@@ -1184,9 +1234,10 @@ package body Sem_Ch12 is
 
                   else
                      Analyze (Match);
-                     Append_To (Assoc,
-                       Instantiate_Type
-                         (Formal, Match, Analyzed_Formal, Assoc));
+                     Append_List
+                       (Instantiate_Type
+                         (Formal, Match, Analyzed_Formal, Assoc),
+                       Assoc);
 
                      --  An instantiation is a freeze point for the actuals,
                      --  unless this is a rewritten formal package.
@@ -1509,29 +1560,25 @@ package body Sem_Ch12 is
    -------------------------------------------
 
    procedure Analyze_Formal_Derived_Interface_Type
-     (T   : Entity_Id;
+     (N   : Node_Id;
+      T   : Entity_Id;
       Def : Node_Id)
    is
-      Ifaces_List : Elist_Id;
+      Loc   : constant Source_Ptr := Sloc (Def);
+      New_N : Node_Id;
 
    begin
-      Enter_Name (T);
-      Set_Ekind  (T, E_Record_Type);
-      Set_Etype  (T, T);
-      Analyze (Subtype_Indication (Def));
-      Analyze_Interface_Declaration (T, Def);
-      Make_Class_Wide_Type (T);
-      Analyze_List (Interface_List (Def));
-
-      --  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);
+      --  Rewrite as a type declaration of a derived type. This ensures that
+      --  the interface list and primitive operations are properly captured.
+
+      New_N :=
+        Make_Full_Type_Declaration (Loc,
+          Defining_Identifier => T,
+           Type_Definition => Def);
+
+      Rewrite (N, New_N);
+      Analyze (N);
+      Set_Is_Generic_Type (T);
    end Analyze_Formal_Derived_Interface_Type;
 
    ---------------------------------
@@ -1695,14 +1742,23 @@ package body Sem_Ch12 is
    -- Analyze_Formal_Interface_Type;--
    -----------------------------------
 
-   procedure Analyze_Formal_Interface_Type (T : Entity_Id; Def : Node_Id) is
+   procedure Analyze_Formal_Interface_Type
+      (N   : Node_Id;
+       T   : Entity_Id;
+       Def : Node_Id)
+   is
+      Loc   : constant Source_Ptr := Sloc (N);
+      New_N : Node_Id;
+
    begin
-      Enter_Name (T);
-      Set_Ekind  (T, E_Record_Type);
-      Set_Etype  (T, T);
-      Analyze_Interface_Declaration (T, Def);
-      Make_Class_Wide_Type (T);
-      Set_Primitive_Operations (T, New_Elmt_List);
+      New_N :=
+        Make_Full_Type_Declaration (Loc,
+          Defining_Identifier => T,
+          Type_Definition => Def);
+
+      Rewrite (N, New_N);
+      Analyze (N);
+      Set_Is_Generic_Type (T);
    end Analyze_Formal_Interface_Type;
 
    ---------------------------------
@@ -2090,7 +2146,7 @@ package body Sem_Ch12 is
       Set_Ekind  (Formal, E_Package);
       Set_Etype  (Formal, Standard_Void_Type);
       Set_Inner_Instances (Formal, New_Elmt_List);
-      New_Scope  (Formal);
+      Push_Scope  (Formal);
 
       if Is_Child_Unit (Gen_Unit)
         and then Parent_Installed
@@ -2449,10 +2505,10 @@ package body Sem_Ch12 is
          --  record declaration or a abstract type derivation.
 
          when N_Record_Definition                      =>
-            Analyze_Formal_Interface_Type (T, Def);
+            Analyze_Formal_Interface_Type (N, T, Def);
 
          when N_Derived_Type_Definition                =>
-            Analyze_Formal_Derived_Interface_Type (T, Def);
+            Analyze_Formal_Derived_Interface_Type (N, T, Def);
 
          when N_Error                                  =>
             null;
@@ -2589,7 +2645,7 @@ package body Sem_Ch12 is
       Enter_Name (Id);
       Set_Ekind (Id, E_Generic_Package);
       Set_Etype (Id, Standard_Void_Type);
-      New_Scope (Id);
+      Push_Scope (Id);
       Enter_Generic_Scope (Id);
       Set_Inner_Instances (Id, New_Elmt_List);
 
@@ -2679,7 +2735,7 @@ package body Sem_Ch12 is
       Enter_Name (Id);
 
       Set_Scope_Depth_Value (Id, Scope_Depth (Current_Scope) + 1);
-      New_Scope (Id);
+      Push_Scope (Id);
       Enter_Generic_Scope (Id);
       Set_Inner_Instances (Id, New_Elmt_List);
       Set_Is_Pure (Id, Is_Pure (Current_Scope));
@@ -3163,11 +3219,13 @@ package body Sem_Ch12 is
             Check_Forward_Instantiation (Gen_Decl);
             if Nkind (N) = N_Package_Instantiation then
                declare
-                  Enclosing_Master : Entity_Id := Current_Scope;
+                  Enclosing_Master : Entity_Id;
 
                begin
-                  while Enclosing_Master /= Standard_Standard loop
+                  --  Loop to search enclosing masters
 
+                  Enclosing_Master := Current_Scope;
+                  Scope_Loop : while Enclosing_Master /= Standard_Standard loop
                      if Ekind (Enclosing_Master) = E_Package then
                         if Is_Compilation_Unit (Enclosing_Master) then
                            if In_Package_Body (Enclosing_Master) then
@@ -3178,7 +3236,7 @@ package body Sem_Ch12 is
                                 (Enclosing_Master);
                            end if;
 
-                           exit;
+                           exit Scope_Loop;
 
                         else
                            Enclosing_Master := Scope (Enclosing_Master);
@@ -3194,15 +3252,19 @@ package body Sem_Ch12 is
                         --  the enclosing instance, if any. enclosing scope
                         --  is void in the formal part of a generic subp.
 
-                        exit;
+                        exit Scope_Loop;
 
                      else
                         if Ekind (Enclosing_Master) = E_Entry
                           and then
                             Ekind (Scope (Enclosing_Master)) = E_Protected_Type
                         then
-                           Enclosing_Master :=
-                             Protected_Body_Subprogram (Enclosing_Master);
+                           if not Expander_Active then
+                              exit Scope_Loop;
+                           else
+                              Enclosing_Master :=
+                                Protected_Body_Subprogram (Enclosing_Master);
+                           end if;
                         end if;
 
                         Set_Delay_Cleanups (Enclosing_Master);
@@ -3227,9 +3289,9 @@ package body Sem_Ch12 is
                            end;
                         end if;
 
-                        exit;
+                        exit Scope_Loop;
                      end if;
-                  end loop;
+                  end loop Scope_Loop;
                end;
 
                --  Make entry in table
@@ -3458,17 +3520,35 @@ package body Sem_Ch12 is
          --  removed previously.
 
          --  If current scope is the body of a child unit, remove context of
-         --  spec as well.
+         --  spec as well. If an enclosing scope is an instance body. the
+         --  context has already been removed, but the entities in the body
+         --  must be made invisible as well.
 
          S := Current_Scope;
 
          while Present (S)
            and then S /= Standard_Standard
          loop
-            exit when Is_Generic_Instance (S)
-                 and then (In_Package_Body (S)
-                            or else Ekind (S) = E_Procedure
-                            or else Ekind (S) = E_Function);
+            if Is_Generic_Instance (S)
+              and then (In_Package_Body (S)
+                          or else Ekind (S) = E_Procedure
+                            or else Ekind (S) = E_Function)
+            then
+               --  We still have to remove the entities of the enclosing
+               --  instance from direct visibility.
+
+               declare
+                  E : Entity_Id;
+               begin
+                  E := First_Entity (S);
+                  while Present (E) loop
+                     Set_Is_Immediately_Visible (E, False);
+                     Next_Entity (E);
+                  end loop;
+               end;
+
+               exit;
+            end if;
 
             if S = Curr_Unit
               or else (Ekind (Curr_Unit) = E_Package_Body
@@ -3514,7 +3594,7 @@ package body Sem_Ch12 is
          end loop;
          pragma Assert (Num_Inner < Num_Scopes);
 
-         New_Scope (Standard_Standard);
+         Push_Scope (Standard_Standard);
          Scope_Stack.Table (Scope_Stack.Last).Is_Active_Stack_Base := True;
          Instantiate_Package_Body
            ((N, Act_Decl, Expander_Active, Current_Sem_Unit), True);
@@ -3538,13 +3618,13 @@ package body Sem_Ch12 is
             if Present (Curr_Scope)
               and then Is_Child_Unit (Curr_Scope)
             then
-               New_Scope (Curr_Scope);
+               Push_Scope (Curr_Scope);
                Set_Is_Immediately_Visible (Curr_Scope);
 
                --  Finally, restore inner scopes as well
 
                for J in reverse 1 .. Num_Inner loop
-                  New_Scope (Inner_Scopes (J));
+                  Push_Scope (Inner_Scopes (J));
                end loop;
             end if;
 
@@ -3595,9 +3675,30 @@ package body Sem_Ch12 is
             end  loop;
          end if;
 
-         for J in 1 .. N_Instances loop
-            Set_Is_Generic_Instance (Instances (J), True);
-         end loop;
+         --  Restore status of instances. If one of them is a body, make
+         --  its local entities visible again.
+
+         declare
+            E    : Entity_Id;
+            Inst : Entity_Id;
+
+         begin
+            for J in 1 .. N_Instances loop
+               Inst := Instances (J);
+               Set_Is_Generic_Instance (Inst, True);
+
+               if In_Package_Body (Inst)
+                 or else Ekind (S) = E_Procedure
+                 or else Ekind (S) = E_Function
+               then
+                  E := First_Entity (Instances (J));
+                  while Present (E) loop
+                     Set_Is_Immediately_Visible (E);
+                     Next_Entity (E);
+                  end loop;
+               end if;
+            end loop;
+         end;
 
       --  If generic unit is in current unit, current context is correct
 
@@ -4970,6 +5071,17 @@ package body Sem_Ch12 is
                then
                   Install_Parent (Inst_Par);
                   Parent_Installed := True;
+
+               elsif In_Open_Scopes (Inst_Par) then
+
+                  --  If the parent is already installed verify that the
+                  --  actuals for its formal packages declared with a box
+                  --  are already installed. This is necessary when the
+                  --  child instance is a child of the parent instance.
+                  --  In this case the parent is placed on the scope stack
+                  --  but the formal packages are not made visible.
+
+                  Install_Formal_Packages (Inst_Par);
                end if;
 
             else
@@ -5156,12 +5268,39 @@ package body Sem_Ch12 is
          then
             Switch_View (Designated_Type (T));
 
-         elsif Is_Array_Type (T)
-           and then Is_Private_Type (Component_Type (T))
-           and then not Has_Private_View (N)
-           and then Present (Full_View (Component_Type (T)))
-         then
-            Switch_View (Component_Type (T));
+         elsif Is_Array_Type (T) then
+            if Is_Private_Type (Component_Type (T))
+              and then not Has_Private_View (N)
+              and then Present (Full_View (Component_Type (T)))
+            then
+               Switch_View (Component_Type (T));
+            end if;
+
+            --  The normal exchange mechanism relies on the setting of a
+            --  flag on the reference in the generic. However, an additional
+            --  mechanism is needed for types that are not explicitly mentioned
+            --  in the generic, but may be needed in expanded code in the
+            --  instance. This includes component types of arrays and
+            --  designated types of access types. This processing must also
+            --  include the index types of arrays which we take care of here.
+
+            declare
+               Indx : Node_Id;
+               Typ  : Entity_Id;
+
+            begin
+               Indx := First_Index (T);
+               Typ  := Base_Type (Etype (Indx));
+               while Present (Indx) loop
+                  if Is_Private_Type (Typ)
+                    and then Present (Full_View (Typ))
+                  then
+                     Switch_View (Typ);
+                  end if;
+
+                  Next_Index (Indx);
+               end loop;
+            end;
 
          elsif Is_Private_Type (T)
            and then Present (Full_View (T))
@@ -5171,10 +5310,9 @@ package body Sem_Ch12 is
             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.
+         --  must be exchanged for consistency. This can happen when a package
+         --  body is instantiated, 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
@@ -5852,6 +5990,7 @@ package body Sem_Ch12 is
 
       elsif Nkind (N) = N_Integer_Literal
         or else Nkind (N) = N_Real_Literal
+        or else Nkind (N) = N_String_Literal
       then
          --  No descendant fields need traversing
 
@@ -6780,6 +6919,42 @@ package body Sem_Ch12 is
       Mark_Rewrite_Insertion (Act_Body);
    end Install_Body;
 
+   -----------------------------
+   -- Install_Formal_Packages --
+   -----------------------------
+
+   procedure Install_Formal_Packages (Par : Entity_Id) is
+      E : Entity_Id;
+
+   begin
+      E := First_Entity (Par);
+      while Present (E) loop
+         if Ekind (E) = E_Package
+           and then Nkind (Parent (E)) = N_Package_Renaming_Declaration
+         then
+            --  If this is the renaming for the parent instance, done
+
+            if Renamed_Object (E) = Par then
+               exit;
+
+            --  The visibility of a formal of an enclosing generic is
+            --  already correct.
+
+            elsif Denotes_Formal_Package (E) then
+               null;
+
+            elsif Present (Associated_Formal_Package (E))
+              and then Box_Present (Parent (Associated_Formal_Package (E)))
+            then
+               Check_Generic_Actuals (Renamed_Object (E), True);
+               Set_Is_Hidden (E, False);
+            end if;
+         end if;
+
+         Next_Entity (E);
+      end loop;
+   end Install_Formal_Packages;
+
    --------------------
    -- Install_Parent --
    --------------------
@@ -6794,12 +6969,6 @@ package body Sem_Ch12 is
       First_Gen : Entity_Id;
       Elmt      : Elmt_Id;
 
-      procedure Install_Formal_Packages (Par : Entity_Id);
-      --  If any of the formals of the parent are formal packages with box,
-      --  their formal parts are visible in the parent and thus in the child
-      --  unit as well. Analogous to what is done in Check_Generic_Actuals
-      --  for the unit itself.
-
       procedure Install_Noninstance_Specs (Par : Entity_Id);
       --  Install the scopes of noninstance parent units ending with Par
 
@@ -6807,42 +6976,6 @@ package body Sem_Ch12 is
       --  The child unit is within the declarative part of the parent, so
       --  the declarations within the parent are immediately visible.
 
-      -----------------------------
-      -- Install_Formal_Packages --
-      -----------------------------
-
-      procedure Install_Formal_Packages (Par : Entity_Id) is
-         E : Entity_Id;
-
-      begin
-         E := First_Entity (Par);
-         while Present (E) loop
-            if Ekind (E) = E_Package
-              and then Nkind (Parent (E)) = N_Package_Renaming_Declaration
-            then
-               --  If this is the renaming for the parent instance, done
-
-               if Renamed_Object (E) = Par then
-                  exit;
-
-               --  The visibility of a formal of an enclosing generic is
-               --  already correct.
-
-               elsif Denotes_Formal_Package (E) then
-                  null;
-
-               elsif Present (Associated_Formal_Package (E))
-                 and then Box_Present (Parent (Associated_Formal_Package (E)))
-               then
-                  Check_Generic_Actuals (Renamed_Object (E), True);
-                  Set_Is_Hidden (E, False);
-               end if;
-            end if;
-
-            Next_Entity (E);
-         end loop;
-      end Install_Formal_Packages;
-
       -------------------------------
       -- Install_Noninstance_Specs --
       -------------------------------
@@ -6895,7 +7028,7 @@ package body Sem_Ch12 is
          --  parents then it should be possible to remove this
          --  special check. ???
 
-         New_Scope (Par);
+         Push_Scope (Par);
          Set_Is_Immediately_Visible   (Par);
          Install_Visible_Declarations (Par);
          Set_Use (Visible_Declarations (Spec));
@@ -6993,7 +7126,7 @@ package body Sem_Ch12 is
       end if;
 
       if not In_Body then
-         New_Scope (S);
+         Push_Scope (S);
       end if;
    end Install_Parent;
 
@@ -7422,13 +7555,15 @@ package body Sem_Ch12 is
          --  renamings of the actuals supplied.
 
          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;
+            Gen_Decl : constant Node_Id :=
+                         Unit_Declaration_Node (Gen_Parent);
+            Formals  : constant List_Id :=
+                         Generic_Formal_Declarations (Gen_Decl);
+
+            Actual_Ent       : Entity_Id;
+            Actual_Of_Formal : Node_Id;
+            Formal_Node      : Node_Id;
+            Formal_Ent       : Entity_Id;
 
          begin
             if Present (Formals) then
@@ -7438,6 +7573,8 @@ package body Sem_Ch12 is
             end if;
 
             Actual_Ent := First_Entity (Actual_Pack);
+            Actual_Of_Formal :=
+               First (Visible_Declarations (Specification (Analyzed_Formal)));
             while Present (Actual_Ent)
               and then Actual_Ent /= First_Private_Entity (Actual_Pack)
             loop
@@ -7449,22 +7586,19 @@ package body Sem_Ch12 is
                      Match_Formal_Entity
                        (Formal_Node, Formal_Ent, Actual_Ent);
 
+                     --  We iterate at the same time over the actuals of the
+                     --  local package created for the formal, to determine
+                     --  which one of the formals of the original generic were
+                     --  defaulted in the formal. The corresponding actual
+                     --  entities are visible in the enclosing instance.
+
                      if Box_Present (Formal)
                        or else
-                         (Present (Formal_Node)
-                           and then Is_Generic_Formal (Formal_Ent))
+                         (Present (Actual_Of_Formal)
+                           and then
+                             Is_Generic_Formal
+                               (Get_Formal_Entity (Actual_Of_Formal)))
                      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
@@ -7473,10 +7607,15 @@ package body Sem_Ch12 is
                         if Ekind (Actual_Ent) = E_Package then
                            Process_Nested_Formal (Actual_Ent);
                         end if;
+
+                     else
+                        Set_Is_Hidden (Actual_Ent);
+                        Set_Is_Potentially_Use_Visible (Actual_Ent, False);
                      end if;
                   end if;
 
                   Next_Non_Pragma (Formal_Node);
+                  Next (Actual_Of_Formal);
 
                else
                   --  No further formals to match, but the generic part may
@@ -7485,7 +7624,6 @@ package body Sem_Ch12 is
 
                   Next_Entity (Actual_Ent);
                end if;
-
             end loop;
 
             --  Inherited subprograms generated by formal derived types are
@@ -8170,9 +8308,9 @@ package body Sem_Ch12 is
       --  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.
+      --  the declaration of the formal object of G must 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)
@@ -8183,8 +8321,10 @@ package body Sem_Ch12 is
         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);
+         Error_Msg_Sloc := Sloc (Actual_Decl);
+         Error_Msg_N
+           ("`NOT NULL` required in formal, to match actual #",
+            Analyzed_Formal);
       end if;
 
       return List;
@@ -8443,7 +8583,6 @@ package body Sem_Ch12 is
       Gen_Body      : Node_Id;
       Gen_Body_Id   : Node_Id;
       Act_Body      : Node_Id;
-      Act_Body_Id   : Entity_Id;
       Pack_Body     : Node_Id;
       Prev_Formal   : Entity_Id;
       Ret_Expr      : Node_Id;
@@ -8496,9 +8635,13 @@ package body Sem_Ch12 is
          Act_Body :=
            Copy_Generic_Node
              (Original_Node (Gen_Body), Empty, Instantiating => True);
-         Act_Body_Id := Defining_Entity (Act_Body);
-         Set_Chars (Act_Body_Id, Chars (Anon_Id));
-         Set_Sloc (Act_Body_Id, Sloc (Defining_Entity (Inst_Node)));
+
+         --  Create proper defining name for the body, to correspond to
+         --  the one in the spec.
+
+         Set_Defining_Unit_Name (Specification (Act_Body),
+           Make_Defining_Identifier
+             (Sloc (Defining_Entity (Inst_Node)), Chars (Anon_Id)));
          Set_Corresponding_Spec (Act_Body, Anon_Id);
          Set_Has_Completion (Anon_Id);
          Check_Generic_Actuals (Pack_Id, False);
@@ -8688,16 +8831,18 @@ package body Sem_Ch12 is
      (Formal          : Node_Id;
       Actual          : Node_Id;
       Analyzed_Formal : Node_Id;
-      Actual_Decls    : List_Id) return Node_Id
+      Actual_Decls    : List_Id) return List_Id
    is
-      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;
+      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;
+      Decl_Nodes : List_Id;
+      Loc        : Source_Ptr;
+      Subt       : Entity_Id;
 
       procedure Validate_Array_Type_Instance;
       procedure Validate_Access_Subprogram_Instance;
@@ -8832,6 +8977,14 @@ package body Sem_Ch12 is
                  Actual, Gen_T);
             Abandon_Instantiation (Actual);
          end if;
+
+         --  Ada 2005: null-exclusion indicators of the two types must agree
+
+         if Can_Never_Be_Null (A_Gen_T) /=  Can_Never_Be_Null (Act_T) then
+            Error_Msg_NE
+              ("non null exclusion of actual and formal & do not match",
+                 Actual, Gen_T);
+         end if;
       end Validate_Access_Type_Instance;
 
       ----------------------------------
@@ -8964,7 +9117,7 @@ package body Sem_Ch12 is
          --  the actual.
 
          if Present (Par)
-           and then  not Interface_Present_In_Ancestor (Act_T, Par)
+           and then not Interface_Present_In_Ancestor (Act_T, Par)
          then
             Error_Msg_NE
               ("interface actual must include progenitor&", Actual, Par);
@@ -8975,7 +9128,9 @@ package body Sem_Ch12 is
 
          Elmt := First_Elmt (Abstract_Interfaces (A_Gen_T));
          while Present (Elmt) loop
-            if not Interface_Present_In_Ancestor (Act_T, Node (Elmt)) then
+            if not Interface_Present_In_Ancestor
+                     (Act_T, Get_Instance_Of (Node (Elmt)))
+            then
                Error_Msg_NE
                  ("interface actual must include progenitor&",
                     Actual, Node (Elmt));
@@ -9256,7 +9411,7 @@ package body Sem_Ch12 is
                Is_Synchronized_Interface (Act_T)
          then
             Error_Msg_NE
-              ("actual for interface& does not match ('R'M 12.5.5(5))",
+              ("actual for interface& does not match ('R'M 12.5.5(4))",
                  Actual, Gen_T);
          end if;
       end Validate_Interface_Type_Instance;
@@ -9376,7 +9531,7 @@ package body Sem_Ch12 is
    begin
       if Get_Instance_Of (A_Gen_T) /= A_Gen_T then
          Error_Msg_N ("duplicate instantiation of generic type", Actual);
-         return Error;
+         return New_List (Error);
 
       elsif not Is_Entity_Name (Actual)
         or else not Is_Type (Entity (Actual))
@@ -9472,7 +9627,11 @@ package body Sem_Ch12 is
               ("actual of non-abstract formal cannot be abstract", Actual);
          end if;
 
-         if Is_Scalar_Type (Gen_T) then
+         --  A generic scalar type is a first subtype for which we generate
+         --  an anonymous base type. Indicate that the instance of this base
+         --  is the base type of the actual.
+
+         if Is_Scalar_Type (A_Gen_T) then
             Set_Instance_Of (Etype (A_Gen_T), Etype (Act_T));
          end if;
       end if;
@@ -9571,6 +9730,8 @@ package body Sem_Ch12 is
          Set_Has_Private_View (Subtype_Indication (Decl_Node));
       end if;
 
+      Decl_Nodes := New_List (Decl_Node);
+
       --  Flag actual derived types so their elaboration produces the
       --  appropriate renamings for the primitive operations of the ancestor.
       --  Flag actual for formal private types as well, to determine whether
@@ -9582,7 +9743,47 @@ package body Sem_Ch12 is
          Set_Generic_Parent_Type (Decl_Node, Ancestor);
       end if;
 
-      return Decl_Node;
+      --  If the actual is a synchronized type that implements an interface,
+      --  the primitive operations are attached to the corresponding record,
+      --  and we have to treat it as an additional generic actual, so that its
+      --  primitive operations become visible in the instance. The task or
+      --  protected type itself does not carry primitive operations.
+
+      if Is_Concurrent_Type (Act_T)
+        and then Is_Tagged_Type (Act_T)
+        and then Present (Corresponding_Record_Type (Act_T))
+        and then Present (Ancestor)
+        and then Is_Interface (Ancestor)
+      then
+         declare
+            Corr_Rec  : constant Entity_Id :=
+                          Corresponding_Record_Type (Act_T);
+            New_Corr  : Entity_Id;
+            Corr_Decl : Node_Id;
+
+         begin
+            New_Corr := Make_Defining_Identifier (Loc,
+                            Chars => New_Internal_Name  ('S'));
+            Corr_Decl :=
+              Make_Subtype_Declaration (Loc,
+                Defining_Identifier => New_Corr,
+                Subtype_Indication  =>
+                  New_Reference_To (Corr_Rec, Loc));
+            Append_To (Decl_Nodes, Corr_Decl);
+
+            if Ekind (Act_T) = E_Task_Type then
+               Set_Ekind (Subt, E_Task_Subtype);
+            else
+               Set_Ekind (Subt, E_Protected_Subtype);
+            end if;
+
+            Set_Corresponding_Record_Type (Subt, Corr_Rec);
+            Set_Generic_Parent_Type (Corr_Decl, Ancestor);
+            Set_Generic_Parent_Type (Decl_Node, Empty);
+         end;
+      end if;
+
+      return Decl_Nodes;
    end Instantiate_Type;
 
    -----------------------
@@ -9590,13 +9791,23 @@ package body Sem_Ch12 is
    -----------------------
 
    function Is_Generic_Formal (E : Entity_Id) return Boolean is
-      Kind : constant Node_Kind := Nkind (Parent (E));
+      Kind : Node_Kind;
+
    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;
+      if No (E) then
+         return False;
+      else
+         Kind := Nkind (Parent (E));
+         return
+           Kind = N_Formal_Object_Declaration
+             or else Kind = N_Formal_Package_Declaration
+             or else Kind = N_Formal_Type_Declaration
+             or else
+               (Is_Formal_Subprogram (E)
+                 and then
+                   Nkind (Parent (Parent (E))) in
+                     N_Formal_Subprogram_Declaration);
+      end if;
    end Is_Generic_Formal;
 
    ---------------------
@@ -9782,8 +9993,7 @@ package body Sem_Ch12 is
                begin
                   Error_Msg_Unit_1 := Bname;
                   Error_Msg_N ("this instantiation requires$!", N);
-                  Error_Msg_Name_1 :=
-                    Get_File_Name (Bname, Subunit => False);
+                  Error_Msg_File_1 := Get_File_Name (Bname, Subunit => False);
                   Error_Msg_N ("\but file{ was not found!", N);
                   raise Unrecoverable_Error;
                end;
@@ -9959,7 +10169,26 @@ package body Sem_Ch12 is
                begin
                   if Nkind (Expr) = N_Subtype_Indication then
                      Analyze (Subtype_Mark (Expr));
-                     Analyze_List (Constraints (Constraint (Expr)));
+
+                     --  Analyze separately each discriminant constraint,
+                     --  when given with a named association.
+
+                     declare
+                        Constr : Node_Id;
+
+                     begin
+                        Constr := First (Constraints (Constraint (Expr)));
+                        while Present (Constr) loop
+                           if Nkind (Constr) = N_Discriminant_Association then
+                              Analyze (Expression (Constr));
+                           else
+                              Analyze (Constr);
+                           end if;
+
+                           Next (Constr);
+                        end loop;
+                     end;
+
                   else
                      Analyze (Expr);
                   end if;
@@ -10553,17 +10782,33 @@ package body Sem_Ch12 is
 
          elsif Nkind (Parent (N)) = N_Selected_Component
            and then Nkind (Parent (N2)) = N_Function_Call
-           and then Is_Global (Entity (Name (Parent (N2))))
+           and then N = Selector_Name (Parent (N))
          then
-            Change_Selected_Component_To_Expanded_Name (Parent (N));
-            Set_Associated_Node (Parent (N), Name (Parent (N2)));
-            Set_Global_Type (Parent (N), Name (Parent (N2)));
-            Save_Entity_Descendants (N);
+            if No (Parameter_Associations (Parent (N2))) then
+               if Is_Global (Entity (Name (Parent (N2)))) then
+                  Change_Selected_Component_To_Expanded_Name (Parent (N));
+                  Set_Associated_Node (Parent (N), Name (Parent (N2)));
+                  Set_Global_Type (Parent (N), Name (Parent (N2)));
+                  Save_Entity_Descendants (N);
 
-         else
-            --  Entity is local. Reset in generic unit, so that node is
-            --  resolved anew at the point of instantiation.
+               else
+                  Set_Associated_Node (N, Empty);
+                  Set_Etype (N, Empty);
+               end if;
+
+            --  In Ada 2005, X.F may be a call to a primitive operation,
+            --  rewritten as F (X). This rewriting will be done again in an
+            --  instance, so keep the original node. Global entities will be
+            --  captured as for other constructs.
 
+            else
+               null;
+            end if;
+
+         --  Entity is local. Reset in generic unit, so that node is resolved
+         --  anew at the point of instantiation.
+
+         else
             Set_Associated_Node (N, Empty);
             Set_Etype (N, Empty);
          end if;