OSDN Git Service

2005-03-29 Robert Dewar <dewar@adacore.com>
[pf3gnuchains/gcc-fork.git] / gcc / ada / sem_ch12.adb
index 588ce99..661ac76 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2004, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2005, 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- --
@@ -51,6 +51,7 @@ with Sem_Ch7;  use Sem_Ch7;
 with Sem_Ch8;  use Sem_Ch8;
 with Sem_Ch10; use Sem_Ch10;
 with Sem_Ch13; use Sem_Ch13;
+with Sem_Disp; use Sem_Disp;
 with Sem_Elab; use Sem_Elab;
 with Sem_Elim; use Sem_Elim;
 with Sem_Eval; use Sem_Eval;
@@ -254,14 +255,18 @@ package body Sem_Ch12 is
    --  in-out, because in the case of an anonymous type the entity is
    --  actually created in the procedure.
 
-   --  The following procedures treat other kinds of formal parameters.
+   --  The following procedures treat other kinds of formal parameters
 
    procedure Analyze_Formal_Derived_Type
      (N   : Node_Id;
       T   : Entity_Id;
       Def : Node_Id);
 
-   --  All the following need comments???
+   --  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
+   --  their bases. The bounds are expressions that are non-static in the
+   --  generic.
 
    procedure Analyze_Formal_Decimal_Fixed_Point_Type
                                                 (T : Entity_Id; Def : Node_Id);
@@ -312,7 +317,7 @@ package body Sem_Ch12 is
    --  On return, the node N has been rewritten with the actual body.
 
    procedure Check_Formal_Packages (P_Id : Entity_Id);
-   --  Apply the following to all formal packages in generic associations.
+   --  Apply the following to all formal packages in generic associations
 
    procedure Check_Formal_Package_Instance
      (Formal_Pack : Entity_Id;
@@ -470,11 +475,11 @@ package body Sem_Ch12 is
    --  When compiling an instance of a child unit the parent (which is
    --  itself an instance) is an enclosing scope that must be made
    --  immediately visible. This procedure is also used to install the non-
-   --  generic parent of a generic child unit when compiling its body, so that
-   --  full views of types in the parent are made visible.
+   --  generic parent of a generic child unit when compiling its body, so
+   --  that full views of types in the parent are made visible.
 
    procedure Remove_Parent (In_Body : Boolean := False);
-   --  Reverse effect after instantiation of child is complete.
+   --  Reverse effect after instantiation of child is complete
 
    procedure Inline_Instance_Body
      (N        : Node_Id;
@@ -485,8 +490,11 @@ package body Sem_Ch12 is
    --  that successive instantiations succeed.
 
    --  The functions Instantiate_XXX perform various legality checks and build
-   --  the declarations for instantiated generic parameters.
-   --  Need to describe what the parameters are ???
+   --  the declarations for instantiated generic parameters. In all of these
+   --  Formal is the entity in the generic unit, Actual is the entity of
+   --  expression in the generic associations, and Analyzed_Formal is the
+   --  formal in the generic copy, which contains the semantic information to
+   --  be used to validate the actual.
 
    function Instantiate_Object
      (Formal          : Node_Id;
@@ -675,12 +683,19 @@ package body Sem_Ch12 is
    --  that the visibility data structures be properly initialized. Once the
    --  generic is unit is validated, Set_Instance_Env completes Save_Env.
 
+   Parent_Unit_Visible : Boolean := False;
+   --  Parent_Unit_Visible is used when the generic is a child unit, and
+   --  indicates whether the ultimate parent of the generic is visible in the
+   --  instantiation environment. It is used to reset the visiblity of the
+   --  parent at the end of the instantiation (see Remove_Parent).
+
    type Instance_Env is record
       Ada_Version         : Ada_Version_Type;
       Instantiated_Parent : Assoc;
       Exchanged_Views     : Elist_Id;
       Hidden_Entities     : Elist_Id;
       Current_Sem_Unit    : Unit_Number_Type;
+      Parent_Unit_Visible : Boolean := False;
    end record;
 
    package Instance_Envs is new Table.Table (
@@ -879,7 +894,7 @@ package body Sem_Ch12 is
             case Nkind (Formal) is
 
                when N_Formal_Subprogram_Declaration =>
-                  exit when Kind = N_Formal_Subprogram_Declaration
+                  exit when Kind in N_Formal_Subprogram_Declaration
                     and then
                       Chars
                         (Defining_Unit_Name (Specification (Formal))) =
@@ -900,7 +915,7 @@ package body Sem_Ch12 is
                   --  unrecognized pragmas.
 
                   exit when
-                    Kind /= N_Formal_Subprogram_Declaration
+                    Kind not in N_Formal_Subprogram_Declaration
                       and then Kind /= N_Subprogram_Declaration
                       and then Kind /= N_Freeze_Entity
                       and then Kind /= N_Null_Statement
@@ -1038,7 +1053,7 @@ package body Sem_Ch12 is
                   then
                      Temp_Formal := First (Formals);
                      while Present (Temp_Formal) loop
-                        if Nkind (Temp_Formal) =
+                        if Nkind (Temp_Formal) in
                              N_Formal_Subprogram_Declaration
                           and then Temp_Formal /= Formal
                           and then
@@ -1279,6 +1294,7 @@ package body Sem_Ch12 is
       Set_Delta_Value    (T, Delta_Val);
       Set_Small_Value    (T, Delta_Val);
       Set_Scalar_Range   (T, Scalar_Range (Base));
+      Set_Is_Constrained (T);
 
       Check_Restriction (No_Fixed_Point, Def);
    end Analyze_Formal_Decimal_Fixed_Point_Type;
@@ -1357,12 +1373,17 @@ package body Sem_Ch12 is
       Lo  : Node_Id;
       Hi  : Node_Id;
 
+      Base : constant Entity_Id :=
+               New_Internal_Entity
+                 (E_Floating_Point_Type, Current_Scope, Sloc (Def), 'G');
    begin
-      Enter_Name     (T);
-      Set_Ekind      (T, E_Enumeration_Type);
-      Set_Etype      (T, T);
-      Init_Size      (T, 8);
-      Init_Alignment (T);
+      Enter_Name          (T);
+      Set_Ekind           (T, E_Enumeration_Subtype);
+      Set_Etype           (T, Base);
+      Init_Size           (T, 8);
+      Init_Alignment      (T);
+      Set_Is_Generic_Type (T);
+      Set_Is_Constrained  (T);
 
       --  For semantic analysis, the bounds of the type must be set to some
       --  non-static value. The simplest is to create attribute nodes for
@@ -1386,6 +1407,14 @@ package body Sem_Ch12 is
           Low_Bound => Lo,
           High_Bound => Hi));
 
+      Set_Ekind           (Base, E_Enumeration_Type);
+      Set_Etype           (Base, Base);
+      Init_Size           (Base, 8);
+      Init_Alignment      (Base);
+      Set_Is_Generic_Type (Base);
+      Set_Scalar_Range    (Base, Scalar_Range (T));
+      Set_Parent          (Base, Parent (Def));
+
    end Analyze_Formal_Discrete_Type;
 
    ----------------------------------
@@ -1404,12 +1433,13 @@ package body Sem_Ch12 is
       --  the generic itself.
 
       Enter_Name (T);
-      Set_Ekind        (T, E_Floating_Point_Subtype);
-      Set_Etype        (T, Base);
-      Set_Size_Info    (T,              (Standard_Float));
-      Set_RM_Size      (T, RM_Size      (Standard_Float));
-      Set_Digits_Value (T, Digits_Value (Standard_Float));
-      Set_Scalar_Range (T, Scalar_Range (Standard_Float));
+      Set_Ekind          (T, E_Floating_Point_Subtype);
+      Set_Etype          (T, Base);
+      Set_Size_Info      (T,              (Standard_Float));
+      Set_RM_Size        (T, RM_Size      (Standard_Float));
+      Set_Digits_Value   (T, Digits_Value (Standard_Float));
+      Set_Scalar_Range   (T, Scalar_Range (Standard_Float));
+      Set_Is_Constrained (T);
 
       Set_Is_Generic_Type (Base);
       Set_Etype           (Base, Base);
@@ -1492,7 +1522,7 @@ package body Sem_Ch12 is
          Set_Ekind (Id, K);
          Set_Etype (Id, T);
 
-      --  Case of generic IN OUT parameter.
+      --  Case of generic IN OUT parameter
 
       else
          --  If the formal has an unconstrained type, construct its
@@ -1562,6 +1592,7 @@ package body Sem_Ch12 is
         Make_Range (Loc,
           Low_Bound  => Make_Real_Literal (Loc, Ureal_1),
           High_Bound => Make_Real_Literal (Loc, Ureal_1)));
+      Set_Is_Constrained   (T);
 
       Set_Is_Generic_Type (Base);
       Set_Etype           (Base, Base);
@@ -1633,7 +1664,7 @@ package body Sem_Ch12 is
          end if;
       end if;
 
-      --  Check for a formal package that is a package renaming.
+      --  Check for a formal package that is a package renaming
 
       if Present (Renamed_Object (Gen_Unit)) then
          Gen_Unit := Renamed_Object (Gen_Unit);
@@ -1752,7 +1783,7 @@ package body Sem_Ch12 is
    begin
       New_Private_Type (N, T, Def);
 
-      --  Set the size to an arbitrary but legal value.
+      --  Set the size to an arbitrary but legal value
 
       Set_Size_Info (T, Standard_Integer);
       Set_RM_Size   (T, RM_Size (Standard_Integer));
@@ -1773,11 +1804,12 @@ package body Sem_Ch12 is
    begin
       Enter_Name (T);
 
-      Set_Ekind        (T, E_Signed_Integer_Subtype);
-      Set_Etype        (T, Base);
-      Set_Size_Info    (T, Standard_Integer);
-      Set_RM_Size      (T, RM_Size (Standard_Integer));
-      Set_Scalar_Range (T, Scalar_Range (Standard_Integer));
+      Set_Ekind          (T, E_Signed_Integer_Subtype);
+      Set_Etype          (T, Base);
+      Set_Size_Info      (T, Standard_Integer);
+      Set_RM_Size        (T, RM_Size (Standard_Integer));
+      Set_Scalar_Range   (T, Scalar_Range (Standard_Integer));
+      Set_Is_Constrained (T);
 
       Set_Is_Generic_Type (Base);
       Set_Size_Info       (Base, Standard_Integer);
@@ -1811,6 +1843,25 @@ package body Sem_Ch12 is
       Set_Is_Formal_Subprogram (Nam);
       Set_Has_Completion (Nam);
 
+      if Nkind (N) = N_Formal_Abstract_Subprogram_Declaration then
+         Set_Is_Abstract (Nam);
+         Set_Is_Dispatching_Operation (Nam);
+
+         declare
+            Ctrl_Type : constant Entity_Id := Find_Dispatching_Type (Nam);
+
+         begin
+            if not Present (Ctrl_Type) then
+               Error_Msg_N
+                 ("abstract formal subprogram must have a controlling type",
+                  N);
+
+            else
+               Check_Controlling_Formals (Ctrl_Type, Nam);
+            end if;
+         end;
+      end if;
+
       --  Default name is resolved at the point of instantiation
 
       if Box_Present (N) then
@@ -1955,7 +2006,7 @@ package body Sem_Ch12 is
             Defining_Identifier (First (Discriminant_Specifications (N))));
       end if;
 
-      --  Enter the new name, and branch to specific routine.
+      --  Enter the new name, and branch to specific routine
 
       case Nkind (Def) is
          when N_Formal_Private_Type_Definition         =>
@@ -2118,7 +2169,7 @@ package body Sem_Ch12 is
       Id := Defining_Entity (N);
       Generate_Definition (Id);
 
-      --  Expansion is not applied to generic units.
+      --  Expansion is not applied to generic units
 
       Start_Generic;
 
@@ -2344,7 +2395,7 @@ package body Sem_Ch12 is
 
       Text_IO_Kludge (Name (N));
 
-      --  Make node global for error reporting.
+      --  Make node global for error reporting
 
       Instantiation_Node := N;
 
@@ -2426,7 +2477,7 @@ package body Sem_Ch12 is
 
       Set_Entity (Gen_Id, Gen_Unit);
 
-      --  If generic is a renaming, get original generic unit.
+      --  If generic is a renaming, get original generic unit
 
       if Present (Renamed_Object (Gen_Unit))
         and then Ekind (Renamed_Object (Gen_Unit)) = E_Generic_Package
@@ -2434,7 +2485,7 @@ package body Sem_Ch12 is
          Gen_Unit := Renamed_Object (Gen_Unit);
       end if;
 
-      --  Verify that there are no circular instantiations.
+      --  Verify that there are no circular instantiations
 
       if In_Open_Scopes (Gen_Unit) then
          Error_Msg_NE ("instantiation of & within itself", N, Gen_Unit);
@@ -2464,7 +2515,7 @@ package body Sem_Ch12 is
 
          Create_Instantiation_Source (N, Gen_Unit, False, S_Adjustment);
 
-         --  Copy original generic tree, to produce text for instantiation.
+         --  Copy original generic tree, to produce text for instantiation
 
          Act_Tree :=
            Copy_Generic_Node
@@ -2771,13 +2822,15 @@ package body Sem_Ch12 is
 
                Set_Cunit_Entity (Current_Sem_Unit, Act_Decl_Id);
 
-               --  If this is the main unit, replace the main entity as well.
+               --  If this is the main unit, replace the main entity as well
 
                if Current_Sem_Unit = Main_Unit then
                   Main_Unit_Entity := Act_Decl_Id;
                end if;
             end if;
 
+            --  There is a problem with inlining here.
+
             Set_Unit (Parent (N), Act_Decl);
             Set_Parent_Spec (Act_Decl, Parent_Spec (N));
             Analyze (Act_Decl);
@@ -3024,7 +3077,7 @@ package body Sem_Ch12 is
                New_Scope (Curr_Scope);
                Set_Is_Immediately_Visible (Curr_Scope);
 
-               --  Finally, restore inner scopes as well.
+               --  Finally, restore inner scopes as well
 
                for J in reverse 1 .. Num_Inner loop
                   New_Scope (Inner_Scopes (J));
@@ -3032,12 +3085,34 @@ package body Sem_Ch12 is
             end if;
 
             Restore_Scope_Stack (Handle_Use => False);
+
+            if Present (Curr_Scope)
+              and then
+                (In_Private_Part (Curr_Scope)
+                  or else In_Package_Body (Curr_Scope))
+            then
+               --  Install private declaration of ancestor units, which
+               --  are currently available. Restore_Scope_Stack and
+               --  Install_Context only install the visible part of parents.
+
+               declare
+                  Par : Entity_Id;
+               begin
+                  Par := Scope (Curr_Scope);
+                  while (Present (Par))
+                    and then Par /= Standard_Standard
+                  loop
+                     Install_Private_Declarations (Par);
+                     Par := Scope (Par);
+                  end loop;
+               end;
+            end if;
          end if;
 
-         --  Restore use clauses. For a child unit, use clauses in the
-         --  parents are restored when installing the context, so only
-         --  those in inner scopes (and those local to the child unit itself)
-         --  need to be installed explicitly.
+         --  Restore use clauses. For a child unit, use clauses in the parents
+         --  are restored when installing the context, so only those in inner
+         --  scopes (and those local to the child unit itself) need to be
+         --  installed explicitly.
 
          if Is_Child_Unit (Curr_Unit)
            and then Removed
@@ -3060,7 +3135,7 @@ package body Sem_Ch12 is
             Set_Is_Generic_Instance (Instances (J), True);
          end loop;
 
-      --  If generic unit is in current unit, current context is correct.
+      --  If generic unit is in current unit, current context is correct
 
       else
          Instantiate_Package_Body
@@ -3239,7 +3314,7 @@ package body Sem_Ch12 is
             Set_Cunit_Entity (Current_Sem_Unit, Pack_Id);
          end if;
 
-         --  The instance is not a freezing point for the new subprogram.
+         --  The instance is not a freezing point for the new subprogram
 
          Set_Is_Frozen (Act_Decl_Id, False);
 
@@ -3268,7 +3343,7 @@ package body Sem_Ch12 is
 
       Text_IO_Kludge (Gen_Id);
 
-      --  Make node global for error reporting.
+      --  Make node global for error reporting
 
       Instantiation_Node := N;
       Pre_Analyze_Actuals (N);
@@ -3359,14 +3434,14 @@ package body Sem_Ch12 is
 
          Set_Instance_Env (Gen_Unit, Empty);
 
-         --  Initialize renamings map, for error checking.
+         --  Initialize renamings map, for error checking
 
          Generic_Renamings.Set_Last (0);
          Generic_Renamings_HTable.Reset;
 
          Create_Instantiation_Source (N, Gen_Unit, False, S_Adjustment);
 
-         --  Copy original generic tree, to produce text for instantiation.
+         --  Copy original generic tree, to produce text for instantiation
 
          Act_Tree :=
            Copy_Generic_Node
@@ -3585,7 +3660,7 @@ package body Sem_Ch12 is
       Set_Library_Unit  (Decl_Cunit, Body_Cunit);
       Set_Library_Unit  (Body_Cunit, Decl_Cunit);
 
-      --  Preserve the private nature of the package if needed.
+      --  Preserve the private nature of the package if needed
 
       Set_Private_Present (Decl_Cunit, Private_Present (Body_Cunit));
 
@@ -3726,7 +3801,7 @@ package body Sem_Ch12 is
         (E1, E2 : Entity_Id) return Boolean
       is
          function Original_Entity (E : Entity_Id) return Entity_Id;
-         --  Follow chain of renamings to the ultimate ancestor.
+         --  Follow chain of renamings to the ultimate ancestor
 
          ---------------------
          -- Original_Entity --
@@ -4106,7 +4181,7 @@ package body Sem_Ch12 is
       function Find_Generic_Child
         (Scop : Entity_Id;
          Id   : Node_Id) return Entity_Id;
-      --  Search generic parent for possible child unit with the given name.
+      --  Search generic parent for possible child unit with the given name
 
       function In_Enclosing_Instance return Boolean;
       --  Within an instance of the parent, the child unit may be denoted
@@ -4273,7 +4348,7 @@ package body Sem_Ch12 is
                Set_Entity (S, E);
                Set_Etype (S, Etype (E));
 
-               --  Indicate that this is a reference to the parent.
+               --  Indicate that this is a reference to the parent
 
                if In_Extended_Main_Source_Unit (Gen_Id) then
                   Set_Is_Instantiated (Inst_Par);
@@ -4589,7 +4664,7 @@ package body Sem_Ch12 is
                Next_Elmt (Elmt);
             end loop;
 
-            --  Indicate that Inner is being instantiated within  Scop.
+            --  Indicate that Inner is being instantiated within Scop
 
             Append_Elmt (Inner, Inner_Instances (Scop));
          end if;
@@ -4623,15 +4698,15 @@ package body Sem_Ch12 is
       --  value (Sloc, Uint, Char) in which case it need not be copied.
 
       procedure Copy_Descendants;
-      --  Common utility for various nodes.
+      --  Common utility for various nodes
 
       function Copy_Generic_Elist (E : Elist_Id) return Elist_Id;
-      --  Make copy of element list.
+      --  Make copy of element list
 
       function Copy_Generic_List
         (L         : List_Id;
          Parent_Id : Node_Id) return List_Id;
-      --  Apply Copy_Node recursively to the members of a node list.
+      --  Apply Copy_Node recursively to the members of a node list
 
       function In_Defining_Unit_Name (Nam : Node_Id) return Boolean;
       --  True if an identifier is part of the defining program unit name
@@ -5123,7 +5198,7 @@ package body Sem_Ch12 is
 
          begin
             if Present (T) then
-               --  Retrieve the allocator node in the generic copy.
+               --  Retrieve the allocator node in the generic copy
 
                Acc_T := Etype (Parent (Parent (T)));
                if Present (Acc_T)
@@ -5346,7 +5421,7 @@ package body Sem_Ch12 is
       --  node for it.
 
       function True_Parent (N : Node_Id) return Node_Id;
-      --  For a subunit, return parent of corresponding stub.
+      --  For a subunit, return parent of corresponding stub
 
       -------------
       -- Earlier --
@@ -5359,7 +5434,7 @@ package body Sem_Ch12 is
          P2 : Node_Id := N2;
 
          procedure Find_Depth (P : in out Node_Id; D : in out Integer);
-         --  Find distance from given node to enclosing compilation unit.
+         --  Find distance from given node to enclosing compilation unit
 
          ----------------
          -- Find_Depth --
@@ -5744,6 +5819,7 @@ package body Sem_Ch12 is
       Saved.Exchanged_Views     := Exchanged_Views;
       Saved.Hidden_Entities     := Hidden_Entities;
       Saved.Current_Sem_Unit    := Current_Sem_Unit;
+      Saved.Parent_Unit_Visible := Parent_Unit_Visible;
       Instance_Envs.Increment_Last;
       Instance_Envs.Table (Instance_Envs.Last) := Saved;
 
@@ -5939,7 +6015,7 @@ package body Sem_Ch12 is
       Must_Delay : Boolean;
 
       function Enclosing_Subp (Id : Entity_Id) return Entity_Id;
-      --  Find subprogram (if any) that encloses instance and/or generic body.
+      --  Find subprogram (if any) that encloses instance and/or generic body
 
       function True_Sloc (N : Node_Id) return Source_Ptr;
       --  If the instance is nested inside a generic unit, the Sloc of the
@@ -5947,7 +6023,7 @@ package body Sem_Ch12 is
       --  point of the current enclosing instance. Pending a better usage of
       --  Slocs to indicate instantiation places, we determine the place of
       --  origin of a node by finding the maximum sloc of any ancestor node.
-      --  Why is this not equivalent fo Top_Level_Location ???
+      --  Why is this not equivalent to Top_Level_Location ???
 
       --------------------
       -- Enclosing_Subp --
@@ -6106,7 +6182,7 @@ package body Sem_Ch12 is
       --  for the unit itself.
 
       procedure Install_Noninstance_Specs (Par : Entity_Id);
-      --  Install the scopes of noninstance parent units ending with Par.
+      --  Install the scopes of noninstance parent units ending with Par
 
       procedure Install_Spec (Par : Entity_Id);
       --  The child unit is within the declarative part of the parent, so
@@ -6121,13 +6197,11 @@ package body Sem_Ch12 is
 
       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 this is the renaming for the parent instance, done
 
                if Renamed_Object (E) = Par then
                   exit;
@@ -6174,6 +6248,10 @@ package body Sem_Ch12 is
                   Specification (Unit_Declaration_Node (Par));
 
       begin
+         if not Is_Child_Unit (Par) then
+            Parent_Unit_Visible := Is_Immediately_Visible (Par);
+         end if;
+
          New_Scope (Par);
          Set_Is_Immediately_Visible   (Par);
          Install_Visible_Declarations (Par);
@@ -6440,7 +6518,7 @@ package body Sem_Ch12 is
 
                   while Present (Actual_Ent)
                     and then Present (Formal_Node)
-                    and then Actual_Ent /= First_Private_Entity (Act_Ent)
+                    and then Actual_Ent /= First_Private_Entity (Act_Pkg)
                   loop
                      --  ???  Are the following calls also needed here:
                      --
@@ -6492,7 +6570,7 @@ package body Sem_Ch12 is
          if No (Gen_Par) then
             return False;
 
-         --  Simplest case: the generic parent of the actual is the formal.
+         --  Simplest case: the generic parent of the actual is the formal
 
          elsif Gen_Par = Gen_Anc then
             return True;
@@ -6773,16 +6851,16 @@ package body Sem_Ch12 is
       New_Spec   : Node_Id;
 
       function From_Parent_Scope (Subp : Entity_Id) return Boolean;
-      --  If the generic is a child unit, the parent has been installed
-      --  on the scope stack, but a default subprogram cannot resolve to
-      --  something on the parent because that parent is not really part
-      --  of the visible context (it is there to resolve explicit local
-      --  entities). If the default has resolved in this way, we remove
-      --  the entity from immediate visibility and analyze the node again
-      --  to emit an error message or find another visible candidate.
+      --  If the generic is a child unit, the parent has been installed on the
+      --  scope stack, but a default subprogram cannot resolve to something on
+      --  the parent because that parent is not really part of the visible
+      --  context (it is there to resolve explicit local entities). If the
+      --  default has resolved in this way, we remove the entity from
+      --  immediate visibility and analyze the node again to emit an error
+      --  message or find another visible candidate.
 
       procedure Valid_Actual_Subprogram (Act : Node_Id);
-      --  Perform legality check and raise exception on failure.
+      --  Perform legality check and raise exception on failure
 
       -----------------------
       -- From_Parent_Scope --
@@ -6842,7 +6920,7 @@ package body Sem_Ch12 is
    begin
       New_Spec := New_Copy_Tree (Specification (Formal));
 
-      --  Create new entity for the actual (New_Copy_Tree does not).
+      --  Create new entity for the actual (New_Copy_Tree does not)
 
       Set_Defining_Unit_Name
         (New_Spec, Make_Defining_Identifier (Loc, Chars (Formal_Sub)));
@@ -6966,10 +7044,12 @@ package body Sem_Ch12 is
 
       --  The generic instantiation freezes the actual. This can only be
       --  done once the actual is resolved, in the analysis of the renaming
-      --  declaration. To indicate that must be done, we set the corresponding
-      --  spec of the node to point to the formal subprogram entity.
+      --  declaration. To make the formal subprogram entity available, we set
+      --  Corresponding_Formal_Spec to point to the formal subprogram entity.
+      --  This is also needed in Analyze_Subprogram_Renaming for the processing
+      --  of formal abstract subprograms.
 
-      Set_Corresponding_Spec (Decl_Node, Analyzed_S);
+      Set_Corresponding_Formal_Spec (Decl_Node, Analyzed_S);
 
       --  We cannot analyze the renaming declaration, and thus find the
       --  actual, until the all the actuals are assembled in the instance.
@@ -7032,7 +7112,8 @@ package body Sem_Ch12 is
       Subt_Decl : Node_Id := Empty;
 
    begin
-      --  Sloc for error message on missing actual.
+      --  Sloc for error message on missing actual
+
       Error_Msg_Sloc := Sloc (Scope (Defining_Identifier (Analyzed_Formal)));
 
       if Get_Instance_Of (Formal_Id) /= Formal_Id then
@@ -7045,12 +7126,12 @@ package body Sem_Ch12 is
 
       if Out_Present (Formal) then
 
-         --  An IN OUT generic actual must be a name. The instantiation is
-         --  a renaming declaration. The actual is the name being renamed.
-         --  We use the actual directly, rather than a copy, because it is not
+         --  An IN OUT generic actual must be a name. The instantiation is a
+         --  renaming declaration. The actual is the name being renamed. We
+         --  use the actual directly, rather than a copy, because it is not
          --  used further in the list of actuals, and because a copy or a use
-         --  of relocate_node is incorrect if the instance is nested within
-         --  generic. In order to simplify ASIS searches, the Generic_Parent
+         --  of relocate_node is incorrect if the instance is nested within a
+         --  generic. In order to simplify ASIS searches, the Generic_Parent
          --  field links the declaration to the generic association.
 
          if No (Actual) then
@@ -7078,6 +7159,12 @@ package body Sem_Ch12 is
          Append (Decl_Node, List);
          Analyze (Actual);
 
+         --  Return if the analysis of the actual reported some error
+
+         if Etype (Actual) = Any_Type then
+            return List;
+         end if;
+
          --  This check is performed here because Analyze_Object_Renaming
          --  will not check it when Comes_From_Source is False. Note
          --  though that the check for the actual being the name of an
@@ -7187,6 +7274,12 @@ package body Sem_Ch12 is
 
             if Nkind (Actual) /= N_Allocator then
                Analyze (Actual);
+
+               --  Return if the analysis of the actual reported some error
+
+               if Etype (Actual) = Any_Type then
+                  return List;
+               end if;
             end if;
 
             declare
@@ -7197,9 +7290,9 @@ package body Sem_Ch12 is
             begin
                Freeze_Before (Instantiation_Node, Typ);
 
-               --  If the actual is an aggregate, perform name resolution
-               --  on its components (the analysis of an aggregate does not
-               --  do it) to capture local names that may be hidden if the
+               --  If the actual is an aggregate, perform name resolution on
+               --  its components (the analysis of an aggregate does not do
+               --  it) to capture local names that may be hidden if the
                --  generic is a child unit.
 
                if Nkind (Actual) = N_Aggregate then
@@ -7209,7 +7302,7 @@ package body Sem_Ch12 is
 
          elsif Present (Expression (Formal)) then
 
-            --  Use default to construct declaration.
+            --  Use default to construct declaration
 
             Decl_Node :=
               Make_Object_Declaration (Sloc (Formal),
@@ -8259,19 +8352,20 @@ package body Sem_Ch12 is
 
                   Formal_Subt := Get_Instance_Of (Etype (Formal_Discr));
 
-                  --  access discriminants match if designated types do.
+                  --  Access discriminants match if designated types do
 
                   if Ekind (Base_Type (Formal_Subt)) = E_Anonymous_Access_Type
-                    and then (Ekind (Base_Type (Etype (Actual_Discr))))
-                      = E_Anonymous_Access_Type
-                    and then Get_Instance_Of (
-                      Designated_Type (Base_Type (Formal_Subt)))
-                      = Designated_Type (Base_Type (Etype (Actual_Discr)))
+                    and then (Ekind (Base_Type (Etype (Actual_Discr)))) =
+                                E_Anonymous_Access_Type
+                    and then
+                      Get_Instance_Of
+                        (Designated_Type (Base_Type (Formal_Subt))) =
+                           Designated_Type (Base_Type (Etype (Actual_Discr)))
                   then
                      null;
 
                   elsif Base_Type (Formal_Subt) /=
-                                       Base_Type (Etype (Actual_Discr))
+                          Base_Type (Etype (Actual_Discr))
                   then
                      Error_Msg_NE
                        ("types of actual discriminants must match formal",
@@ -8922,16 +9016,18 @@ package body Sem_Ch12 is
                   Install_Private_Declarations (P);
                end if;
 
-            --  This looks incomplete: what about compilation units that
-            --  were made visible by Install_Parent but should not remain
-            --  visible??? Standard is on the scope stack.
+            --  If the ultimate parent is a compilation unit, reset its
+            --  visibility to what it was before instantiation.
 
-            elsif not In_Open_Scopes (Scope (P)) then
+            elsif not In_Open_Scopes (Scope (P))
+              or else
+               (not Is_Child_Unit (P) and then not Parent_Unit_Visible)
+            then
                Set_Is_Immediately_Visible (P, False);
             end if;
          end loop;
 
-         --  Reset visibility of entities in the enclosing scope.
+         --  Reset visibility of entities in the enclosing scope
 
          Set_Is_Hidden_Open_Scope (Current_Scope, False);
          Hidden := First_Elmt (Hidden_Entities);
@@ -8977,6 +9073,7 @@ package body Sem_Ch12 is
       Exchanged_Views              := Saved.Exchanged_Views;
       Hidden_Entities              := Saved.Hidden_Entities;
       Current_Sem_Unit             := Saved.Current_Sem_Unit;
+      Parent_Unit_Visible          := Saved.Parent_Unit_Visible;
 
       Instance_Envs.Decrement_Last;
    end Restore_Env;
@@ -9019,8 +9116,9 @@ package body Sem_Ch12 is
                Set_Is_Hidden (Ent);
                Set_Is_Potentially_Use_Visible (Ent, False);
 
+               --  If package, then recurse
+
                if Ekind (Ent) = E_Package then
-                  --  Recurse.
                   Restore_Nested_Formal (Ent);
                end if;
 
@@ -9536,7 +9634,7 @@ package body Sem_Ch12 is
             Next (Act2);
          end loop;
 
-         --  Find the associations added for default suprograms.
+         --  Find the associations added for default suprograms
 
          if Present (Act2) then
             while Nkind (Act2) /= N_Generic_Association
@@ -9805,7 +9903,7 @@ package body Sem_Ch12 is
                   --  access to a composite type, or a parameterless function
                   --  call that returns an access type.
 
-                  --  Check whether corresponding entity in prefix is global.
+                  --  Check whether corresponding entity in prefix is global
 
                   if Is_Entity_Name (Prefix (N2))
                     and then Present (Entity (Prefix (N2)))