* [Ada] Incorrect accessibility level on actual in procedure call
@ 2021-05-05 8:20 Pierre-Marie de Rodat
0 siblings, 0 replies; only message in thread
From: Pierre-Marie de Rodat @ 2021-05-05 8:20 UTC (permalink / raw)
To: gcc-patches; +Cc: Justin Squirek
[-- Attachment #1: Type: text/plain, Size: 408 bytes --]
This patch fixes an error in the compiler whereby dispatching calls to
subprograms featuring anonymous access formals may get incorrectly
expanded in such a way so as to lead to spurious runtime accessibility
check failures within the callee.
Tested on x86_64-pc-linux-gnu, committed on trunk
gcc/ada/
* exp_ch6.adb (Expand_Call_Helper): Add condition to check for
expanded actuals and remove dead code.
[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 5093 bytes --]
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -3473,12 +3473,6 @@ package body Exp_Ch6 is
Scop : Entity_Id;
Subp : Entity_Id;
- Prev_Orig : Node_Id;
- -- Original node for an actual, which may have been rewritten. If the
- -- actual is a function call that has been transformed from a selected
- -- component, the original node is unanalyzed. Otherwise, it carries
- -- semantic information used to generate additional actuals.
-
CW_Interface_Formals_Present : Boolean := False;
-- Start of processing for Expand_Call_Helper
@@ -3739,7 +3733,6 @@ package body Exp_Ch6 is
-- Prepare to examine current entry
Prev := Actual;
- Prev_Orig := Original_Node (Prev);
-- Ada 2005 (AI-251): Check if any formal is a class-wide interface
-- to expand it in a further round.
@@ -3828,63 +3821,6 @@ package body Exp_Ch6 is
-- Create possible extra actual for accessibility level
if Present (Extra_Accessibility (Formal)) then
-
- -- Ada 2005 (AI-252): If the actual was rewritten as an Access
- -- attribute, then the original actual may be an aliased object
- -- occurring as the prefix in a call using "Object.Operation"
- -- notation. In that case we must pass the level of the object,
- -- so Prev_Orig is reset to Prev and the attribute will be
- -- processed by the code for Access attributes further below.
-
- if Prev_Orig /= Prev
- and then Nkind (Prev) = N_Attribute_Reference
- and then Get_Attribute_Id (Attribute_Name (Prev)) =
- Attribute_Access
- and then Is_Aliased_View (Prev_Orig)
- then
- Prev_Orig := Prev;
-
- -- A class-wide precondition generates a test in which formals of
- -- the subprogram are replaced by actuals that came from source.
- -- In that case as well, the accessiblity comes from the actual.
- -- This is the one case in which there are references to formals
- -- outside of their subprogram.
-
- elsif Prev_Orig /= Prev
- and then Is_Entity_Name (Prev_Orig)
- and then Present (Entity (Prev_Orig))
- and then Is_Formal (Entity (Prev_Orig))
- and then not In_Open_Scopes (Scope (Entity (Prev_Orig)))
- then
- Prev_Orig := Prev;
-
- -- If the actual is a formal of an enclosing subprogram it is
- -- the right entity, even if it is a rewriting. This happens
- -- when the call is within an inherited condition or predicate.
-
- elsif Is_Entity_Name (Actual)
- and then Is_Formal (Entity (Actual))
- and then In_Open_Scopes (Scope (Entity (Actual)))
- then
- Prev_Orig := Prev;
-
- -- If the actual is an attribute reference that was expanded
- -- into a reference to an entity, then get accessibility level
- -- from that entity. AARM 6.1.1(27.d) says "... the implicit
- -- constant declaration defines the accessibility level of X'Old".
-
- elsif Nkind (Prev_Orig) = N_Attribute_Reference
- and then Attribute_Name (Prev_Orig) in Name_Old | Name_Loop_Entry
- and then Is_Entity_Name (Prev)
- and then Present (Entity (Prev))
- and then Is_Object (Entity (Prev))
- then
- Prev_Orig := Prev;
-
- elsif Nkind (Prev_Orig) = N_Type_Conversion then
- Prev_Orig := Expression (Prev_Orig);
- end if;
-
-- Ada 2005 (AI-251): Thunks must propagate the extra actuals of
-- accessibility levels.
@@ -3929,6 +3865,29 @@ package body Exp_Ch6 is
then
Add_Cond_Expression_Extra_Actual (Formal);
+ -- Internal constant generated to remove side effects (normally
+ -- from the expansion of dispatching calls).
+
+ -- First verify the actual is internal
+
+ elsif not Comes_From_Source (Prev)
+ and then Original_Node (Prev) = Prev
+
+ -- Next check that the actual is a constant
+
+ and then Nkind (Prev) = N_Identifier
+ and then Ekind (Entity (Prev)) = E_Constant
+ and then Nkind (Parent (Entity (Prev))) = N_Object_Declaration
+ then
+ -- Generate the accessibility level based on the expression in
+ -- the constant's declaration.
+
+ Add_Extra_Actual
+ (Expr => Accessibility_Level
+ (Expr => Expression (Parent (Entity (Prev))),
+ Level => Dynamic_Level),
+ EF => Extra_Accessibility (Formal));
+
-- Normal case
else
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2021-05-05 8:20 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2021-05-05 8:20 [Ada] Incorrect accessibility level on actual in procedure call Pierre-Marie de Rodat
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).