diff mbox series

[Ada] Fix handling of access-to-variable objects in Global and Depends

Message ID 20210504095222.GA90470@adacore.com
State New
Headers show
Series [Ada] Fix handling of access-to-variable objects in Global and Depends | expand

Commit Message

Pierre-Marie de Rodat May 4, 2021, 9:52 a.m. UTC 
Objects that typically would be constant, but can actually be written
because they are of access-to-variable type, can appear as outputs in
the Global and Depends contracts of non-functions (i.e. functions,
procedures, generic functions, generic procedures, protected entries,
task types and single task objects).

Those objects are constants, generic parameters of mode IN, and actual
non-function parameters of mode IN (i.e. parameters of procedures,
generic procedures and protected entries).

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

gcc/ada/

	* sem_prag.ads (Collect_Subprogram_Inputs_Outputs): Update
	comment; this routine is no longer used by GNATprove.
	* sem_prag.adb (Find_Role): The IN parameter is on output only
	when it belongs to non-function; also, the otherwise constant
	object can only be written by a non-function.
	(Collect_Global_Item): The IN parameter can only be written when
	it belongs to non-function; also, unnest this check to make it
	easier to read.
diff mbox series

Patch

diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb
--- a/gcc/ada/sem_prag.adb
+++ b/gcc/ada/sem_prag.adb
@@ -1281,17 +1281,22 @@  package body Sem_Prag is
            (Item_Is_Input  : out Boolean;
             Item_Is_Output : out Boolean)
          is
-            --  A constant or IN parameter of access-to-variable type should be
+            --  A constant or an IN parameter of a procedure or a protected
+            --  entry, if it is of an access-to-variable type, should be
             --  handled like a variable, as the underlying memory pointed-to
             --  can be modified. Use Adjusted_Kind to do this adjustment.
 
             Adjusted_Kind : Entity_Kind := Ekind (Item_Id);
 
          begin
-            if Ekind (Item_Id) in E_Constant
-                                | E_Generic_In_Parameter
-                                | E_In_Parameter
+            if (Ekind (Item_Id) in E_Constant | E_Generic_In_Parameter
+                  or else
+                  (Ekind (Item_Id) = E_In_Parameter
+                     and then Ekind (Scope (Item_Id))
+                                not in E_Function | E_Generic_Function))
               and then Is_Access_Variable (Etype (Item_Id))
+              and then Ekind (Spec_Id) not in E_Function
+                                            | E_Generic_Function
             then
                Adjusted_Kind := E_Variable;
             end if;
@@ -30244,16 +30249,6 @@  package body Sem_Prag is
          Formal := First_Entity (Spec_Id);
          while Present (Formal) loop
             if Ekind (Formal) in E_In_Out_Parameter | E_In_Parameter then
-
-               --  IN parameters can act as output when the related type is
-               --  access-to-variable.
-
-               if Ekind (Formal) = E_In_Parameter
-                 and then Is_Access_Variable (Etype (Formal))
-               then
-                  Append_New_Elmt (Formal, Subp_Outputs);
-               end if;
-
                Append_New_Elmt (Formal, Subp_Inputs);
             end if;
 
@@ -30271,6 +30266,17 @@  package body Sem_Prag is
                end if;
             end if;
 
+            --  IN parameters of procedures and protected entries can act as
+            --  outputs when the related type is access-to-variable.
+
+            if Ekind (Formal) = E_In_Parameter
+              and then Ekind (Spec_Id) not in E_Function
+                                            | E_Generic_Function
+              and then Is_Access_Variable (Etype (Formal))
+            then
+               Append_New_Elmt (Formal, Subp_Outputs);
+            end if;
+
             Next_Entity (Formal);
          end loop;
 


diff --git a/gcc/ada/sem_prag.ads b/gcc/ada/sem_prag.ads
--- a/gcc/ada/sem_prag.ads
+++ b/gcc/ada/sem_prag.ads
@@ -360,9 +360,9 @@  package Sem_Prag is
       Subp_Outputs : in out Elist_Id;
       Global_Seen  : out Boolean);
    --  Subsidiary to the analysis of pragmas Depends, Global, Refined_Depends
-   --  and Refined_Global. The routine is also used by GNATprove. Collect all
-   --  inputs and outputs of subprogram Subp_Id in lists Subp_Inputs (inputs)
-   --  and Subp_Outputs (outputs). The inputs and outputs are gathered from:
+   --  and Refined_Global. Collect all inputs and outputs of subprogram Subp_Id
+   --  in lists Subp_Inputs (inputs) and Subp_Outputs (outputs). The inputs and
+   --  outputs are gathered from:
    --    1) The formal parameters of the subprogram
    --    2) The generic formal parameters of the generic subprogram
    --    3) The current instance of a concurrent type