This change adds missing code to enforce language restrictions for remote
access to subprogram types in the case of 'Unchecked_Access and 'Unrestricted_
Access.
The following compilation must be rejected with the given error message:
$ gcc -c server_main.adb
server_main.adb:11:35: prefix must statically denote a remote subprogram
package Queue is
pragma Remote_Call_Interface;
type Result_Callback is access procedure (Job : in Integer);
procedure Append_Job
(Job : in Integer;
Callback : in Result_Callback);
procedure Set_Result (Job : in Integer);
end Queue;
with Ada.Text_IO;
with Queue;
procedure Server_Main is
use Ada;
procedure Set_Result (Id : in Integer) is
begin
null;
end Set_Result;
begin
Text_IO.Put_Line ("Start server...");
Queue.Append_Job (1, Set_Result'Unrestricted_Access);
end Server_Main;
Tested on x86_64-pc-linux-gnu, committed on trunk
2012-05-15 Thomas Quinot <qui...@adacore.com>
* sem_res.adb (Resolve): Enforce E.2.2(11/2) and E.2.2(12) for
'Unrestricted_Access and 'Unchecked_Access (not just 'Access):
even in those cases, a remote access type may only designate a
remote subprogram.
Index: sem_res.adb
===================================================================
--- sem_res.adb (revision 187501)
+++ sem_res.adb (working copy)
@@ -1967,7 +1967,10 @@
-- Prefix (N) must statically denote a remote subprogram
-- declared in a package specification.
- if Attr = Attribute_Access then
+ if Attr = Attribute_Access or else
+ Attr = Attribute_Unchecked_Access or else
+ Attr = Attribute_Unrestricted_Access
+ then
Decl := Unit_Declaration_Node (Entity (Pref));
if Nkind (Decl) = N_Subprogram_Body then
@@ -1990,26 +1993,22 @@
("prefix must statically denote a remote subprogram ",
N);
end if;
- end if;
- -- If we are generating code for a distributed program.
- -- perform semantic checks against the corresponding
- -- remote entities.
+ -- If we are generating code in distributed mode, perform
+ -- semantic checks against corresponding remote entities.
- if (Attr = Attribute_Access or else
- Attr = Attribute_Unchecked_Access or else
- Attr = Attribute_Unrestricted_Access)
- and then Full_Expander_Active
- and then Get_PCS_Name /= Name_No_DSA
- then
- Check_Subtype_Conformant
- (New_Id => Entity (Prefix (N)),
- Old_Id => Designated_Type
- (Corresponding_Remote_Type (Typ)),
- Err_Loc => N);
+ if Full_Expander_Active
+ and then Get_PCS_Name /= Name_No_DSA
+ then
+ Check_Subtype_Conformant
+ (New_Id => Entity (Prefix (N)),
+ Old_Id => Designated_Type
+ (Corresponding_Remote_Type (Typ)),
+ Err_Loc => N);
- if Is_Remote then
- Process_Remote_AST_Attribute (N, Typ);
+ if Is_Remote then
+ Process_Remote_AST_Attribute (N, Typ);
+ end if;
end if;
end if;
end if;
