diff options
author | Justin Squirek <squirek@adacore.com> | 2019-12-10 22:49:43 -0500 |
---|---|---|
committer | Pierre-Marie de Rodat <derodat@adacore.com> | 2020-05-25 10:00:54 -0400 |
commit | 4354291994e6f6cb6eba1acef3192fa5c18b1274 (patch) | |
tree | 50898cdff6edd6dbc8f0cfb2ab2c057532598d5e /gcc | |
parent | a746f952abb78af9db28a7f3bce442e113877c9c (diff) | |
download | gcc-4354291994e6f6cb6eba1acef3192fa5c18b1274.zip gcc-4354291994e6f6cb6eba1acef3192fa5c18b1274.tar.gz gcc-4354291994e6f6cb6eba1acef3192fa5c18b1274.tar.bz2 |
[Ada] Spurious accessibility error on return aggregate in GNATprove mode
2020-05-25 Justin Squirek <squirek@adacore.com>
gcc/ada/
* sem_ch6.adb (Check_Return_Obj_Accessibility): Use original
node to avoid looking at expansion done in GNATprove mode.
Diffstat (limited to 'gcc')
-rw-r--r-- | gcc/ada/ChangeLog | 5 | ||||
-rw-r--r-- | gcc/ada/sem_ch6.adb | 24 |
2 files changed, 17 insertions, 12 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 09f81ba..08c2676 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,8 @@ +2020-05-25 Justin Squirek <squirek@adacore.com> + + * sem_ch6.adb (Check_Return_Obj_Accessibility): Use original + node to avoid looking at expansion done in GNATprove mode. + 2020-05-25 Eric Botcazou <ebotcazou@adacore.com> * gcc-interface/decl.c (gnat_to_gnu_entity): Add new local variable diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index eca0557..d79b7a2 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -798,44 +798,44 @@ package body Sem_Ch6 is N_Discriminant_Association) then Expr := Expression (Assoc); + else + Expr := Empty; end if; -- This anonymous access discriminant has an associated -- expression which needs checking. - if Nkind (Expr) = N_Attribute_Reference + if Present (Expr) + and then Nkind (Expr) = N_Attribute_Reference and then Attribute_Name (Expr) /= Name_Unrestricted_Access then -- Obtain the object to perform static checks on by moving -- up the prefixes in the expression taking into account -- named access types. - Obj := Prefix (Expr); + Obj := Original_Node (Prefix (Expr)); while Nkind_In (Obj, N_Indexed_Component, N_Selected_Component) loop + Obj := Original_Node (Prefix (Obj)); + -- When we encounter a named access type then we can -- ignore accessibility checks on the dereference. - if Ekind (Etype (Prefix (Obj))) + if Ekind (Etype (Obj)) in E_Access_Type .. E_Access_Protected_Subprogram_Type then - if Nkind (Obj) = N_Selected_Component then - Obj := Selector_Name (Obj); + if Nkind (Parent (Obj)) = N_Selected_Component then + Obj := Selector_Name (Parent (Obj)); end if; exit; end if; -- Skip over the explicit dereference - if Nkind (Prefix (Obj)) = N_Explicit_Dereference then - Obj := Prefix (Prefix (Obj)); - - -- Otherwise move up to the next prefix - - else - Obj := Prefix (Obj); + if Nkind (Obj) = N_Explicit_Dereference then + Obj := Original_Node (Prefix (Obj)); end if; end loop; |