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 --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
