From: Steve Baird <ba...@adacore.com>

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

Tested on x86_64-pc-linux-gnu, committed on master.

---
 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 255fa12f8eb..eb7422c8c7a 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
-- 
2.43.0

Reply via email to