]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
ada: Follow up fixes.
authorSteve Baird <baird@adacore.com>
Wed, 16 Jul 2025 20:37:44 +0000 (13:37 -0700)
committerMarc Poulhiès <dkm@gcc.gnu.org>
Fri, 25 Jul 2025 08:09:36 +0000 (10:09 +0200)
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).

gcc/ada/exp_ch6.adb

index 255fa12f8eb5c30753a1d0db8c008cffc8049800..eb7422c8c7a81569b14350f7d6b215daa36c7749 100644 (file)
@@ -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