diff mbox series

[Ada] Incorrect accessibility check on return of discriminated type

Message ID 20220704075003.GA98978@adacore.com
State New
Headers show
Series [Ada] Incorrect accessibility check on return of discriminated type | expand

Commit Message

Pierre-Marie de Rodat July 4, 2022, 7:50 a.m. UTC 
This patch corrects an error in the compiler whereby the presence of a
call to a function returning a type with an access discriminant within
an expanded loop condition caused the wrong value to be supplied for the
extra- accessibility-of-result actual, thus causing incorrect checks
within the callee at the point of return.

This change also corrects a problem where spurious "null value not
allowed" warnings were generated for tagged type declarations with an
access discriminant specified as "null."

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

gcc/ada/

	* sem_disp.adb (Most_Descendant_Use_Clause): Remove call to
	deprecated Is_Internal.
	* sem_util.adb (Innermost_Master_Scope_Depth): Use
	Find_Enclosing_Scope instead of Nearest_Dynamic_Scope to avoid
	cases where relevant scopes get skipped leading to an incorrect
	scope depth calculation.
diff mbox series

Patch

diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb
--- a/gcc/ada/sem_disp.adb
+++ b/gcc/ada/sem_disp.adb
@@ -508,12 +508,11 @@  package body Sem_Disp is
          return Empty;
 
       --  The dispatching type and the primitive operation must be defined in
-      --  the same scope, except in the case of internal operations and formal
-      --  abstract subprograms.
+      --  the same scope, except in the case of abstract formal subprograms.
 
-      elsif ((Scope (Subp) = Scope (Tagged_Type) or else Is_Internal (Subp))
-               and then (not Is_Generic_Type (Tagged_Type)
-                          or else not Comes_From_Source (Subp)))
+      elsif (Scope (Subp) = Scope (Tagged_Type)
+              and then (not Is_Generic_Type (Tagged_Type)
+                         or else not Comes_From_Source (Subp)))
         or else
           (Is_Formal_Subprogram (Subp) and then Is_Abstract_Subprogram (Subp))
         or else


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
@@ -275,9 +275,9 @@  package body Sem_Util is
       --  with its type set to Natural.
 
       function Innermost_Master_Scope_Depth (N : Node_Id) return Uint;
-      --  Returns the scope depth of the given node's innermost
-      --  enclosing dynamic scope (effectively the accessibility
-      --  level of the innermost enclosing master).
+      --  Returns the scope depth of the given node's innermost enclosing
+      --  scope (effectively the accessibility level of the innermost
+      --  enclosing master).
 
       function Function_Call_Or_Allocator_Level (N : Node_Id) return Node_Id;
       --  Centralized processing of subprogram calls which may appear in
@@ -301,7 +301,7 @@  package body Sem_Util is
       begin
          --  Locate the nearest enclosing node (by traversing Parents)
          --  that Defining_Entity can be applied to, and return the
-         --  depth of that entity's nearest enclosing dynamic scope.
+         --  depth of that entity's nearest enclosing scope.
 
          --  The rules that define what a master are defined in
          --  RM 7.6.1 (3), and include statements and conditions for loops
@@ -311,13 +311,13 @@  package body Sem_Util is
             Ent := Defining_Entity_Or_Empty (Node_Par);
 
             if Present (Ent) then
-               Encl_Scop := Nearest_Dynamic_Scope (Ent);
+               Encl_Scop := Find_Enclosing_Scope (Ent);
 
                --  Ignore transient scopes made during expansion
 
                if Comes_From_Source (Node_Par) then
                   return
-                    Scope_Depth_Default_0 (Encl_Scop) + Master_Lvl_Modifier;
+                    Scope_Depth (Encl_Scop) + Master_Lvl_Modifier;
                end if;
 
             --  For a return statement within a function, return