Enforce rule from E.2.3(14/3): the return type of an RCI function
must support external streaming; per 13.13.2(52/3) an anonymous access
type does not support external streaming.

The following code is illegal and must be rejected:

$ gcc -c rci_func_return_anon_access.adb
rci_func_return_anon_access.ads:3:04: function in RCI unit cannot
   have access result

package rci_func_return_anon_access is
   pragma Remote_Call_Interface;
   function F return access Integer;
end rci_func_return_anon_access;
package body rci_func_return_anon_access is
   X : aliased Integer;

   function F return access Integer is
   begin
      return X'Access;
   end F;
end rci_func_return_anon_access;

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

2015-01-06  Thomas Quinot  <qui...@adacore.com>

        * sem_cat.adb (In_RCI_Declaration): Remove unnecessary
        parameter and rename to...
        (In_RCI_Visible_Declarations): Fix handling of private part of nested
        package.
        (Validate_RCI_Subprogram_Declaration): Reject illegal function
        returning anonymous access in RCI unit.

Index: sem_cat.adb
===================================================================
--- sem_cat.adb (revision 219191)
+++ sem_cat.adb (working copy)
@@ -86,10 +86,10 @@
    --  Return True if the entity or one of its subcomponents does not support
    --  external streaming.
 
-   function In_RCI_Declaration (N : Node_Id) return Boolean;
-   --  Determines if a declaration is  within the visible part of a Remote
-   --  Call Interface compilation unit, for semantic checking purposes only
-   --  (returns false within an instance and within the package body).
+   function In_RCI_Visible_Declarations return Boolean;
+   --  Determines if the visible part of a remote call interface library unit
+   --  is being compiled, for semantic checking purposes (returns False within
+   --  an instance and within the package body).
 
    function In_RT_Declaration return Boolean;
    --  Determines if current scope is within the declaration of a Remote Types
@@ -544,31 +544,40 @@
       return Is_Pure (Current_Scope);
    end In_Pure_Unit;
 
-   ------------------------
-   -- In_RCI_Declaration --
-   ------------------------
+   ---------------------------------
+   -- In_RCI_Visible_Declarations --
+   ---------------------------------
 
-   function In_RCI_Declaration (N : Node_Id) return Boolean is
-      Unit_Entity : constant Entity_Id := Current_Scope;
+   function In_RCI_Visible_Declarations return Boolean is
+      Unit_Entity : Entity_Id := Current_Scope;
       Unit_Kind   : constant Node_Kind :=
                       Nkind (Unit (Cunit (Current_Sem_Unit)));
 
    begin
-      --  There are no restrictions on the private part or body
-      --  of an RCI unit.
+      --  There are no restrictions on the private part or body of an RCI unit
 
-      return Is_Remote_Call_Interface (Unit_Entity)
+      if not (Is_Remote_Call_Interface (Unit_Entity)
         and then Is_Package_Or_Generic_Package (Unit_Entity)
         and then Unit_Kind /= N_Package_Body
-        and then List_Containing (N) =
-                   Visible_Declarations (Package_Specification (Unit_Entity))
-        and then not In_Package_Body (Unit_Entity)
-        and then not In_Instance;
+        and then not In_Instance)
+      then
+         return False;
+      end if;
 
-      --  What about the case of a nested package in the visible part???
-      --  This case is missed by the List_Containing check above???
-   end In_RCI_Declaration;
+      while Unit_Entity /= Standard_Standard loop
+         if In_Private_Part (Unit_Entity) then
+            return False;
+         end if;
 
+         Unit_Entity := Scope (Unit_Entity);
+      end loop;
+
+      --  Here if in RCI declaration, and not in private part of any open
+      --  scope.
+
+      return True;
+   end In_RCI_Visible_Declarations;
+
    -----------------------
    -- In_RT_Declaration --
    -----------------------
@@ -1371,7 +1380,7 @@
       --  The visible part of an RCI library unit must not contain the
       --  declaration of a variable (RM E.1.3(9))
 
-      elsif In_RCI_Declaration (N) then
+      elsif In_RCI_Visible_Declarations then
          Error_Msg_N ("visible variable not allowed in 'R'C'I unit", N);
 
       --  The visible part of a Shared Passive library unit must not contain
@@ -1609,7 +1618,7 @@
       --    1. from Analyze_Subprogram_Declaration.
       --    2. from Validate_Object_Declaration (access to subprogram).
 
-      if not (Comes_From_Source (N) and then In_RCI_Declaration (N)) then
+      if not (Comes_From_Source (N) and then In_RCI_Visible_Declarations) then
          return;
       end if;
 
@@ -1652,12 +1661,10 @@
 
                --  Report error only if declaration is in source program
 
-               if Comes_From_Source
-                 (Defining_Entity (Specification (N)))
-               then
+               if Comes_From_Source (Id) then
                   Error_Msg_N
                     ("subprogram in 'R'C'I unit cannot have access parameter",
-                      Error_Node);
+                     Error_Node);
                end if;
 
             --  For a limited private type parameter, we check only the private
@@ -1680,8 +1687,15 @@
 
             Next (Param_Spec);
          end loop;
+      end if;
 
-         --  No check on return type???
+      if Ekind (Id) = E_Function
+        and then Ekind (Etype (Id)) = E_Anonymous_Access_Type
+        and then Comes_From_Source (Id)
+      then
+         Error_Msg_N
+           ("function in 'R'C'I unit cannot have access result",
+             Error_Node);
       end if;
    end Validate_RCI_Subprogram_Declaration;
 
@@ -1698,8 +1712,8 @@
       --  the given node is N_Access_To_Object_Definition.
 
       if not Comes_From_Source (T)
-        or else (not In_RCI_Declaration (Parent (T))
-                  and then not In_RT_Declaration)
+        or else (not In_RCI_Visible_Declarations
+                   and then not In_RT_Declaration)
       then
          return;
       end if;
@@ -1721,7 +1735,7 @@
       if Ekind (T) /= E_General_Access_Type
         or else not Is_Class_Wide_Type (Designated_Type (T))
       then
-         if In_RCI_Declaration (Parent (T)) then
+         if In_RCI_Visible_Declarations then
             Error_Msg_N
               ("error in access type in Remote_Call_Interface unit", T);
          else

Reply via email to