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
begin
null;
end Need_Body;
type Access_T is not null access Si'Class;
task type T is new Si with
end T;
overriding
function Name (P : T) return String;
function Name (P : T) return String is
begin
return "Hej hopp ditt feta nylle";
end Name;
task body T is
begin
null;
end T;
TP : Access_T := Access_T'(new T);
I : T;
generic
S : in String;
package G is
end;
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 <schonb...@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))
then
+
+ -- 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
