[Ada] Issue warning or error message on ignored typing constraint

[Ada] Issue warning or error message on ignored typing constraint

[Pierre-Marie de Rodat]

[-- Attachment #1: Type: text/plain, Size: 441 bytes --]

GNAT ignores the discriminant constraint on a component when it applies
to the type of the record being analyzed. Now issue a warning on Ada
code when ignoring this constraint, or an error on SPARK code.

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

2019-07-22  Yannick Moy  <moy@adacore.com>

gcc/ada/

	* sem_ch3.adb (Constrain_Access): Issue a message about ignored
	constraint.

gcc/testsuite/

	* gnat.dg/warn24.adb: New testcase.

[-- Attachment #2: patch.diff --]
[-- Type: text/x-diff, Size: 941 bytes --]

--- gcc/ada/sem_ch3.adb
+++ gcc/ada/sem_ch3.adb
@@ -12970,6 +12970,10 @@ package body Sem_Ch3 is
          if Desig_Type = Current_Scope
            and then No (Def_Id)
          then
+            Error_Msg_Warn := SPARK_Mode /= On;
+            Error_Msg_N ("<<constraint is ignored on component that is "
+                         & "access to current record", S);
+
             Set_Ekind (Desig_Subtype, E_Record_Subtype);
             Def_Id := Entity (Subtype_Mark (S));
 

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/warn24.adb
@@ -0,0 +1,15 @@
+--  { dg-do compile }
+
+procedure Warn24 is
+   type List_D (D : Boolean);
+
+   type List_Acc is access List_D;
+
+   type List_D (D : Boolean) is record
+      Next : List_Acc (D);  --  { dg-warning "constraint is ignored on component that is access to current record" }
+   end record;
+
+   X : List_D (True);
+begin
+   X.Next := new List_D (False);
+end Warn24;