aboutsummaryrefslogtreecommitdiff
path: root/gcc
diff options
context:
space:
mode:
authorSteve Baird <baird@adacore.com>2025-07-16 13:37:44 -0700
committerMarc Poulhiès <dkm@gcc.gnu.org>2025-07-25 10:09:36 +0200
commit09eced2c9b6b9ae2f2643a6610ab5baf230c1e34 (patch)
treefed040e44ea7fed75643cd4a9cab2063b57da41c /gcc
parent91fc017022c66e475da5ea5528f983d840800e40 (diff)
downloadgcc-09eced2c9b6b9ae2f2643a6610ab5baf230c1e34.zip
gcc-09eced2c9b6b9ae2f2643a6610ab5baf230c1e34.tar.gz
gcc-09eced2c9b6b9ae2f2643a6610ab5baf230c1e34.tar.bz2
ada: Follow up fixes.
Two follow-up fixes for the previous change for this issue. gcc/ada/ChangeLog: * exp_ch6.adb (Apply_Access_Discrims_Accessibility_Check): Do nothing and simply return if either Ada_Version <= Ada_95 or if the function being returned from lacks the extra formal parameter needed to perform the check (typically because the result is tagged).
Diffstat (limited to 'gcc')
-rw-r--r--gcc/ada/exp_ch6.adb21
1 files changed, 21 insertions, 0 deletions
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 255fa12..eb7422c 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -899,6 +899,17 @@ package body Exp_Ch6 is
Constrained_Subtype : constant Entity_Id :=
Constraint_Bearing_Subtype_If_Any (Exp);
begin
+ -- ??? Do not generate a check if version is Ada 95 (or earlier).
+ -- It is unclear whether this is really correct, or is just a stopgap
+ -- measure. Investigation is needed to decide how post-Ada-95 binding
+ -- interpretation changes in RM 3.10.2 should interact with Ada 95's
+ -- return-by-reference model for functions with limited result types
+ -- (which was abandoned in Ada 2005).
+
+ if Ada_Version <= Ada_95 then
+ return;
+ end if;
+
-- If we are returning a function call then that function will
-- perform the needed check.
@@ -906,6 +917,16 @@ package body Exp_Ch6 is
return;
end if;
+ -- ??? Cope with the consequences of the Disable_Tagged_Cases flag
+ -- in accessibility.adb (which can cause the extra formal parameter
+ -- needed for the check(s) generated here to be missing in the case
+ -- of a tagged result type); this is a workaround and can
+ -- prevent generation of a required check.
+
+ if No (Extra_Accessibility_Of_Result (Func)) then
+ return;
+ end if;
+
Remove_Side_Effects (Exp);
while Present (Discr) loop