[gcc r13-1424] [Ada] Incorrect accessibility check on return of discriminated type

[gcc r13-1424] [Ada] Incorrect accessibility check on return of discriminated type

[Pierre-Marie de Rodat]

https://gcc.gnu.org/g:ddd88925273e86018b6cf57c9f6acc798a38e112

commit r13-1424-gddd88925273e86018b6cf57c9f6acc798a38e112
Author: Justin Squirek <squirek@adacore.com>
Date:   Thu Mar 24 18:42:09 2022 +0000

    [Ada] Incorrect accessibility check on return of discriminated type
    
    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."
    
    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:
---
 gcc/ada/sem_disp.adb |  9 ++++-----
 gcc/ada/sem_util.adb | 12 ++++++------
 2 files changed, 10 insertions(+), 11 deletions(-)

diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb
index 7bead6b3522..226142f2b41 100644
--- 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
index 9f861a2a850..addad83c6ae 100644
--- 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