Comments
Patch
===================================================================
@@ -223,10 +223,6 @@
-- reference to the object itself, and the call becomes a call to the
-- corresponding protected subprogram.
- function Is_Null_Procedure (Subp : Entity_Id) return Boolean;
- -- Predicate to recognize stubbed procedures and null procedures, which
- -- can be inlined unconditionally in all cases.
-
procedure Expand_Simple_Function_Return (N : Node_Id);
-- Expand simple return from function. In the case where we are returning
-- from a function body this is called by Expand_N_Simple_Return_Statement.
===================================================================
@@ -119,6 +119,10 @@
-- that requires handling as a build-in-place call or is a qualified
-- expression applied to such a call; otherwise returns False.
+ function Is_Null_Procedure (Subp : Entity_Id) return Boolean;
+ -- Predicate to recognize stubbed procedures and null procedures, which
+ -- can be inlined unconditionally in all cases.
+
procedure Make_Build_In_Place_Call_In_Allocator
(Allocator : Node_Id;
Function_Call : Node_Id);
===================================================================
@@ -6362,7 +6362,19 @@
end if;
end if;
- if not Has_Completion (E) then
+ -- Ada 2012 (AI05-0165): For internally generated bodies of
+ -- null procedures locate the internally generated spec. We
+ -- enforce mode conformance since a tagged type may inherit
+ -- from interfaces several null primitives which differ only
+ -- in the mode of the formals.
+
+ if not (Comes_From_Source (E))
+ and then Is_Null_Procedure (E)
+ and then not Mode_Conformant (Designator, E)
+ then
+ null;
+
+ elsif not Has_Completion (E) then
if Nkind (N) /= N_Subprogram_Body_Stub then
Set_Corresponding_Spec (N, E);
end if;
@@ -7037,6 +7049,30 @@
Iface : constant Entity_Id := Find_Dispatching_Type (Iface_Prim);
Typ : constant Entity_Id := Find_Dispatching_Type (Prim);
+ function Controlling_Formal (Prim : Entity_Id) return Entity_Id;
+ -- Return the controlling formal of Prim
+
+ function Controlling_Formal (Prim : Entity_Id) return Entity_Id is
+ E : Entity_Id := First_Entity (Prim);
+ begin
+ while Present (E) loop
+ if Is_Formal (E) and then Is_Controlling_Formal (E) then
+ return E;
+ end if;
+
+ Next_Entity (E);
+ end loop;
+
+ return Empty;
+ end Controlling_Formal;
+
+ -- Local variables
+
+ Iface_Ctrl_F : constant Entity_Id := Controlling_Formal (Iface_Prim);
+ Prim_Ctrl_F : constant Entity_Id := Controlling_Formal (Prim);
+
+ -- Start of processing for Is_Interface_Conformant
+
begin
pragma Assert (Is_Subprogram (Iface_Prim)
and then Is_Subprogram (Prim)
@@ -7060,9 +7096,18 @@
then
return False;
- -- Case of a procedure, or a function that does not have a controlling
- -- result (I or access I).
+ -- The mode of the controlling formals must match
+ elsif Present (Iface_Ctrl_F)
+ and then Present (Prim_Ctrl_F)
+ and then Ekind (Iface_Ctrl_F) /= Ekind (Prim_Ctrl_F)
+ then
+ return False;
+
+ -- Case of a procedure, or a function whose result type matches the
+ -- result type of the interface primitive, or a function that has no
+ -- controlling result (I or access I).
+
elsif Ekind (Iface_Prim) = E_Procedure
or else Etype (Prim) = Etype (Iface_Prim)
or else not Has_Controlling_Result (Prim)
@@ -8254,6 +8299,18 @@
if Scope (E) /= Current_Scope then
null;
+ -- Ada 2012 (AI05-0165): For internally generated bodies of
+ -- null procedures locate the internally generated spec. We
+ -- enforce mode conformance since a tagged type may inherit
+ -- from interfaces several null primitives which differ only
+ -- in the mode of the formals.
+
+ elsif not Comes_From_Source (S)
+ and then Is_Null_Procedure (S)
+ and then not Mode_Conformant (E, S)
+ then
+ null;
+
-- Check if we have type conformance
elsif Type_Conformant (E, S) then
In Ada 2012 it is possible to inherit non-conformant homographs, but they can't be called or overridden. The following test now compiles silently. package Pack1 is type Int1 is interface; procedure Op (X : in Int1) is null; end Pack1; package Pack2 is type Int2 is interface; procedure Op (Y : in out Int2) is null; end Pack2; with Pack1; with Pack2; package Pack3 is type Typ3 is new Pack1.Int1 and Pack2.Int2 with record F1 : Integer; end record; end Pack3; Tested on x86_64-pc-linux-gnu, committed on trunk 2011-08-29 Javier Miranda <miranda@adacore.com> * exp_ch6.ads, exp_ch6.adb (Is_Null_Procedure): Move the spec of this function to the package spec. * sem_ch6.adb (Find_Corresponding_Spec, New_Overloaded_Entity): For internally generated bodies of null procedures locate the internally generated spec enforcing mode conformance. (Is_Interface_Conformant): Ensure that the controlling formal of the primitives match.