Patchwork [Ada] Missing DSA remote access to subprogram rules enforcement

login
register
mail settings
Submitter Arnaud Charlet
Date May 15, 2012, 10:22 a.m.
Message ID <20120515102222.GA13473@adacore.com>
Download mbox | patch
Permalink /patch/159284/
State New
Headers show

Comments

Arnaud Charlet - May 15, 2012, 10:22 a.m.
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  <quinot@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.

Patch

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;