[Ada] Spurious dynamic accessibility check on allocator

Message ID 20210921152633.GA3094947@adacore.com
State Committed
Commit 7d9735bbb88b6e61e5405d7c99e6cc97112e7a41
Headers
Series [Ada] Spurious dynamic accessibility check on allocator |

Commit Message

Pierre-Marie de Rodat Sept. 21, 2021, 3:26 p.m. UTC
  This patch corrects an issue in the compiler whereby an anonymous access
class-wide type allocator with default initialization has spuriously
generated dynamic accessibility checks associated with the construct -
leading to spurious runtime accessibility failures.

Additionally, this patch corrects level miscalculations for protected
components.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

	* sem_util.adb (Accessibility_Level): Remove spurious special
	case for protected type components.
	* exp_ch4.adb (Generate_Accessibility_Check): Use general
	Accessibility_Level instead of the low-level function
	Type_Access_Level.
  

Patch

diff --git a/gcc/ada/exp_ch4.adb b/gcc/ada/exp_ch4.adb
--- a/gcc/ada/exp_ch4.adb
+++ b/gcc/ada/exp_ch4.adb
@@ -767,8 +767,7 @@  package body Exp_Ch4 is
             Cond :=
               Make_Op_Gt (Loc,
                 Left_Opnd  => Cond,
-                Right_Opnd =>
-                  Make_Integer_Literal (Loc, Type_Access_Level (PtrT)));
+                Right_Opnd => Accessibility_Level (N, Dynamic_Level));
 
             --  Due to the complexity and side effects of the check, utilize an
             --  if statement instead of the regular Program_Error circuitry.


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
@@ -728,17 +728,6 @@  package body Sem_Util is
                return Make_Level_Literal
                         (Typ_Access_Level (Etype (E)));
 
-            --  When E is a component of the current instance of a
-            --  protected type, we assume the level to be deeper than that of
-            --  the type itself.
-
-            elsif not Is_Overloadable (E)
-              and then Ekind (Scope (E)) = E_Protected_Type
-              and then Comes_From_Source (Scope (E))
-            then
-               return Make_Level_Literal
-                        (Scope_Depth (Enclosing_Dynamic_Scope (E)) + 1);
-
             --  Check if E is an expansion-generated renaming of an iterator
             --  by examining Related_Expression. If so, determine the
             --  accessibility level based on the original expression.