diff mbox series

[Ada] Overriding error on type derived from discriminated untagged private type

Message ID 20220518084308.GA3311250@adacore.com
State Committed
Commit df61c5dc3a16178834651d3437da6fa4490b480b
Headers
Series [Ada] Overriding error on type derived from discriminated untagged private type |

Commit Message

Pierre-Marie de Rodat May 18, 2022, 8:43 a.m. UTC 
  When a derived type DT has an untagged private parent type PT with a
discriminant, where the full type of PT is tagged, and DT inherits a
function F with an anonymous access result that designates the type, the
compiler wrongly reports an error saying that DT must be declared
abstract or F overridden. A test is added to exclude checking the
abstract overriding rules that should only apply to inherited
subprograms of tagged derived types.

Tested on x86_64-pc-linux-gnu, committed on trunk

gcc/ada/

	* sem_ch3.adb (Check_Abstract_Overriding): If the type is
	derived from an untagged type, then don't perform any of the
	abstract overriding error checks.
diff mbox series

Patch

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -11047,6 +11047,14 @@  package body Sem_Ch3 is
          Subp := Node (Elmt);
          Alias_Subp := Alias (Subp);
 
+         --  If the parent type is untagged, then no overriding error checks
+         --  are needed (such as in the case of an implicit full type for
+         --  a derived type whose parent is an untagged private type with
+         --  a tagged full type).
+
+         if not Is_Tagged_Type (Etype (T)) then
+            null;
+
          --  Inherited subprograms are identified by the fact that they do not
          --  come from source, and the associated source location is the
          --  location of the first subtype of the derived type.
@@ -11065,7 +11073,7 @@  package body Sem_Ch3 is
          --  overriding in Ada 2005, but wrappers need to be built for them
          --  (see exp_ch3, Build_Controlling_Function_Wrappers).
 
-         if Is_Null_Extension (T)
+         elsif Is_Null_Extension (T)
            and then Has_Controlling_Result (Subp)
            and then Ada_Version >= Ada_2005
            and then Present (Alias_Subp)