sem_ch4.adb (Analyze_Selected_Component): Include the requeue statement to the list of contexts where a selected...

2007-12-06  Hristian Kirtchev  <kirtchev@adacore.com>
	    Ed Schonberg  <schonberg@adacore.com>

	* sem_ch4.adb (Analyze_Selected_Component): Include the requeue
	statement to the list of contexts where a selected component with a
	concurrent tagged type prefix should yield a primitive operation.
	(Find_Primitive_Operation): Handle case of class-wide types.
	(Analyze_Overloaded_Selected_Component): If type of prefix is
	class-wide, use visible components of base type.
	(Resolve_Selected_Component): Ditto.
	(Try_Primitive_Operation, Collect_Generic_Type_Ops): If the type is a
	formal of a generic subprogram. find candidate interpretations by
	scanning the list of generic formal declarations.:
	(Process_Implicit_Dereference_Prefix): If the prefix has an incomplete
	type from a limited_with_clause, and the full view is available, use it
	for subsequent semantic checks.
	(Check_Misspelled_Selector): Use Namet.Sp.Is_Bad_Spelling_Of function
	(Find_Primitive_Operation): New function.
	(Analyze_Overloaded_Selected_Component): insert explicit dereference
	only once if several interpretations of the prefix yield an access type.
	(Try_Object_Operation): Code and comment cleanup.
	(Analyze_Selected_Component): Reorder local variables. Minot comment and
	code reformatting. When the type of the prefix is tagged concurrent, a
	correct interpretation might be available in the primitive and
	class-wide operations of the type.

From-SVN: r130853

1 files changed, 397 insertions, 191 deletions

diff --git a/gcc/ada/sem_ch4.adb b/gcc/ada/sem_ch4.adb
index 818d576..1627072 100644
--- a/gcc/ada/sem_ch4.adb
+++ b/gcc/ada/sem_ch4.adb
@@ -34,6 +34,7 @@ with Itypes;   use Itypes;
 with Lib;      use Lib;
 with Lib.Xref; use Lib.Xref;
 with Namet;    use Namet;
+with Namet.Sp; use Namet.Sp;
 with Nlists;   use Nlists;
 with Nmake;    use Nmake;
 with Opt;      use Opt;
@@ -43,6 +44,7 @@ with Rident;   use Rident;
 with Sem;      use Sem;
 with Sem_Cat;  use Sem_Cat;
 with Sem_Ch3;  use Sem_Ch3;
+with Sem_Ch6;  use Sem_Ch6;
 with Sem_Ch8;  use Sem_Ch8;
 with Sem_Disp; use Sem_Disp;
 with Sem_Dist; use Sem_Dist;
@@ -55,8 +57,6 @@ with Sinfo;    use Sinfo;
 with Snames;   use Snames;
 with Tbuild;   use Tbuild;
 
-with GNAT.Spelling_Checker; use GNAT.Spelling_Checker;
-
 package body Sem_Ch4 is
 
    -----------------------
@@ -184,6 +184,10 @@ package body Sem_Ch4 is
    --  interpretation of the other operand. N can be an operator node, or
    --  a function call whose name is an operator designator.
 
+   function Find_Primitive_Operation (N : Node_Id) return Boolean;
+   --  Find candidate interpretations for the name Obj.Proc when it appears
+   --  in a subprogram renaming declaration.
+
    procedure Find_Unary_Types
      (R     : Node_Id;
       Op_Id : Entity_Id;
@@ -219,14 +223,18 @@ package body Sem_Ch4 is
    --  type is not directly visible. The routine uses this type to emit a more
    --  informative message.
 
-   procedure Process_Implicit_Dereference_Prefix
+   function Process_Implicit_Dereference_Prefix
      (E : Entity_Id;
-      P : Node_Id);
+      P : Node_Id) return Entity_Id;
    --  Called when P is the prefix of an implicit dereference, denoting an
-   --  object E. If in semantics only mode (-gnatc or generic), record that is
-   --  a reference to E. Normally, such a reference is generated only when the
-   --  implicit dereference is expanded into an explicit one. E may be empty,
-   --  in which case this procedure does nothing.
+   --  object E. The function returns the designated type of the prefix, taking
+   --  into account that the designated type of an anonymous access type may be
+   --  a limited view, when the non-limited view is visible.
+   --  If in semantics only mode (-gnatc or generic), the function also records
+   --  that the prefix is a reference to E, if any. Normally, such a reference
+   --  is generated only when the implicit dereference is expanded into an
+   --  explicit one, but for consistency we must generate the reference when
+   --  expansion is disabled as well.
 
    procedure Remove_Abstract_Operations (N : Node_Id);
    --  Ada 2005: implementation of AI-310. An abstract non-dispatching
@@ -303,9 +311,7 @@ package body Sem_Ch4 is
       if Nkind (N) in N_Membership_Test then
          Error_Msg_N ("ambiguous operands for membership",  N);
 
-      elsif Nkind (N) = N_Op_Eq
-        or else Nkind (N) = N_Op_Ne
-      then
+      elsif Nkind_In (N, N_Op_Eq, N_Op_Ne) then
          Error_Msg_N ("ambiguous operands for equality",  N);
 
       else
@@ -349,7 +355,6 @@ package body Sem_Ch4 is
       Check_Restriction (No_Allocators, N);
 
       if Nkind (E) = N_Qualified_Expression then
-
          Acc_Type := Create_Itype (E_Allocator_Type, N);
          Set_Etype (Acc_Type, Acc_Type);
          Init_Size_Align (Acc_Type);
@@ -461,8 +466,8 @@ package body Sem_Ch4 is
                       Subtype_Indication  => Relocate_Node (E)));
 
                   if Sav_Errs /= Serious_Errors_Detected
-                    and then Nkind (Constraint (E))
-                      = N_Index_Or_Discriminant_Constraint
+                    and then Nkind (Constraint (E)) =
+                               N_Index_Or_Discriminant_Constraint
                   then
                      Error_Msg_N
                        ("if qualified expression was meant, " &
@@ -599,21 +604,18 @@ package body Sem_Ch4 is
       Analyze_Expression (L);
       Analyze_Expression (R);
 
-      --  If the entity is already set, the node is the instantiation of
-      --  a generic node with a non-local reference, or was manufactured
-      --  by a call to Make_Op_xxx. In either case the entity is known to
-      --  be valid, and we do not need to collect interpretations, instead
-      --  we just get the single possible interpretation.
+      --  If the entity is already set, the node is the instantiation of a
+      --  generic node with a non-local reference, or was manufactured by a
+      --  call to Make_Op_xxx. In either case the entity is known to be valid,
+      --  and we do not need to collect interpretations, instead we just get
+      --  the single possible interpretation.
 
       Op_Id := Entity (N);
 
       if Present (Op_Id) then
          if Ekind (Op_Id) = E_Operator then
 
-            if (Nkind (N) = N_Op_Divide   or else
-                Nkind (N) = N_Op_Mod      or else
-                Nkind (N) = N_Op_Multiply or else
-                Nkind (N) = N_Op_Rem)
+            if Nkind_In (N, N_Op_Divide, N_Op_Mod, N_Op_Multiply, N_Op_Rem)
               and then Treat_Fixed_As_Integer (N)
             then
                null;
@@ -753,7 +755,6 @@ package body Sem_Ch4 is
          --  kinds of call into this form.
 
          elsif Nkind (Nam) = N_Indexed_Component then
-
             if Nkind (Prefix (Nam)) = N_Selected_Component then
                Nam_Ent := Entity (Selector_Name (Prefix (Nam)));
             else
@@ -794,8 +795,8 @@ package body Sem_Ch4 is
                   --  Check for tasking cases where only an entry call will do
 
                   elsif not L
-                    and then (K = N_Entry_Call_Alternative
-                               or else K = N_Triggering_Alternative)
+                    and then Nkind_In (K, N_Entry_Call_Alternative,
+                                          N_Triggering_Alternative)
                   then
                      Error_Msg_N ("entry name expected", Nam);
 
@@ -818,7 +819,7 @@ package body Sem_Ch4 is
          --  the return type of the access_to_subprogram.
 
          if Success
-           and then  Nkind (Nam) = N_Explicit_Dereference
+           and then Nkind (Nam) = N_Explicit_Dereference
            and then Ekind (Etype (N)) = E_Incomplete_Type
            and then Present (Full_View (Etype (N)))
          then
@@ -871,8 +872,8 @@ package body Sem_Ch4 is
             if Success then
                Set_Etype (Nam, It.Typ);
 
-            elsif Nkind (Name (N)) = N_Selected_Component
-              or else Nkind (Name (N)) = N_Function_Call
+            elsif Nkind_In (Name (N), N_Selected_Component,
+                                      N_Function_Call)
             then
                Remove_Interp (X);
             end if;
@@ -971,9 +972,9 @@ package body Sem_Ch4 is
       if Ada_Version >= Ada_05
         and then not Debug_Flag_Dot_L
         and then Is_Inherently_Limited_Type (Etype (N))
-        and then (Nkind (Parent (N)) = N_Selected_Component
-                   or else Nkind (Parent (N)) = N_Indexed_Component
-                   or else Nkind (Parent (N)) = N_Slice
+        and then (Nkind_In (Parent (N), N_Selected_Component,
+                                        N_Indexed_Component,
+                                        N_Slice)
                    or else
                     (Nkind (Parent (N)) = N_Attribute_Reference
                        and then Attribute_Name (Parent (N)) /= Name_Class))
@@ -1550,9 +1551,8 @@ package body Sem_Ch4 is
             --  account a possible implicit dereference.
 
             if Is_Access_Type (Array_Type) then
-               Array_Type := Designated_Type (Array_Type);
                Error_Msg_NW (Warn_On_Dereference, "?implicit dereference", N);
-               Process_Implicit_Dereference_Prefix (Pent, P);
+               Array_Type := Process_Implicit_Dereference_Prefix (Pent, P);
             end if;
 
             if Is_Array_Type (Array_Type) then
@@ -1739,9 +1739,9 @@ package body Sem_Ch4 is
       --  Get name of array, function or type
 
       Analyze (P);
-      if Nkind (N) = N_Function_Call
-        or else Nkind (N) = N_Procedure_Call_Statement
-      then
+
+      if Nkind_In (N, N_Function_Call, N_Procedure_Call_Statement) then
+
          --  If P is an explicit dereference whose prefix is of a
          --  remote access-to-subprogram type, then N has already
          --  been rewritten as a subprogram call and analyzed.
@@ -2025,8 +2025,9 @@ package body Sem_Ch4 is
        Success    : out Boolean;
        Skip_First : Boolean := False)
    is
-      Actuals    : constant List_Id   := Parameter_Associations (N);
-      Prev_T     : constant Entity_Id := Etype (N);
+      Actuals : constant List_Id   := Parameter_Associations (N);
+      Prev_T  : constant Entity_Id := Etype (N);
+
       Must_Skip  : constant Boolean := Skip_First
                      or else Nkind (Original_Node (N)) = N_Selected_Component
                      or else
@@ -2496,6 +2497,14 @@ package body Sem_Ch4 is
          end if;
 
          if Is_Record_Type (T) then
+
+            --  If the prefix is a class-wide type, the visible components are
+            --  those of the base type.
+
+            if Is_Class_Wide_Type (T) then
+               T := Etype (T);
+            end if;
+
             Comp := First_Entity (T);
             while Present (Comp) loop
                if Chars (Comp) = Chars (Sel)
@@ -2532,9 +2541,12 @@ package body Sem_Ch4 is
                   Set_Etype (Nam, It.Typ);
 
                   --  For access type case, introduce explicit deference for
-                  --  more uniform treatment of entry calls.
+                  --  more uniform treatment of entry calls. Do this only
+                  --  once if several interpretations yield an access type.
 
-                  if Is_Access_Type (Etype (Nam)) then
+                  if Is_Access_Type (Etype (Nam))
+                    and then Nkind (Nam) /= N_Explicit_Dereference
+                  then
                      Insert_Explicit_Dereference (Nam);
                      Error_Msg_NW
                        (Warn_On_Dereference, "?implicit dereference", N);
@@ -2754,20 +2766,64 @@ package body Sem_Ch4 is
    --  later case, the selector must denote a visible entry.
 
    procedure Analyze_Selected_Component (N : Node_Id) is
-      Name        : constant Node_Id := Prefix (N);
-      Sel         : constant Node_Id := Selector_Name (N);
-      Comp        : Entity_Id;
-      Prefix_Type : Entity_Id;
+      Name          : constant Node_Id := Prefix (N);
+      Sel           : constant Node_Id := Selector_Name (N);
+      Act_Decl      : Node_Id;
+      Comp          : Entity_Id;
+      Has_Candidate : Boolean := False;
+      In_Scope      : Boolean;
+      Parent_N      : Node_Id;
+      Pent          : Entity_Id := Empty;
+      Prefix_Type   : Entity_Id;
 
       Type_To_Use : Entity_Id;
       --  In most cases this is the Prefix_Type, but if the Prefix_Type is
       --  a class-wide type, we use its root type, whose components are
       --  present in the class-wide type.
 
-      Pent        : Entity_Id := Empty;
-      Act_Decl    : Node_Id;
-      In_Scope    : Boolean;
-      Parent_N    : Node_Id;
+      function Has_Mode_Conformant_Spec (Comp : Entity_Id) return Boolean;
+      --  It is known that the parent of N denotes a subprogram call. Comp
+      --  is an overloadable component of the concurrent type of the prefix.
+      --  Determine whether all formals of the parent of N and Comp are mode
+      --  conformant.
+
+      ------------------------------
+      -- Has_Mode_Conformant_Spec --
+      ------------------------------
+
+      function Has_Mode_Conformant_Spec (Comp : Entity_Id) return Boolean is
+         Comp_Param : Entity_Id;
+         Param      : Node_Id;
+         Param_Typ  : Entity_Id;
+
+      begin
+         Comp_Param := First_Formal (Comp);
+         Param := First (Parameter_Associations (Parent (N)));
+         while Present (Comp_Param)
+           and then Present (Param)
+         loop
+            Param_Typ := Find_Parameter_Type (Param);
+
+            if Present (Param_Typ)
+              and then
+                not Conforming_Types
+                     (Etype (Comp_Param), Param_Typ, Mode_Conformant)
+            then
+               return False;
+            end if;
+
+            Next_Formal (Comp_Param);
+            Next (Param);
+         end loop;
+
+         --  One of the specs has additional formals
+
+         if Present (Comp_Param) or else Present (Param) then
+            return False;
+         end if;
+
+         return True;
+      end Has_Mode_Conformant_Spec;
 
    --  Start of processing for Analyze_Selected_Component
 
@@ -2814,11 +2870,8 @@ package body Sem_Ch4 is
                Pent := Entity (Selector_Name (Name));
             end if;
 
-            Process_Implicit_Dereference_Prefix (Pent, Name);
+            Prefix_Type := Process_Implicit_Dereference_Prefix (Pent, Name);
          end if;
-
-         Prefix_Type := Designated_Type (Prefix_Type);
-
       end if;
 
       --  (Ada 2005): if the prefix is the limited view of a type, and
@@ -2966,7 +3019,7 @@ package body Sem_Ch4 is
                if not Is_Packed (Etype (Comp))
                  and then
                    ((Nkind (Parent_N) = N_Indexed_Component
-                      and then Nkind (Name) /= N_Selected_Component)
+                       and then Nkind (Name) /= N_Selected_Component)
                      or else
                       (Nkind (Parent_N) = N_Attribute_Reference
                          and then (Attribute_Name (Parent_N) = Name_First
@@ -3037,13 +3090,29 @@ package body Sem_Ch4 is
             Next_Entity (Comp);
          end loop;
 
-         --  Ada 2005 (AI-252)
+         --  Ada 2005 (AI-252): The selected component can be interpreted as
+         --  a prefixed view of a subprogram. Depending on the context, this is
+         --  either a name that can appear in a renaming declaration, or part
+         --  of an enclosing call given in prefix form.
+
+         --  Ada 2005 (AI05-0030): In the case of dispatching requeue, the
+         --  selected component should resolve to a name.
 
          if Ada_Version >= Ada_05
            and then Is_Tagged_Type (Prefix_Type)
-           and then Try_Object_Operation (N)
+           and then not Is_Concurrent_Type (Prefix_Type)
          then
-            return;
+            if Nkind (Parent (N)) = N_Generic_Association
+              or else Nkind (Parent (N)) = N_Requeue_Statement
+              or else Nkind (Parent (N)) = N_Subprogram_Renaming_Declaration
+            then
+               if Find_Primitive_Operation (N) then
+                  return;
+               end if;
+
+            elsif Try_Object_Operation (N) then
+               return;
+            end if;
 
             --  If the transformation fails, it will be necessary to redo the
             --  analysis with all errors enabled, to indicate candidate
@@ -3052,6 +3121,7 @@ package body Sem_Ch4 is
          end if;
 
       elsif Is_Private_Type (Prefix_Type) then
+
          --  Allow access only to discriminants of the type. If the type has
          --  no full view, gigi uses the parent type for the components, so we
          --  do the same here.
@@ -3071,8 +3141,7 @@ package body Sem_Ch4 is
                   Set_Etype (N,   Etype (Comp));
 
                   if Is_Generic_Type (Prefix_Type)
-                    or else
-                     Is_Generic_Type (Root_Type (Prefix_Type))
+                    or else Is_Generic_Type (Root_Type (Prefix_Type))
                   then
                      Set_Original_Discriminant (Sel, Comp);
                   end if;
@@ -3102,14 +3171,15 @@ package body Sem_Ch4 is
 
       elsif Is_Concurrent_Type (Prefix_Type) then
 
-         --  Prefix is concurrent type. Find visible operation with given name
-         --  For a task, this can only include entries or discriminants if the
-         --  task type is not an enclosing scope. If it is an enclosing scope
-         --  (e.g. in an inner task) then all entities are visible, but the
-         --  prefix must denote the enclosing scope, i.e. can only be a direct
-         --  name or an expanded name.
+         --  Find visible operation with given name. For a protected type,
+         --  the possible candidates are discriminants, entries or protected
+         --  procedures. For a task type, the set can only include entries or
+         --  discriminants if the task type is not an enclosing scope. If it
+         --  is an enclosing scope (e.g. in an inner task) then all entities
+         --  are visible, but the prefix must denote the enclosing scope, i.e.
+         --  can only be a direct name or an expanded name.
 
-         Set_Etype (Sel,  Any_Type);
+         Set_Etype (Sel, Any_Type);
          In_Scope := In_Open_Scopes (Prefix_Type);
 
          while Present (Comp) loop
@@ -3117,6 +3187,21 @@ package body Sem_Ch4 is
                if Is_Overloadable (Comp) then
                   Add_One_Interp (Sel, Comp, Etype (Comp));
 
+                  --  If the prefix is tagged, the correct interpretation may
+                  --  lie in the primitive or class-wide operations of the
+                  --  type. Perform a simple conformance check to determine
+                  --  whether Try_Object_Operation should be invoked even if
+                  --  a visible entity is found.
+
+                  if Is_Tagged_Type (Prefix_Type)
+                    and then
+                      Nkind_In (Parent (N), N_Procedure_Call_Statement,
+                                            N_Function_Call)
+                    and then Has_Mode_Conformant_Spec (Comp)
+                  then
+                     Has_Candidate := True;
+                  end if;
+
                elsif Ekind (Comp) = E_Discriminant
                  or else Ekind (Comp) = E_Entry_Family
                  or else (In_Scope
@@ -3153,14 +3238,15 @@ package body Sem_Ch4 is
                    Comp = First_Private_Entity (Base_Type (Prefix_Type));
          end loop;
 
-         --  If there is no visible entry with the given name, and the task
-         --  implements an interface, check whether there is some other
-         --  primitive operation with that name.
+         --  If there is no visible entity with the given name or none of the
+         --  visible entities are plausible interpretations, check whether
+         --  there is some other primitive operation with that name.
 
          if Ada_Version >= Ada_05
            and then Is_Tagged_Type (Prefix_Type)
          then
-            if Etype (N) = Any_Type
+            if (Etype (N) = Any_Type
+                  or else not Has_Candidate)
               and then Try_Object_Operation (N)
             then
                return;
@@ -3313,7 +3399,6 @@ package body Sem_Ch4 is
       Set_Etype (N, Any_Type);
 
       if not Is_Overloaded (L) then
-
          if Root_Type (Etype (L)) = Standard_Boolean
            and then Has_Compatible_Type (R, Etype (L))
          then
@@ -3333,13 +3418,12 @@ package body Sem_Ch4 is
          end loop;
       end if;
 
-      --  Here we have failed to find an interpretation. Clearly we
-      --  know that it is not the case that both operands can have
-      --  an interpretation of Boolean, but this is by far the most
-      --  likely intended interpretation. So we simply resolve both
-      --  operands as Booleans, and at least one of these resolutions
-      --  will generate an error message, and we do not need to give
-      --  a further error message on the short circuit operation itself.
+      --  Here we have failed to find an interpretation. Clearly we know that
+      --  it is not the case that both operands can have an interpretation of
+      --  Boolean, but this is by far the most likely intended interpretation.
+      --  So we simply resolve both operands as Booleans, and at least one of
+      --  these resolutions will generate an error message, and we do not need
+      --  to give another error message on the short circuit operation itself.
 
       if Etype (N) = Any_Type then
          Resolve (L, Standard_Boolean);
@@ -3884,44 +3968,34 @@ package body Sem_Ch4 is
          return;
       end if;
 
-      Get_Name_String (Chars (Sel));
-
-      declare
-         S  : constant String (1 .. Name_Len) := Name_Buffer (1 .. Name_Len);
-
-      begin
-         Comp  := First_Entity (Prefix);
-         while Nr_Of_Suggestions <= Max_Suggestions
-            and then Present (Comp)
-         loop
-            if Is_Visible_Component (Comp) then
-               Get_Name_String (Chars (Comp));
-
-               if Is_Bad_Spelling_Of (Name_Buffer (1 .. Name_Len), S) then
-                  Nr_Of_Suggestions := Nr_Of_Suggestions + 1;
-
-                  case Nr_Of_Suggestions is
-                     when 1      => Suggestion_1 := Comp;
-                     when 2      => Suggestion_2 := Comp;
-                     when others => exit;
-                  end case;
-               end if;
+      Comp  := First_Entity (Prefix);
+      while Nr_Of_Suggestions <= Max_Suggestions and then Present (Comp) loop
+         if Is_Visible_Component (Comp) then
+            if Is_Bad_Spelling_Of (Chars (Comp), Chars (Sel)) then
+               Nr_Of_Suggestions := Nr_Of_Suggestions + 1;
+
+               case Nr_Of_Suggestions is
+                  when 1      => Suggestion_1 := Comp;
+                  when 2      => Suggestion_2 := Comp;
+                  when others => exit;
+               end case;
             end if;
+         end if;
 
-            Comp := Next_Entity (Comp);
-         end loop;
+         Comp := Next_Entity (Comp);
+      end loop;
 
-         --  Report at most two suggestions
+      --  Report at most two suggestions
 
-         if Nr_Of_Suggestions = 1 then
-            Error_Msg_NE ("\possible misspelling of&", Sel, Suggestion_1);
+      if Nr_Of_Suggestions = 1 then
+         Error_Msg_NE
+           ("\possible misspelling of&", Sel, Suggestion_1);
 
-         elsif Nr_Of_Suggestions = 2 then
-            Error_Msg_Node_2 := Suggestion_2;
-            Error_Msg_NE ("\possible misspelling of& or&",
-              Sel, Suggestion_1);
-         end if;
-      end;
+      elsif Nr_Of_Suggestions = 2 then
+         Error_Msg_Node_2 := Suggestion_2;
+         Error_Msg_NE
+           ("\possible misspelling of& or&", Sel, Suggestion_1);
+      end if;
    end Check_Misspelled_Selector;
 
    ----------------------
@@ -4548,6 +4622,81 @@ package body Sem_Ch4 is
       end if;
    end Find_Negation_Types;
 
+   ------------------------------
+   -- Find_Primitive_Operation --
+   ------------------------------
+
+   function Find_Primitive_Operation (N : Node_Id) return Boolean is
+      Obj : constant Node_Id := Prefix (N);
+      Op  : constant Node_Id := Selector_Name (N);
+
+      Prim  : Elmt_Id;
+      Prims : Elist_Id;
+      Typ   : Entity_Id;
+
+   begin
+      Set_Etype (Op, Any_Type);
+
+      if Is_Access_Type (Etype (Obj)) then
+         Typ := Designated_Type (Etype (Obj));
+      else
+         Typ := Etype (Obj);
+      end if;
+
+      if Is_Class_Wide_Type (Typ) then
+         Typ := Root_Type (Typ);
+      end if;
+
+      Prims := Primitive_Operations (Typ);
+
+      Prim := First_Elmt (Prims);
+      while Present (Prim) loop
+         if Chars (Node (Prim)) = Chars (Op) then
+            Add_One_Interp (Op, Node (Prim), Etype (Node (Prim)));
+            Set_Etype (N, Etype (Node (Prim)));
+         end if;
+
+         Next_Elmt (Prim);
+      end loop;
+
+      --  Now look for class-wide operations of the type or any of its
+      --  ancestors by iterating over the homonyms of the selector.
+
+      declare
+         Cls_Type : constant Entity_Id := Class_Wide_Type (Typ);
+         Hom      : Entity_Id;
+
+      begin
+         Hom := Current_Entity (Op);
+         while Present (Hom) loop
+            if (Ekind (Hom) = E_Procedure
+                  or else
+                Ekind (Hom) = E_Function)
+              and then Scope (Hom) = Scope (Typ)
+              and then Present (First_Formal (Hom))
+              and then
+                (Base_Type (Etype (First_Formal (Hom))) = Cls_Type
+                  or else
+                    (Is_Access_Type (Etype (First_Formal (Hom)))
+                       and then
+                         Ekind (Etype (First_Formal (Hom))) =
+                           E_Anonymous_Access_Type
+                       and then
+                         Base_Type
+                           (Designated_Type (Etype (First_Formal (Hom)))) =
+                                                                Cls_Type))
+            then
+               Add_One_Interp (Op, Hom, Etype (Hom));
+               Set_Etype (N, Etype (Hom));
+            end if;
+
+            Hom := Homonym (Hom);
+         end loop;
+      end;
+
+      return Etype (Op) /= Any_Type;
+   end Find_Primitive_Operation;
+
    ----------------------
    -- Find_Unary_Types --
    ----------------------
@@ -4744,12 +4893,7 @@ package body Sem_Ch4 is
             --  pretty much know that the other operand should be Boolean, so
             --  resolve it that way (generating an error)
 
-            elsif Nkind (N) = N_Op_And
-                    or else
-                  Nkind (N) = N_Op_Or
-                    or else
-                  Nkind (N) = N_Op_Xor
-            then
+            elsif Nkind_In (N, N_Op_And, N_Op_Or, N_Op_Xor) then
                if Etype (L) = Standard_Boolean then
                   Resolve (R, Standard_Boolean);
                   return;
@@ -4763,16 +4907,17 @@ package body Sem_Ch4 is
             --  is not the same numeric type. If it is a non-numeric type,
             --  then probably it is intended to match the other operand.
 
-            elsif Nkind (N) = N_Op_Add      or else
-                  Nkind (N) = N_Op_Divide   or else
-                  Nkind (N) = N_Op_Ge       or else
-                  Nkind (N) = N_Op_Gt       or else
-                  Nkind (N) = N_Op_Le       or else
-                  Nkind (N) = N_Op_Lt       or else
-                  Nkind (N) = N_Op_Mod      or else
-                  Nkind (N) = N_Op_Multiply or else
-                  Nkind (N) = N_Op_Rem      or else
-                  Nkind (N) = N_Op_Subtract
+            elsif Nkind_In (N, N_Op_Add,
+                               N_Op_Divide,
+                               N_Op_Ge,
+                               N_Op_Gt,
+                               N_Op_Le)
+              or else
+                  Nkind_In (N, N_Op_Lt,
+                               N_Op_Mod,
+                               N_Op_Multiply,
+                               N_Op_Rem,
+                               N_Op_Subtract)
             then
                if Is_Numeric_Type (Etype (L))
                  and then not Is_Numeric_Type (Etype (R))
@@ -4790,8 +4935,7 @@ package body Sem_Ch4 is
             --  Comparisons on A'Access are common enough to deserve a
             --  special message.
 
-            elsif (Nkind (N) = N_Op_Eq  or else
-                   Nkind (N) = N_Op_Ne)
+            elsif Nkind_In (N, N_Op_Eq, N_Op_Ne)
                and then Ekind (Etype (L)) = E_Access_Attribute_Type
                and then Ekind (Etype (R)) = E_Access_Attribute_Type
             then
@@ -4903,11 +5047,12 @@ package body Sem_Ch4 is
    -- Process_Implicit_Dereference_Prefix --
    -----------------------------------------
 
-   procedure Process_Implicit_Dereference_Prefix
+   function Process_Implicit_Dereference_Prefix
      (E : Entity_Id;
-      P : Entity_Id)
+      P : Entity_Id) return Entity_Id
    is
       Ref : Node_Id;
+      Typ : constant Entity_Id := Designated_Type (Etype (P));
 
    begin
       if Present (E)
@@ -4922,6 +5067,24 @@ package body Sem_Ch4 is
          Set_Comes_From_Source (Ref, Comes_From_Source (P));
          Generate_Reference (E, Ref);
       end if;
+
+      --  An implicit dereference is a legal occurrence of an
+      --  incomplete type imported through a limited_with clause,
+      --  if the full view is visible.
+
+      if From_With_Type (Typ)
+        and then not From_With_Type (Scope (Typ))
+        and then
+          (Is_Immediately_Visible (Scope (Typ))
+            or else
+              (Is_Child_Unit (Scope (Typ))
+                 and then Is_Visible_Child_Unit (Scope (Typ))))
+      then
+         return Available_View (Typ);
+      else
+         return Typ;
+      end if;
+
    end Process_Implicit_Dereference_Prefix;
 
    --------------------------------
@@ -5290,26 +5453,26 @@ package body Sem_Ch4 is
 
    function Try_Object_Operation (N : Node_Id) return Boolean is
       K              : constant Node_Kind  := Nkind (Parent (N));
+      Is_Subprg_Call : constant Boolean    := Nkind_In
+                                               (K, N_Procedure_Call_Statement,
+                                                   N_Function_Call);
       Loc            : constant Source_Ptr := Sloc (N);
-      Candidate      : Entity_Id := Empty;
-      Is_Subprg_Call : constant Boolean    := K = N_Procedure_Call_Statement
-                                               or else K = N_Function_Call;
       Obj            : constant Node_Id    := Prefix (N);
       Subprog        : constant Node_Id    :=
                          Make_Identifier (Sloc (Selector_Name (N)),
                            Chars => Chars (Selector_Name (N)));
       --  Identifier on which possible interpretations will be collected
 
-      Success        : Boolean := False;
-
       Report_Error : Boolean := False;
       --  If no candidate interpretation matches the context, redo the
       --  analysis with error enabled to provide additional information.
 
       Actual          : Node_Id;
+      Candidate       : Entity_Id := Empty;
       New_Call_Node   : Node_Id := Empty;
       Node_To_Replace : Node_Id;
       Obj_Type        : Entity_Id := Etype (Obj);
+      Success         : Boolean := False;
 
       function Valid_Candidate
         (Success : Boolean;
@@ -5333,9 +5496,9 @@ package body Sem_Ch4 is
         (Call_Node       : out Node_Id;
          Node_To_Replace : out Node_Id);
       --  Transform Obj.Operation (X, Y,,) into Operation (Obj, X, Y ..)
-      --  Call_Node is the resulting subprogram call,
-      --  Node_To_Replace is either N or the parent of N, and Subprog
-      --  is a reference to the subprogram we are trying to match.
+      --  Call_Node is the resulting subprogram call, Node_To_Replace is
+      --  either N or the parent of N, and Subprog is a reference to the
+      --  subprogram we are trying to match.
 
       function Try_Class_Wide_Operation
         (Call_Node       : Node_Id;
@@ -5376,14 +5539,14 @@ package body Sem_Ch4 is
             end if;
          end if;
 
-         --  If the call may be an indexed call, retrieve component type
-         --  of resulting expression, and add possible interpretation.
+         --  If the call may be an indexed call, retrieve component type of
+         --  resulting expression, and add possible interpretation.
 
          Comp_Type := Empty;
 
          if Nkind (Call) = N_Function_Call
-             and then Nkind (Parent (N)) = N_Indexed_Component
-             and then Needs_One_Actual (Subp)
+           and then Nkind (Parent (N)) = N_Indexed_Component
+           and then Needs_One_Actual (Subp)
          then
             if Is_Array_Type (Etype (Subp)) then
                Comp_Type := Component_Type (Etype (Subp));
@@ -5396,7 +5559,7 @@ package body Sem_Ch4 is
          end if;
 
          if Present (Comp_Type)
-              and then Etype (Subprog) /= Comp_Type
+           and then Etype (Subprog) /= Comp_Type
          then
             Add_One_Interp (Subprog, Subp, Comp_Type);
          end if;
@@ -5472,9 +5635,9 @@ package body Sem_Ch4 is
                  ("expect variable in call to&", Prefix (N), Entity (Subprog));
             end if;
 
-         --  Conversely, if the formal is an access parameter and the
-         --  object is not, replace the actual with a 'Access reference.
-         --   Its analysis will check that the object is aliased.
+         --  Conversely, if the formal is an access parameter and the object
+         --  is not, replace the actual with a 'Access reference. Its analysis
+         --  will check that the object is aliased.
 
          elsif Is_Access_Type (Formal_Type)
            and then not Is_Access_Type (Etype (Obj))
@@ -5563,22 +5726,21 @@ package body Sem_Ch4 is
         (Call_Node       : out Node_Id;
          Node_To_Replace : out Node_Id)
       is
-         Parent_Node : constant Node_Id := Parent (N);
-
          Dummy : constant Node_Id := New_Copy (Obj);
          --  Placeholder used as a first parameter in the call, replaced
          --  eventually by the proper object.
 
-         Actuals : List_Id;
+         Parent_Node : constant Node_Id := Parent (N);
+
          Actual  : Node_Id;
+         Actuals : List_Id;
 
       begin
          --  Common case covering 1) Call to a procedure and 2) Call to a
          --  function that has some additional actuals.
 
-         if (Nkind (Parent_Node) = N_Function_Call
-               or else
-             Nkind (Parent_Node) = N_Procedure_Call_Statement)
+         if Nkind_In (Parent_Node, N_Function_Call,
+                                   N_Procedure_Call_Statement)
 
             --  N is a selected component node containing the name of the
             --  subprogram. If N is not the name of the parent node we must
@@ -5614,7 +5776,7 @@ package body Sem_Ch4 is
 
             end if;
 
-         --  Before analysis, the function call appears as an indexed component
+         --  Before analysis, a function call appears as an indexed component
          --  if there are no named associations.
 
          elsif Nkind (Parent_Node) =  N_Indexed_Component
@@ -5637,7 +5799,7 @@ package body Sem_Ch4 is
                  Name => New_Copy (Subprog),
                  Parameter_Associations => Actuals);
 
-         --  Parameterless call:  Obj.F is rewritten as F (Obj)
+         --  Parameterless call: Obj.F is rewritten as F (Obj)
 
          else
             Node_To_Replace := N;
@@ -5666,8 +5828,8 @@ package body Sem_Ch4 is
             Error    : out Boolean);
          --  Traverse the homonym chain of the subprogram searching for those
          --  homonyms whose first formal has the Anc_Type's class-wide type,
-         --  or an anonymous access type designating the class-wide type. If an
-         --  ambiguity is detected, then Error is set to True.
+         --  or an anonymous access type designating the class-wide type. If
+         --  an ambiguity is detected, then Error is set to True.
 
          procedure Traverse_Interfaces
            (Anc_Type : Entity_Id;
@@ -5770,9 +5932,9 @@ package body Sem_Ch4 is
            (Anc_Type : Entity_Id;
             Error    : out Boolean)
          is
-            Intface      : Node_Id;
             Intface_List : constant List_Id :=
                              Abstract_Interface_List (Anc_Type);
+            Intface      : Node_Id;
 
          begin
             Error := False;
@@ -5807,10 +5969,10 @@ package body Sem_Ch4 is
       --  Start of processing for Try_Class_Wide_Operation
 
       begin
-         --  Loop through ancestor types (including interfaces), traversing the
-         --  homonym chain of the subprogram, and trying out those homonyms
-         --  whose first formal has the class-wide type of the ancestor, or an
-         --  anonymous access type designating the class-wide type.
+         --  Loop through ancestor types (including interfaces), traversing
+         --  the homonym chain of the subprogram, trying out those homonyms
+         --  whose first formal has the class-wide type of the ancestor, or
+         --  an anonymous access type designating the class-wide type.
 
          Anc_Type := Obj_Type;
          loop
@@ -5921,6 +6083,10 @@ package body Sem_Ch4 is
          --  part) because the type itself carries no primitive operations,
          --  except for formal derived types that inherit the operations of
          --  the parent and progenitors.
+         --  If the context is a generic subprogram body, the generic formals
+         --  are visible by name, but are not in the entity list of the
+         --  subprogram because that list starts with the subprogram formals.
+         --  We retrieve the candidate operations from the generic declaration.
 
          function Valid_First_Argument_Of (Op : Entity_Id) return Boolean;
          --  Verify that the prefix, dereferenced if need be, is a valid
@@ -5937,10 +6103,61 @@ package body Sem_Ch4 is
             Subp       : Entity_Id;
             Formal     : Entity_Id;
 
+            procedure Check_Candidate;
+            --  The operation is a candidate if its first parameter is a
+            --  controlling operand of the desired type.
+
+            -----------------------
+            --  Check_Candidate; --
+            -----------------------
+
+            procedure Check_Candidate is
+            begin
+               Formal := First_Formal (Subp);
+
+               if Present (Formal)
+                 and then Is_Controlling_Formal (Formal)
+                 and then
+                   (Base_Type (Etype (Formal)) = Bas
+                     or else
+                       (Is_Access_Type (Etype (Formal))
+                         and then Designated_Type (Etype (Formal)) = Bas))
+               then
+                  Append_Elmt (Subp, Candidates);
+               end if;
+            end Check_Candidate;
+
+         --  Start of processing for Collect_Generic_Type_Ops
+
          begin
             if Is_Derived_Type (T) then
                return Primitive_Operations (T);
 
+            elsif Ekind (Scope (T)) = E_Procedure
+              or else Ekind (Scope (T)) = E_Function
+            then
+               --  Scan the list of generic formals to find subprograms
+               --  that may have a first controlling formal of the type.
+
+               declare
+                  Decl : Node_Id;
+
+               begin
+                  Decl :=
+                    First (Generic_Formal_Declarations
+                            (Unit_Declaration_Node (Scope (T))));
+                  while Present (Decl) loop
+                     if Nkind (Decl) in N_Formal_Subprogram_Declaration then
+                        Subp := Defining_Entity (Decl);
+                        Check_Candidate;
+                     end if;
+
+                     Next (Decl);
+                  end loop;
+               end;
+
+               return Candidates;
+
             else
                --  Scan the list of entities declared in the same scope as
                --  the type. In general this will be an open scope, given that
@@ -5951,18 +6168,7 @@ package body Sem_Ch4 is
                Subp := First_Entity (Scope (T));
                while Present (Subp) loop
                   if Is_Overloadable (Subp) then
-                     Formal := First_Formal (Subp);
-
-                     if Present (Formal)
-                       and then Is_Controlling_Formal (Formal)
-                       and then
-                         (Base_Type (Etype (Formal)) = Bas
-                           or else
-                            (Is_Access_Type (Etype (Formal))
-                              and then Designated_Type (Etype (Formal)) = Bas))
-                     then
-                        Append_Elmt (Subp, Candidates);
-                     end if;
+                     Check_Candidate;
                   end if;
 
                   Next_Entity (Subp);
@@ -5980,12 +6186,11 @@ package body Sem_Ch4 is
             Typ : constant Entity_Id := Etype (First_Formal (Op));
 
          begin
-            --  Simple case. Object may be a subtype of the tagged type
-            --  or may be the corresponding record of a synchronized type.
+            --  Simple case. Object may be a subtype of the tagged type or
+            --  may be the corresponding record of a synchronized type.
 
             return Obj_Type = Typ
-              or else  Base_Type (Obj_Type) = Typ
-
+              or else Base_Type (Obj_Type) = Typ
               or else Corr_Type = Typ
 
                --  Prefix can be dereferenced
@@ -6005,11 +6210,11 @@ package body Sem_Ch4 is
       --  Start of processing for Try_Primitive_Operation
 
       begin
-         --  Look for subprograms in the list of primitive operations The name
+         --  Look for subprograms in the list of primitive operations. The name
          --  must be identical, and the kind of call indicates the expected
          --  kind of operation (function or procedure). If the type is a
-         --  (tagged) synchronized type, the primitive ops are attached to
-         --  the corresponding record type.
+         --  (tagged) synchronized type, the primitive ops are attached to the
+         --  corresponding record type.
 
          if Is_Concurrent_Type (Obj_Type) then
             Corr_Type := Corresponding_Record_Type (Obj_Type);
@@ -6045,9 +6250,9 @@ package body Sem_Ch4 is
                                              (Alias (Prim_Op)), Corr_Type))
                  or else
 
-               --  Do not consider hidden primitives unless the type is
-               --  in an open scope or we are within an instance, where
-               --  visibility is known to be correct.
+               --  Do not consider hidden primitives unless the type is in an
+               --  open scope or we are within an instance, where visibility
+               --  is known to be correct.
 
                   (Is_Hidden (Prim_Op)
                      and then not Is_Immediately_Visible (Obj_Type)
@@ -6077,12 +6282,11 @@ package body Sem_Ch4 is
 
                   Matching_Op := Valid_Candidate (Success, Call_Node, Prim_Op);
 
-               else
-
-                  --  More than one interpretation, collect for subsequent
-                  --  disambiguation. If this is a procedure call and there
-                  --  is another match, report ambiguity now.
+               --  More than one interpretation, collect for subsequent
+               --  disambiguation. If this is a procedure call and there
+               --  is another match, report ambiguity now.
 
+               else
                   Analyze_One_Call
                     (N          => Call_Node,
                      Nam        => Prim_Op,
@@ -6165,7 +6369,7 @@ package body Sem_Ch4 is
 
          --  The argument list is not type correct. Re-analyze with error
          --  reporting enabled, and use one of the possible candidates.
-         --  In all_errors mode, re-analyze all failed interpretations.
+         --  In All_Errors_Mode, re-analyze all failed interpretations.
 
          if All_Errors_Mode then
             Report_Error := True;
@@ -6190,7 +6394,9 @@ package body Sem_Ch4 is
                Skip_First => True);
          end if;
 
-         return True;  --  No need for further errors.
+         --  No need for further errors
+
+         return True;
 
       else
          --  There was no candidate operation, so report it as an error