aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJustin Squirek <squirek@adacore.com>2022-03-24 18:42:09 +0000
committerPierre-Marie de Rodat <derodat@adacore.com>2022-07-04 07:45:52 +0000
commitddd88925273e86018b6cf57c9f6acc798a38e112 (patch)
treeb8ba74a459a71abd5b2995a6e4d7eeb175a601dc
parentbdd5056736b642f0124e6cb26f9c2fd8be028908 (diff)
downloadgcc-ddd88925273e86018b6cf57c9f6acc798a38e112.zip
gcc-ddd88925273e86018b6cf57c9f6acc798a38e112.tar.gz
gcc-ddd88925273e86018b6cf57c9f6acc798a38e112.tar.bz2
[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.
-rw-r--r--gcc/ada/sem_disp.adb9
-rw-r--r--gcc/ada/sem_util.adb12
2 files changed, 10 insertions, 11 deletions
diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb
index 7bead6b..226142f 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 9f861a2..addad83 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