From: "Marc Poulhiès" <poulhies@adacore.com>
To: gcc-patches@gcc.gnu.org
Cc: Javier Miranda <miranda@adacore.com>
Subject: [COMMITTED] ada: Missing warning on null-excluding array aggregate component
Date: Thu, 25 May 2023 10:06:28 +0200 [thread overview]
Message-ID: <20230525080628.1957926-1-poulhies@adacore.com> (raw)
From: Javier Miranda <miranda@adacore.com>
The compiler does not report warnings on the initialization
of arrays of null-excluding access type components by means
of iterated component association, when the expression
initializing each component is either a conditional
expression or a case expression that may initialize
some component with a null value.
gcc/ada/
* sem_aggr.adb
(Warn_On_Null_Component_Association): New subprogram.
(Empty_Range): Adding missing support for iterated component
association node.
(Resolve_Array_Aggregate): Report warning on iterated component
association that may initialize some component of an array of
null-excluding access type components with a null value.
* exp_ch4.adb
(Expand_N_Expression_With_Actions): Add missing type check since
the subtype of the EWA node and the subtype of the expression
may differ.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_ch4.adb | 5 ++
gcc/ada/sem_aggr.adb | 163 ++++++++++++++++++++++++++++++++++++++++++-
2 files changed, 165 insertions(+), 3 deletions(-)
diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
index c7727904df2..48692c06f01 100644
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -5728,6 +5728,11 @@ package body Exp_Ch4 is
-- the usual forced evaluation to encapsulate potential aliasing.
else
+ -- A check is also needed since the subtype of the EWA node and the
+ -- subtype of the expression may differ (for example, the EWA node
+ -- may have a null-excluding access subtype).
+
+ Apply_Constraint_Check (Expression (N), Etype (N));
Force_Evaluation (Expression (N));
end if;
diff --git a/gcc/ada/sem_aggr.adb b/gcc/ada/sem_aggr.adb
index d9520ca8f4b..e7643277460 100644
--- a/gcc/ada/sem_aggr.adb
+++ b/gcc/ada/sem_aggr.adb
@@ -1340,6 +1340,12 @@ package body Sem_Aggr is
Index_Typ : Entity_Id);
-- For AI12-061
+ procedure Warn_On_Null_Component_Association (Expr : Node_Id);
+ -- Expr is either a conditional expression or a case expression of an
+ -- iterated component association initializing the aggregate N with
+ -- components that can never be null. Report warning on associations
+ -- that may initialize some component with a null value.
+
---------
-- Add --
---------
@@ -1877,6 +1883,132 @@ package body Sem_Aggr is
End_Scope;
end Resolve_Iterated_Component_Association;
+ ----------------------------------------
+ -- Warn_On_Null_Component_Association --
+ ----------------------------------------
+
+ procedure Warn_On_Null_Component_Association (Expr : Node_Id) is
+ Comp_Typ : constant Entity_Id := Component_Type (Etype (N));
+
+ procedure Check_Case_Expr (N : Node_Id);
+ -- Check if a case expression may initialize some component with a
+ -- null value.
+
+ procedure Check_Cond_Expr (N : Node_Id);
+ -- Check if a conditional expression may initialize some component
+ -- with a null value.
+
+ procedure Check_Expr (Expr : Node_Id);
+ -- Check if an expression may initialize some component with a
+ -- null value.
+
+ procedure Warn_On_Null_Expression_And_Rewrite (Null_Expr : Node_Id);
+ -- Report warning on known null expression and replace the expression
+ -- by a raise constraint error node.
+
+ ---------------------
+ -- Check_Case_Expr --
+ ---------------------
+
+ procedure Check_Case_Expr (N : Node_Id) is
+ Alt_Node : Node_Id := First (Alternatives (N));
+
+ begin
+ while Present (Alt_Node) loop
+ Check_Expr (Expression (Alt_Node));
+ Next (Alt_Node);
+ end loop;
+ end Check_Case_Expr;
+
+ ---------------------
+ -- Check_Cond_Expr --
+ ---------------------
+
+ procedure Check_Cond_Expr (N : Node_Id) is
+ If_Expr : Node_Id := N;
+ Then_Expr : Node_Id;
+ Else_Expr : Node_Id;
+
+ begin
+ Then_Expr := Next (First (Expressions (If_Expr)));
+ Else_Expr := Next (Then_Expr);
+
+ Check_Expr (Then_Expr);
+
+ -- Process elsif parts (if any)
+
+ while Nkind (Else_Expr) = N_If_Expression loop
+ If_Expr := Else_Expr;
+ Then_Expr := Next (First (Expressions (If_Expr)));
+ Else_Expr := Next (Then_Expr);
+
+ Check_Expr (Then_Expr);
+ end loop;
+
+ if Known_Null (Else_Expr) then
+ Warn_On_Null_Expression_And_Rewrite (Else_Expr);
+ end if;
+ end Check_Cond_Expr;
+
+ ----------------
+ -- Check_Expr --
+ ----------------
+
+ procedure Check_Expr (Expr : Node_Id) is
+ begin
+ if Known_Null (Expr) then
+ Warn_On_Null_Expression_And_Rewrite (Expr);
+
+ elsif Nkind (Expr) = N_If_Expression then
+ Check_Cond_Expr (Expr);
+
+ elsif Nkind (Expr) = N_Case_Expression then
+ Check_Case_Expr (Expr);
+ end if;
+ end Check_Expr;
+
+ -----------------------------------------
+ -- Warn_On_Null_Expression_And_Rewrite --
+ -----------------------------------------
+
+ procedure Warn_On_Null_Expression_And_Rewrite (Null_Expr : Node_Id) is
+ begin
+ Error_Msg_N
+ ("(Ada 2005) NULL not allowed in null-excluding component??",
+ Null_Expr);
+ Error_Msg_N
+ ("\Constraint_Error might be raised at run time??", Null_Expr);
+
+ -- We cannot use Apply_Compile_Time_Constraint_Error because in
+ -- some cases the components are rewritten and the runtime error
+ -- would be missed.
+
+ Rewrite (Null_Expr,
+ Make_Raise_Constraint_Error (Sloc (Null_Expr),
+ Reason => CE_Access_Check_Failed));
+
+ Set_Etype (Null_Expr, Comp_Typ);
+ Set_Analyzed (Null_Expr);
+ end Warn_On_Null_Expression_And_Rewrite;
+
+ -- Start of processing for Warn_On_Null_Component_Association
+
+ begin
+ pragma Assert (Can_Never_Be_Null (Comp_Typ));
+
+ case Nkind (Expr) is
+ when N_If_Expression =>
+ Check_Cond_Expr (Expr);
+
+ when N_Case_Expression =>
+ Check_Case_Expr (Expr);
+
+ when others =>
+ pragma Assert (False);
+ null;
+ end case;
+ end Warn_On_Null_Component_Association;
+
-- Local variables
Assoc : Node_Id;
@@ -2146,8 +2278,15 @@ package body Sem_Aggr is
-----------------
function Empty_Range (A : Node_Id) return Boolean is
- R : constant Node_Id := First (Choices (A));
+ R : Node_Id;
+
begin
+ if Nkind (A) = N_Iterated_Component_Association then
+ R := First (Discrete_Choices (A));
+ else
+ R := First (Choices (A));
+ end if;
+
return No (Next (R))
and then Nkind (R) = N_Range
and then Compile_Time_Compare
@@ -2313,10 +2452,28 @@ package body Sem_Aggr is
-- Ada 2005 (AI-231)
if Ada_Version >= Ada_2005
- and then Known_Null (Expression (Assoc))
and then not Empty_Range (Assoc)
then
- Check_Can_Never_Be_Null (Etype (N), Expression (Assoc));
+ if Known_Null (Expression (Assoc)) then
+ Check_Can_Never_Be_Null (Etype (N), Expression (Assoc));
+
+ -- Report warning on iterated component association that may
+ -- initialize some component of an array of null-excluding
+ -- access type components with a null value. For example:
+
+ -- type AList is array (...) of not null access Integer;
+ -- L : AList :=
+ -- [for J in A'Range =>
+ -- (if Func (J) = 0 then A(J)'Access else Null)];
+
+ elsif Ada_Version >= Ada_2022
+ and then Can_Never_Be_Null (Component_Type (Etype (N)))
+ and then Nkind (Assoc) = N_Iterated_Component_Association
+ and then Nkind (Expression (Assoc)) in N_If_Expression
+ | N_Case_Expression
+ then
+ Warn_On_Null_Component_Association (Expression (Assoc));
+ end if;
end if;
-- Ada 2005 (AI-287): In case of default initialized component
--
2.40.0
reply other threads:[~2023-05-25 8:06 UTC|newest]
Thread overview: [no followups] expand[flat|nested] mbox.gz Atom feed
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20230525080628.1957926-1-poulhies@adacore.com \
--to=poulhies@adacore.com \
--cc=gcc-patches@gcc.gnu.org \
--cc=miranda@adacore.com \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).