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

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.

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.

From-SVN: r273684

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 06e6421c20234f079fe61b9d2fe5acd869822b35..f47d247281f2ac82d7ef9ab87a84b096949ed3f0 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,8 @@
+2019-07-22  Yannick Moy  <moy@adacore.com>
+
+       * sem_ch3.adb (Constrain_Access): Issue a message about ignored
+       constraint.
+
 2019-07-22  Eric Botcazou  <ebotcazou@adacore.com>
 
        * sem_ch8.adb (End_Use_Type): Reset the In_Use flag on the

diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index d8cd34850879eff50be620959577b68dc6e5cf04..645a024b7e080dafafa6abd53363c6bc2fd000c8 100644 (file)
--- a/gcc/ada/sem_ch3.adb
+++ b/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));
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 0f8b798f0a58ebda8b469537c888fba0280d41b4..079f6e9d6f3f4f7ffa12a77c88cef37a246029f5 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2019-07-22  Yannick Moy  <moy@adacore.com>
+
+       * gnat.dg/warn24.adb: New testcase.
+
 2019-07-22  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gnat.dg/inline17.adb, gnat.dg/inline17_pkg1.adb,

diff --git a/gcc/testsuite/gnat.dg/warn24.adb b/gcc/testsuite/gnat.dg/warn24.adb
new file mode 100644 (file)
index 0000000..e7c9f8a
--- /dev/null
+++ b/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;