https://gcc.gnu.org/g:09eced2c9b6b9ae2f2643a6610ab5baf230c1e34

commit r16-2499-g09eced2c9b6b9ae2f2643a6610ab5baf230c1e34
Author: Steve Baird <ba...@adacore.com>
Date:   Wed Jul 16 13:37:44 2025 -0700

    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).

Diff:
---
 gcc/ada/exp_ch6.adb | 21 +++++++++++++++++++++
 1 file changed, 21 insertions(+)

diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 255fa12f8eb5..eb7422c8c7a8 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

Reply via email to