https://gcc.gnu.org/g:2c1200d671759d7d138a15b3f891d88cc5fc48da
commit r15-6520-g2c1200d671759d7d138a15b3f891d88cc5fc48da
Author: Bob Duff <d...@adacore.com>
Date: Tue Dec 3 17:49:15 2024 -0500
ada: Warn on unmodified parameters of expression functions
If an 'out' or 'in out' parameter is not modified in a function body,
we warn. However, the warning was missing when we have an expression
function instead of a proper body. This patch enables the warning
on expression functions.
gcc/ada/ChangeLog:
* sem_ch6.adb (Analyze_Expression_Function): Mark the implicit
spec for an expression function as Comes_From_Source.
(Analyze_Null_Procedure): Minor cleanup.
* sem_warn.adb (Source_E1): New function to compute whether
to give warnings. In particular, return True for [in] out
parameters of expression functions.
Diff:
---
gcc/ada/sem_ch6.adb | 16 ++++++++++------
gcc/ada/sem_warn.adb | 44 ++++++++++++++++++++++++++++++++++++--------
2 files changed, 46 insertions(+), 14 deletions(-)
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index a3b521ddad4b..2f09284ebdad 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -310,7 +310,7 @@ package body Sem_Ch6 is
Typ : Entity_Id := Empty;
Def_Id : Entity_Id := Empty;
- Prev : Entity_Id;
+ Prev : Entity_Id := Current_Entity_In_Scope (Defining_Entity (Spec));
-- If the expression is a completion, Prev is the entity whose
-- declaration is completed. Def_Id is needed to analyze the spec.
@@ -325,10 +325,15 @@ package body Sem_Ch6 is
Inline_Processing_Required := True;
-- Create a specification for the generated body. This must be done
- -- prior to the analysis of the initial declaration.
+ -- prior to the analysis of the initial declaration. We mark the
+ -- generated Defining_Unit_Name as Comes_From_Source to avoid
+ -- suppressing warnings on it. We do not do that in instances,
+ -- because of arcane interactions with ghost generics.
New_Spec := Copy_Subprogram_Spec (Spec);
- Prev := Current_Entity_In_Scope (Defining_Entity (Spec));
+ if not In_Instance then
+ Set_Comes_From_Source (Defining_Unit_Name (New_Spec));
+ end if;
-- Copy SPARK pragma from expression function
@@ -1363,11 +1368,10 @@ package body Sem_Ch6 is
Form : Node_Id;
Null_Body : Node_Id := Empty;
Null_Stmt : Node_Id := Null_Statement (Spec);
- Prev : Entity_Id;
+ Prev : Entity_Id :=
+ Current_Entity_In_Scope (Defining_Entity (Spec));
begin
- Prev := Current_Entity_In_Scope (Defining_Entity (Spec));
-
-- A null procedure is Ghost when it is stand-alone and is subject to
-- pragma Ghost, or when the corresponding spec is Ghost. Set the mode
-- now, to ensure that any nodes generated during analysis and expansion
diff --git a/gcc/ada/sem_warn.adb b/gcc/ada/sem_warn.adb
index 2ffd631d6283..2eac80246a69 100644
--- a/gcc/ada/sem_warn.adb
+++ b/gcc/ada/sem_warn.adb
@@ -861,6 +861,13 @@ package body Sem_Warn is
-- Return True if it is OK for an object of type T to be referenced
-- without having been assigned a value in the source.
+ function Source_E1 return Boolean;
+ -- True if E1 is sufficiently "from source" to warrant a warning.
+ -- We are only interested in source entities. We also don't issue
+ -- warnings within instances, since the proper place for such
+ -- warnings is on the template when it is compiled. Expression
+ -- functions are a special case (see body).
+
function Warnings_Off_E1 return Boolean;
-- Return True if Warnings_Off is set for E1, or for its Etype (E1T),
-- or for the base type of E1T.
@@ -1156,6 +1163,34 @@ package body Sem_Warn is
end if;
end Type_OK_For_No_Value_Assigned;
+ ---------------
+ -- Source_E1 --
+ ---------------
+
+ function Source_E1 return Boolean is
+ begin
+ if Instantiation_Location (Sloc (E1)) /= No_Location then
+ return False;
+ end if;
+
+ if Comes_From_Source (E1) then
+ return True;
+ end if;
+
+ -- In the special case of an expression function, which has been
+ -- turned into an E_Subprogram_Body, we want to warn about unmodified
+ -- [in] out parameters.
+
+ if Ekind (E) = E_Subprogram_Body
+ and then Comes_From_Source (E)
+ and then Ekind (E1) in E_In_Out_Parameter | E_Out_Parameter
+ then
+ return True;
+ end if;
+
+ return False;
+ end Source_E1;
+
---------------------
-- Warnings_Off_E1 --
---------------------
@@ -1190,14 +1225,7 @@ package body Sem_Warn is
E1 := First_Entity (E);
while Present (E1) loop
- -- We are only interested in source entities. We also don't issue
- -- warnings within instances, since the proper place for such
- -- warnings is on the template when it is compiled, and we don't
- -- issue warnings for variables with names like Junk, Discard etc.
-
- if Comes_From_Source (E1)
- and then Instantiation_Location (Sloc (E1)) = No_Location
- then
+ if Source_E1 then
E1T := Etype (E1);
-- We are interested in variables and out/in-out parameters, but
