[Ada] Prefixed calls as generic actuals

Message ID 20110830131224.GA8822@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Aug. 30, 2011, 1:12 p.m.
Generic actuals are pre-analyzed in order to capture external names, but are
only fully analyzed within the instance. If an actual is a prefixed call to a
dispatching operation, it may appear syntactically as a call without actuals.
It is necessary to parse it as an object.operation again in order to capture
the controlling first argument in the call.

The following must compile quietly:

    gcc -c -gnat05 synch.adb

package Synch is
   type Si is synchronized interface;
   function Name (P : Si) return String is abstract;
   procedure Need_Body;
end Synch;
package body Synch is

   procedure Need_Body is
   end Need_Body;

   type Access_T is not null access Si'Class;

   task type T is new Si with
   end T;

   function Name (P : T) return String;

   function Name (P : T) return String is
      return "Hej hopp ditt feta nylle";
   end Name;

   task body T is
   end T;

   TP : Access_T := Access_T'(new T);

   I : T;

      S : in String;
   package G is

   S1 : constant String := TP.Name;
   S2 : constant String := TP.all.Name;
   S3 : constant String := I.Name;

   package Works_Fine_1 is new G (S => S1);
   package Works_Fine_2 is new G (S => I.Name);

   package Trouble_1 is new G (S => TP.Name);
   package Trouble_2 is new G (S => TP.all.Name);
end Synch;

Tested on x86_64-pc-linux-gnu, committed on trunk

2011-08-30  Ed Schonberg  <schonberg@adacore.com>

	* sem_res.adb (Check_Parameterless_Call): If the node is a selected
	component and the selector is a dispatching operation, check if it is
	a prefixed call before rewriting as a parameterless function call.


Index: sem_res.adb
--- sem_res.adb	(revision 178293)
+++ sem_res.adb	(working copy)
@@ -1115,6 +1115,20 @@ 
          if Nkind (Parent (N)) /= N_Function_Call
            or else N /= Name (Parent (N))
+            --  This may be a prefixed call that was not fully analyzed, e.g.
+            --  an actual in an instance.
+            if Ada_Version >= Ada_2005
+              and then Nkind (N) = N_Selected_Component
+              and then Is_Dispatching_Operation (Entity (Selector_Name (N)))
+            then
+               Analyze_Selected_Component (N);
+               if Nkind (N) /= N_Selected_Component then
+                  return;
+               end if;
+            end if;
             Nam := New_Copy (N);
             --  If overloaded, overload set belongs to new copy