diff mbox series

[COMMITTED,14/35] ada: Fix bogus error on function returning noncontrolling result in private part

Message ID 20240516092606.41242-14-poulhies@adacore.com
State New
Headers show
Series [COMMITTED,01/35] ada: Fix docs and comments about pragmas for Boolean-valued aspects | expand

Commit Message

Marc Poulhiès May 16, 2024, 9:25 a.m. UTC 
From: Eric Botcazou <ebotcazou@adacore.com>

This occurs in the additional case of RM 3.9.3(10) in Ada 2012, that is to
say the access controlling result, because the implementation does not use
the same (correct) conditions as in the original case.

This factors out these conditions and uses them in both cases, as well as
adjusts the wording of the message in the first case.

gcc/ada/

	* sem_ch6.adb (Check_Private_Overriding): Implement the second part
	of RM 3.9.3(10) consistently in both cases.

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

---
 gcc/ada/sem_ch6.adb | 23 +++++++++--------------
 1 file changed, 9 insertions(+), 14 deletions(-)
diff mbox series

Patch

diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index c0bfe873111..0a8030cb923 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -11555,35 +11555,30 @@  package body Sem_Ch6 is
                                       Incomplete_Or_Partial_View (T);
 
                   begin
-                     if not Overrides_Visible_Function (Partial_View) then
+                     if not Overrides_Visible_Function (Partial_View)
+                       and then
+                         Is_Tagged_Type
+                           (if Present (Partial_View) then Partial_View else T)
+                     then
 
                         --  Here, S is "function ... return T;" declared in
                         --  the private part, not overriding some visible
                         --  operation. That's illegal in the tagged case
                         --  (but not if the private type is untagged).
 
-                        if ((Present (Partial_View)
-                              and then Is_Tagged_Type (Partial_View))
-                          or else (No (Partial_View)
-                                    and then Is_Tagged_Type (T)))
-                          and then T = Base_Type (Etype (S))
-                        then
+                        if T = Base_Type (Etype (S)) then
                            Error_Msg_N
-                             ("private function with tagged result must"
+                             ("private function with controlling result must"
                               & " override visible-part function", S);
                            Error_Msg_N
                              ("\move subprogram to the visible part"
                               & " (RM 3.9.3(10))", S);
 
                         --  Ada 2012 (AI05-0073): Extend this check to the case
-                        --  of a function whose result subtype is defined by an
-                        --  access_definition designating specific tagged type.
+                        --  of a function with access result type.
 
                         elsif Ekind (Etype (S)) = E_Anonymous_Access_Type
-                          and then Is_Tagged_Type (Designated_Type (Etype (S)))
-                          and then
-                            not Is_Class_Wide_Type
-                                  (Designated_Type (Etype (S)))
+                          and then T = Base_Type (Designated_Type (Etype (S)))
                           and then Ada_Version >= Ada_2012
                         then
                            Error_Msg_N