sem_ch4.adb (Transform_Object_Operation): In a context off the form V (Obj.F)...

2005-09-01  Ed Schonberg  <schonberg@adacore.com>
	    Javier Miranda  <miranda@adacore.com>

	* sem_ch4.adb (Transform_Object_Operation): In a context off the form
	V (Obj.F), the rewriting does not involve the indexed component, but
	only the selected component itself.
	Do not apply the transformation if the analyzed node is an actual of a
	call to another subprogram.
	(Complete_Object_Operation): Retain the entity of the
	dispatching operation in the selector of the rewritten node. The
	entity will be used in the expansion of dispatching selects.
	(Analyze_One_Call): Improve location of the error message associated
	with interface.
	(Analyze_Selected_Component): No need to resolve prefix when it is a
	function call, resolution is done when parent node is resolved, as
	usual.
	(Analyze_One_Call): Add a flag to suppress analysis of the first actual,
	when attempting to resolve a call transformed from its object notation.
	(Try_Object_Operation, Transform_Object_Operastion): Avoid makind copies
	of the argument list for each interpretation of the operation.
	(Try_Object_Operation): The designated type of an access parameter may
	be an incomplete type obtained through a limited_with clause, in which
	case the primitive operations of the type are retrieved from its full
	view.
	(Analyze_Call): If this is an indirect call, and the return type of the
	access_to_subprogram is incomplete, use its full view if available.

From-SVN: r103882

gcc/ada/sem_ch4.adb

@@ -25,7 +25,6 @@
 ------------------------------------------------------------------------------
 
 with Atree;    use Atree;
-with Checks;   use Checks;
 with Debug;    use Debug;
 with Einfo;    use Einfo;
 with Elists;   use Elists;
@@ -97,10 +96,11 @@ package body Sem_Ch4 is
    --  arguments, list possible interpretations.
 
    procedure Analyze_One_Call
-      (N       : Node_Id;
-       Nam     : Entity_Id;
-       Report  : Boolean;
-       Success : out Boolean);
+      (N          : Node_Id;
+       Nam        : Entity_Id;
+       Report     : Boolean;
+       Success    : out Boolean;
+       Skip_First : Boolean := False);
    --  Check one interpretation of an overloaded subprogram name for
    --  compatibility with the types of the actuals in a call. If there is a
    --  single interpretation which does not match, post error if Report is
@@ -111,6 +111,13 @@ package body Sem_Ch4 is
    --  subprogram type constructed for an access_to_subprogram. If the actuals
    --  are compatible with Nam, then Nam is added to the list of candidate
    --  interpretations for N, and Success is set to True.
+   --
+   --  The flag Skip_First is used when analyzing a call that was rewritten
+   --  from object notation. In this case the first actual may have to receive
+   --  an explicit dereference, depending on the first formal of the operation
+   --  being called. The caller will have verified that the object is legal
+   --  for the call. If the remaining parameters match, the first parameter
+   --  will rewritten as a dereference if needed, prior to completing analysis.
 
    procedure Check_Misspelled_Selector
      (Prefix : Entity_Id;
@@ -538,15 +545,6 @@ package body Sem_Ch4 is
          Check_Restriction (No_Local_Allocators, N);
       end if;
 
-      --  Ada 2005 (AI-231): Static checks
-
-      if Ada_Version >= Ada_05
-        and then (Null_Exclusion_Present (N)
-                    or else Can_Never_Be_Null (Etype (N)))
-      then
-         Null_Exclusion_Static_Checks (N);
-      end if;
-
       if Serious_Errors_Detected > Sav_Errs then
          Set_Error_Posted (N);
          Set_Etype (N, Any_Type);
@@ -780,6 +778,20 @@ package body Sem_Ch4 is
 
          Analyze_One_Call (N, Nam_Ent, True, Success);
 
+         --  If this is an indirect call, the return type of the access_to
+         --  subprogram may be an incomplete type. At the point of the call,
+         --  use the full type if available, and at the same time update
+         --  the return type of the access_to_subprogram.
+
+         if Success
+           and then  Nkind (Nam) = N_Explicit_Dereference
+           and then Ekind (Etype (N)) = E_Incomplete_Type
+           and then Present (Full_View (Etype (N)))
+         then
+            Set_Etype (N, Full_View (Etype (N)));
+            Set_Etype (Nam_Ent, Etype (N));
+         end if;
+
       else
          --  An overloaded selected component must denote overloaded
          --  operations of a concurrent type. The interpretations are
@@ -1918,10 +1930,11 @@ package body Sem_Ch4 is
    ----------------------
 
    procedure Analyze_One_Call
-      (N       : Node_Id;
-       Nam     : Entity_Id;
-       Report  : Boolean;
-       Success : out Boolean)
+      (N          : Node_Id;
+       Nam        : Entity_Id;
+       Report     : Boolean;
+       Success    : out Boolean;
+       Skip_First : Boolean := False)
    is
       Actuals    : constant List_Id   := Parameter_Associations (N);
       Prev_T     : constant Entity_Id := Etype (N);
@@ -2104,6 +2117,16 @@ package body Sem_Ch4 is
 
          Actual := First_Actual (N);
          Formal := First_Formal (Nam);
+
+         --  If we are analyzing a call rewritten from object notation,
+         --  skip first actual, which may be rewritten later as an
+         --  explicit dereference.
+
+         if Skip_First then
+            Next_Actual (Actual);
+            Next_Formal (Formal);
+         end if;
+
          while Present (Actual) and then Present (Formal) loop
             if Nkind (Parent (Actual)) /= N_Parameter_Association
               or else Chars (Selector_Name (Parent (Actual))) = Chars (Formal)
@@ -2134,10 +2157,8 @@ package body Sem_Ch4 is
                                       (Typ   => Etype (Actual),
                                        Iface => Etype (Etype (Formal)))
                      then
-                        Error_Msg_Name_1 := Chars (Actual);
-                        Error_Msg_Name_2 := Chars (Etype (Etype (Formal)));
                         Error_Msg_NE
-                          ("(Ada 2005) % does not implement interface %",
+                          ("(Ada 2005) does not implement interface }",
                            Actual, Etype (Etype (Formal)));
                      end if;
 
@@ -2557,17 +2578,6 @@ package body Sem_Ch4 is
          return;
 
       else
-         --  Function calls that are prefixes of selected components must be
-         --  fully resolved in case we need to build an actual subtype, or
-         --  do some other operation requiring a fully resolved prefix.
-
-         --  Note: Resolving all Nkinds of nodes here doesn't work.
-         --  (Breaks 2129-008) ???.
-
-         if Nkind (Name) = N_Function_Call then
-            Resolve (Name);
-         end if;
-
          Prefix_Type := Etype (Name);
       end if;
 
@@ -4845,9 +4855,7 @@ package body Sem_Ch4 is
       Subprog         : constant Node_Id    := Selector_Name (N);
 
       Actual          : Node_Id;
-      Call_Node       : Node_Id;
-      Call_Node_Case  : Node_Id := Empty;
-      First_Actual    : Node_Id;
+      New_Call_Node  :  Node_Id := Empty;
       Node_To_Replace : Node_Id;
       Obj_Type        : Entity_Id := Etype (Obj);
 
@@ -4855,31 +4863,30 @@ package body Sem_Ch4 is
         (Call_Node       : Node_Id;
          Node_To_Replace : Node_Id;
          Subprog         : Node_Id);
-      --  Set Subprog as the name of Call_Node, replace Node_To_Replace with
-      --  Call_Node and reanalyze Node_To_Replace.
+      --  Make Subprog the name of Call_Node, replace Node_To_Replace with
+      --  Call_Node, insert the object (or its dereference) as the first actual
+      --  in the call, and complete the analysis of the call.
 
       procedure Transform_Object_Operation
         (Call_Node       : out Node_Id;
-         First_Actual    : Node_Id;
          Node_To_Replace : out Node_Id;
          Subprog         : Node_Id);
-      --  Transform Object.Operation (...) to Operation (Object, ...)
-      --  Call_Node is the resulting subprogram call node, First_Actual is
-      --  either the object Obj or an explicit dereference of Obj in certain
-      --  cases, Node_To_Replace is either N or the parent of N, and Subprog
-      --  is the subprogram we are trying to match.
+      --  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.
 
       function Try_Class_Wide_Operation
         (Call_Node       : Node_Id;
          Node_To_Replace : Node_Id) return Boolean;
-      --  Traverse all the ancestor types looking for a class-wide subprogram
-      --  that matches Subprog.
+      --  Traverse all ancestor types looking for a class-wide subprogram
+      --  for which the current operation is a valid non-dispatching call.
 
       function Try_Primitive_Operation
         (Call_Node       : Node_Id;
          Node_To_Replace : Node_Id) return Boolean;
-      --  Traverse the list of primitive subprograms looking for a subprogram
-      --  than matches Subprog.
+      --  Traverse the list of primitive subprograms looking for a dispatching
+      --  operation for which the current node is a valid call .
 
       -------------------------------
       -- Complete_Object_Operation --
@@ -4890,9 +4897,30 @@ package body Sem_Ch4 is
          Node_To_Replace : Node_Id;
          Subprog         : Node_Id)
       is
+         First_Actual : Node_Id;
+
       begin
-         Set_Name (Call_Node, New_Copy_Tree (Subprog));
-         Set_Analyzed (Call_Node, False);
+         First_Actual := First (Parameter_Associations (Call_Node));
+         Set_Name (Call_Node, Subprog);
+
+         if Nkind (N) = N_Selected_Component
+           and then not Inside_A_Generic
+         then
+            Set_Entity (Selector_Name (N), Entity (Subprog));
+         end if;
+
+         --  If need be, rewrite first actual as an explicit dereference
+
+         if not Is_Access_Type (Etype (First_Formal (Entity (Subprog))))
+           and then Is_Access_Type (Etype (Obj))
+         then
+            Rewrite (First_Actual,
+              Make_Explicit_Dereference (Sloc (Obj), Obj));
+            Analyze (First_Actual);
+         else
+            Rewrite (First_Actual, Obj);
+         end if;
+
          Rewrite (Node_To_Replace, Call_Node);
          Analyze (Node_To_Replace);
       end Complete_Object_Operation;
@@ -4903,51 +4931,45 @@ package body Sem_Ch4 is
 
       procedure Transform_Object_Operation
         (Call_Node       : out Node_Id;
-         First_Actual    : Node_Id;
          Node_To_Replace : out Node_Id;
          Subprog         : Node_Id)
       is
-         Actuals     : List_Id;
          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;
+         Actual  : Node_Id;
+
       begin
-         Actuals := New_List (New_Copy_Tree (First_Actual));
+         --  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)
 
-            --  Avoid recursive calls
+            --  N is a selected component node containing the name of the
+            --  subprogram. If N is not the name of the parent node we must
+            --  not replace the parent node by the new construct. This case
+            --  occurs when N is a parameterless call to a subprogram that
+            --  is an actual parameter of a call to another subprogram. For
+            --  example:
+            --            Some_Subprogram (..., Obj.Operation, ...)
 
-           and then N /= First (Parameter_Associations (Parent_Node))
+            and then Name (Parent_Node) = N
          then
             Node_To_Replace := Parent_Node;
 
-            --  Copy list of actuals in full before attempting to resolve call.
-            --  This is necessary to ensure that the chaining of named actuals
-            --  that happens during matching is done on a separate copy.
-
-            declare
-               Actual : Node_Id;
-            begin
-               Actual := First (Parameter_Associations (Parent_Node));
-               while Present (Actual) loop
-                  declare
-                     New_Actual : constant Node_Id := New_Copy_Tree (Actual);
-
-                  begin
-                     Append (New_Actual, Actuals);
-
-                     if Nkind (Actual) = N_Function_Call
-                       and then Is_Overloaded (Name (Actual))
-                     then
-                        Save_Interps (Name (Actual), Name (New_Actual));
-                     end if;
-                  end;
+            Actuals := Parameter_Associations (Parent_Node);
 
-                  Next (Actual);
-               end loop;
-            end;
+            if Present (Actuals) then
+               Prepend (Dummy, Actuals);
+            else
+               Actuals := New_List (Dummy);
+            end if;
 
             if Nkind (Parent_Node) = N_Procedure_Call_Statement then
                Call_Node :=
@@ -4956,8 +4978,6 @@ package body Sem_Ch4 is
                    Parameter_Associations => Actuals);
 
             else
-               pragma Assert (Nkind (Parent_Node) = N_Function_Call);
-
                Call_Node :=
                  Make_Function_Call (Loc,
                    Name => New_Copy_Tree (Subprog),
@@ -4965,31 +4985,30 @@ package body Sem_Ch4 is
 
             end if;
 
-         --  Before analysis, the function call appears as an
-         --  indexed component.
+         --  Before analysis, the function call appears as an indexed component
+         --  if there are no named associations.
 
-         elsif Nkind (Parent_Node) =  N_Indexed_Component then
+         elsif Nkind (Parent_Node) =  N_Indexed_Component
+           and then N = Prefix (Parent_Node)
+         then
             Node_To_Replace := Parent_Node;
 
-            declare
-               Actual : Node_Id;
-               New_Act : Node_Id;
-            begin
-               Actual := First (Expressions (Parent_Node));
-               while Present (Actual) loop
-                  New_Act := New_Copy_Tree (Actual);
-                  Analyze (New_Act);
-                  Append (New_Act, Actuals);
-                  Next (Actual);
-               end loop;
-            end;
+            Actuals := Expressions (Parent_Node);
+
+            Actual := First (Actuals);
+            while Present (Actual) loop
+               Analyze (Actual);
+               Next (Actual);
+            end loop;
+
+            Prepend (Dummy, Actuals);
 
             Call_Node :=
                Make_Function_Call (Loc,
                  Name => New_Copy_Tree (Subprog),
                  Parameter_Associations => Actuals);
 
-         --  Parameterless call
+         --  Parameterless call:  Obj.F is rewritten as F (Obj)
 
          else
             Node_To_Replace := N;
@@ -4997,7 +5016,7 @@ package body Sem_Ch4 is
             Call_Node :=
                Make_Function_Call (Loc,
                  Name => New_Copy_Tree (Subprog),
-                 Parameter_Associations => Actuals);
+                 Parameter_Associations => New_List (Dummy));
          end if;
       end Transform_Object_Operation;
 
@@ -5010,16 +5029,20 @@ package body Sem_Ch4 is
          Node_To_Replace : Node_Id) return Boolean
       is
          Anc_Type : Entity_Id;
-         Dummy    : Node_Id;
          Hom      : Entity_Id;
          Hom_Ref  : Node_Id;
          Success  : Boolean;
 
       begin
-         --  Loop through ancestor types, traverse their homonym chains and
-         --  gather all interpretations of the subprogram.
+         --  Loop through ancestor types, traverse the homonym chain of the
+         --  subprogram, and try out those homonyms whose first formal has the
+         --  class-wide type of the ancestor.
+
+         --  Should we verify that it is declared in the same package as the
+         --  ancestor type ???
 
          Anc_Type := Obj_Type;
+
          loop
             Hom := Current_Entity (Subprog);
             while Present (Hom) loop
@@ -5032,79 +5055,42 @@ package body Sem_Ch4 is
                then
                   Hom_Ref := New_Reference_To (Hom, Loc);
 
-                  --  When both the type of the object and the type of the
-                  --  first formal of the primitive operation are tagged
-                  --  access types, we use a node with the object as first
-                  --  actual.
-
-                  if Is_Access_Type (Etype (Obj))
-                    and then Ekind (Etype (First_Formal (Hom))) =
-                               E_Anonymous_Access_Type
-                  then
-                     --  Allocate the node only once
-
-                     if not Present (Call_Node_Case) then
-                        Analyze_Expression (Obj);
-                        Set_Analyzed       (Obj);
-
-                        Transform_Object_Operation (
-                          Call_Node       => Call_Node_Case,
-                          First_Actual    => Obj,
-                          Node_To_Replace => Dummy,
-                          Subprog         => Subprog);
-
-                        Set_Etype (Call_Node_Case, Any_Type);
-                        Set_Parent (Call_Node_Case, Parent (Node_To_Replace));
-                     end if;
-
-                     Set_Name (Call_Node_Case, Hom_Ref);
-
-                     Analyze_One_Call (
-                       N       => Call_Node_Case,
-                       Nam     => Hom,
-                       Report  => False,
-                       Success => Success);
-
-                     if Success then
-                        Complete_Object_Operation (
-                          Call_Node       => Call_Node_Case,
-                          Node_To_Replace => Node_To_Replace,
-                          Subprog         => Hom_Ref);
+                  Set_Etype (Call_Node, Any_Type);
+                  Set_Parent (Call_Node, Parent (Node_To_Replace));
 
-                        return True;
-                     end if;
+                  Set_Name (Call_Node, Hom_Ref);
 
-                  --  ??? comment required
+                  Analyze_One_Call
+                    (N          => Call_Node,
+                     Nam        => Hom,
+                     Report     => False,
+                     Success    => Success,
+                     Skip_First => True);
 
-                  else
-                     Set_Name (Call_Node, Hom_Ref);
+                  if Success then
 
-                     Analyze_One_Call (
-                       N       => Call_Node,
-                       Nam     => Hom,
-                       Report  => False,
-                       Success => Success);
+                     --  Reformat into the proper call
 
-                     if Success then
-                        Complete_Object_Operation (
-                          Call_Node       => Call_Node,
-                          Node_To_Replace => Node_To_Replace,
-                          Subprog         => Hom_Ref);
+                     Complete_Object_Operation
+                       (Call_Node       => Call_Node,
+                        Node_To_Replace => Node_To_Replace,
+                        Subprog         => Hom_Ref);
 
-                        return True;
-                     end if;
+                     return True;
                   end if;
                end if;
 
                Hom := Homonym (Hom);
             end loop;
 
-            --  Climb to ancestor type if there is one
+            --  Examine other ancestor types
 
             exit when Etype (Anc_Type) = Anc_Type;
             Anc_Type := Etype (Anc_Type);
          end loop;
 
+         --  Nothing matched
+
          return False;
       end Try_Class_Wide_Operation;
 
@@ -5116,84 +5102,76 @@ package body Sem_Ch4 is
         (Call_Node       : Node_Id;
          Node_To_Replace : Node_Id) return Boolean
       is
-         Dummy       : Node_Id;
          Elmt        : Elmt_Id;
          Prim_Op     : Entity_Id;
          Prim_Op_Ref : Node_Id;
          Success     : Boolean;
 
-      begin
-         --  Look for the subprogram in the list of primitive operations
+         function Valid_First_Argument_Of (Op : Entity_Id) return Boolean;
+         --  Verify that the prefix, dereferenced if need be, is a valid
+         --  controlling argument in a call to Op. The remaining actuals
+         --  are checked in the subsequent call to Analyze_One_Call.
 
-         Elmt := First_Elmt (Primitive_Operations (Obj_Type));
-         while Present (Elmt) loop
-            Prim_Op := Node (Elmt);
+         -----------------------------
+         -- Valid_First_Argument_Of --
+         -----------------------------
 
-            if Chars (Prim_Op) = Chars (Subprog)
-              and then Present (First_Formal (Prim_Op))
-            then
-               Prim_Op_Ref := New_Reference_To (Prim_Op, Loc);
+         function Valid_First_Argument_Of (Op : Entity_Id) return Boolean is
+            Typ : constant Entity_Id := Etype (First_Formal (Op));
 
-               --  When both the type of the object and the type of the first
-               --  formal of the primitive operation are tagged access types,
-               --  we use a node with the object as first actual.
+         begin
+            --  Simple case
 
-               if Is_Access_Type (Etype (Obj))
-                 and then Ekind (Etype (First_Formal (Prim_Op))) =
-                            E_Anonymous_Access_Type
-               then
-                  --  Allocate the node only once
+            return Base_Type (Obj_Type) = Typ
 
-                  if not Present (Call_Node_Case) then
-                     Analyze_Expression (Obj);
-                     Set_Analyzed       (Obj);
+            --  Prefix can be dereferenced
 
-                     Transform_Object_Operation (
-                       Call_Node       => Call_Node_Case,
-                       First_Actual    => Obj,
-                       Node_To_Replace => Dummy,
-                       Subprog         => Subprog);
+              or else
+                (Is_Access_Type (Obj_Type)
+                  and then Designated_Type (Obj_Type) = Typ)
 
-                     Set_Etype (Call_Node_Case, Any_Type);
-                     Set_Parent (Call_Node_Case, Parent (Node_To_Replace));
-                  end if;
+            --  Formal is an access parameter, for which the object
+            --  can provide an access.
 
-                  Set_Name (Call_Node_Case, Prim_Op_Ref);
+              or else
+                (Ekind (Typ) = E_Anonymous_Access_Type
+                  and then Designated_Type (Typ) = Obj_Type);
+         end Valid_First_Argument_Of;
 
-                  Analyze_One_Call (
-                    N       => Call_Node_Case,
-                    Nam     => Prim_Op,
-                    Report  => False,
-                    Success => Success);
+      --  Start of processing for Try_Primitive_Operation
 
-                  if Success then
-                     Complete_Object_Operation (
-                       Call_Node       => Call_Node_Case,
-                       Node_To_Replace => Node_To_Replace,
-                       Subprog         => Prim_Op_Ref);
+      begin
+         --  Look for the subprogram in the list of primitive operations
 
-                     return True;
-                  end if;
+         Elmt := First_Elmt (Primitive_Operations (Obj_Type));
+         while Present (Elmt) loop
+            Prim_Op := Node (Elmt);
+
+            if Chars (Prim_Op) = Chars (Subprog)
+              and then Present (First_Formal (Prim_Op))
+              and then Valid_First_Argument_Of (Prim_Op)
+            then
+               Prim_Op_Ref := New_Reference_To (Prim_Op, Loc);
 
-               --  Comment required ???
+               Set_Etype (Call_Node, Any_Type);
+               Set_Parent (Call_Node, Parent (Node_To_Replace));
 
-               else
-                  Set_Name (Call_Node, Prim_Op_Ref);
+               Set_Name (Call_Node, Prim_Op_Ref);
 
-                  Analyze_One_Call (
-                    N       => Call_Node,
-                    Nam     => Prim_Op,
-                    Report  => False,
-                    Success => Success);
+               Analyze_One_Call
+                 (N          => Call_Node,
+                  Nam        => Prim_Op,
+                  Report     => False,
+                  Success    => Success,
+                  Skip_First => True);
 
-                  if Success then
-                     Complete_Object_Operation (
-                       Call_Node       => Call_Node,
-                       Node_To_Replace => Node_To_Replace,
-                       Subprog         => Prim_Op_Ref);
+               if Success then
+                  Complete_Object_Operation
+                    (Call_Node       => Call_Node,
+                     Node_To_Replace => Node_To_Replace,
+                     Subprog         => Prim_Op_Ref);
 
-                     return True;
-                  end if;
+                  return True;
                end if;
             end if;
 
@@ -5218,7 +5196,21 @@ package body Sem_Ch4 is
          Obj_Type := Etype (Class_Wide_Type (Obj_Type));
       end if;
 
-      --  Analyze the actuals in case of subprogram call
+      --  The type may have be obtained through a limited_with clause,
+      --  in which case the primitive operations are available on its
+      --  non-limited view.
+
+      if Ekind (Obj_Type) = E_Incomplete_Type
+        and then From_With_Type (Obj_Type)
+      then
+         Obj_Type := Non_Limited_View (Obj_Type);
+      end if;
+
+      if not Is_Tagged_Type (Obj_Type) then
+         return False;
+      end if;
+
+      --  Analyze the actuals if node is know to be a subprogram call
 
       if Is_Subprg_Call and then N = Name (Parent (N)) then
          Actual := First (Parameter_Associations (Parent (N)));
@@ -5228,38 +5220,28 @@ package body Sem_Ch4 is
          end loop;
       end if;
 
-      --  If the object is of an Access type, explicit dereference is
-      --  required.
-
-      if Is_Access_Type (Etype (Obj)) then
-         First_Actual :=
-           Make_Explicit_Dereference (Sloc (Obj), Obj);
-         Set_Etype (First_Actual, Obj_Type);
-      else
-         First_Actual := Obj;
-      end if;
-
-      Analyze_Expression (First_Actual);
-      Set_Analyzed       (First_Actual);
+      Analyze_Expression (Obj);
 
-      --  Build a subprogram call node
+      --  Build a subprogram call node, using a copy of Obj as its first
+      --  actual. This is a placeholder, to be replaced by an explicit
+      --  dereference when needed.
 
-      Transform_Object_Operation (
-        Call_Node       => Call_Node,
-        First_Actual    => First_Actual,
-        Node_To_Replace => Node_To_Replace,
-        Subprog         => Subprog);
+      Transform_Object_Operation
+        (Call_Node       => New_Call_Node,
+         Node_To_Replace => Node_To_Replace,
+         Subprog         => Subprog);
 
-      Set_Etype (Call_Node, Any_Type);
-      Set_Parent (Call_Node, Parent (Node_To_Replace));
+      Set_Etype (New_Call_Node, Any_Type);
+      Set_Parent (New_Call_Node, Parent (Node_To_Replace));
 
       return
          Try_Primitive_Operation
-           (Call_Node       => Call_Node,
+           (Call_Node       => New_Call_Node,
             Node_To_Replace => Node_To_Replace)
+
         or else
          Try_Class_Wide_Operation
-           (Call_Node       => Call_Node,
+           (Call_Node       => New_Call_Node,
             Node_To_Replace => Node_To_Replace);
    end Try_Object_Operation;