From: Pierre-Marie de Rodat <derodat@adacore.com>
To: gcc-patches@gcc.gnu.org
Cc: Justin Squirek <squirek@adacore.com>
Subject: [Ada] Missing accessibility check when returning discriminated types
Date: Wed, 20 Oct 2021 19:27:49 +0000 [thread overview]
Message-ID: <20211020192749.GA3154257@adacore.com> (raw)
[-- Attachment #1: Type: text/plain, Size: 807 bytes --]
In some cases where a function result type has an access discriminant
part, Ada requires that the execution of a return statement include a
check that the access discriminant does not designate an object whose
accessibility level is too deep (Ada RM 6.5(21)). This check was being
incorrectly omitted in some cases where the discriminant value
designates a not-explicitly-aliased parameter of the function (or some
part thereof). Correct this omission.
Tested on x86_64-pc-linux-gnu, committed on trunk
gcc/ada/
* sem_ch6.adb (Check_Return_Construct_Accessibility): Modify
generation of accessibility checks to be more consolidated and
get triggered properly in required cases.
* sem_util.adb (Accessibility_Level): Add extra check within
condition to handle aliased formals properly in more cases.
[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 4183 bytes --]
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -807,6 +807,7 @@ package body Sem_Ch6 is
Assoc_Expr : Node_Id;
Assoc_Present : Boolean := False;
+ Check_Cond : Node_Id;
Unseen_Disc_Count : Nat := 0;
Seen_Discs : Elist_Id;
Disc : Entity_Id;
@@ -1180,36 +1181,39 @@ package body Sem_Ch6 is
and then Present (Disc)
and then Ekind (Etype (Disc)) = E_Anonymous_Access_Type
then
- -- Perform a static check first, if possible
+ -- Generate a dynamic check based on the extra accessibility of
+ -- the result or the scope.
+
+ Check_Cond :=
+ Make_Op_Gt (Loc,
+ Left_Opnd => Accessibility_Level
+ (Expr => Assoc_Expr,
+ Level => Dynamic_Level,
+ In_Return_Context => True),
+ Right_Opnd => (if Present
+ (Extra_Accessibility_Of_Result
+ (Scope_Id))
+ then
+ Extra_Accessibility_Of_Result (Scope_Id)
+ else
+ Make_Integer_Literal
+ (Loc, Scope_Depth (Scope (Scope_Id)))));
+
+ Insert_Before_And_Analyze (Return_Stmt,
+ Make_Raise_Program_Error (Loc,
+ Condition => Check_Cond,
+ Reason => PE_Accessibility_Check_Failed));
+
+ -- If constant folding has happened on the condition for the
+ -- generated error, then warn about it being unconditional when
+ -- we know an error will be raised.
- if Static_Accessibility_Level
- (Expr => Assoc_Expr,
- Level => Zero_On_Dynamic_Level,
- In_Return_Context => True)
- > Scope_Depth (Scope (Scope_Id))
+ if Nkind (Check_Cond) = N_Identifier
+ and then Entity (Check_Cond) = Standard_True
then
Error_Msg_N
("access discriminant in return object would be a dangling"
& " reference", Return_Stmt);
-
- exit;
- end if;
-
- -- Otherwise, generate a dynamic check based on the extra
- -- accessibility of the result.
-
- if Present (Extra_Accessibility_Of_Result (Scope_Id)) then
- Insert_Before_And_Analyze (Return_Stmt,
- Make_Raise_Program_Error (Loc,
- Condition =>
- Make_Op_Gt (Loc,
- Left_Opnd => Accessibility_Level
- (Expr => Assoc_Expr,
- Level => Dynamic_Level,
- In_Return_Context => True),
- Right_Opnd => Extra_Accessibility_Of_Result
- (Scope_Id)),
- Reason => PE_Accessibility_Check_Failed));
end if;
end if;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -628,9 +628,9 @@ package body Sem_Util is
-- caller.
if Is_Explicitly_Aliased (E)
- and then Level /= Dynamic_Level
- and then (In_Return_Value (Expr)
- or else In_Return_Context)
+ and then (In_Return_Context
+ or else (Level /= Dynamic_Level
+ and then In_Return_Value (Expr)))
then
return Make_Level_Literal (Scope_Depth (Standard_Standard));
reply other threads:[~2021-10-20 19:27 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=20211020192749.GA3154257@adacore.com \
--to=derodat@adacore.com \
--cc=gcc-patches@gcc.gnu.org \
--cc=squirek@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).