From 5dcbefb1c407fcb949597c4257726bfbc8760cfb Mon Sep 17 00:00:00 2001
From: Yannick Moy <moy@adacore.com>
Date: Mon, 22 Jul 2019 13:57:42 +0000
Subject: [PATCH] [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
---
 gcc/ada/ChangeLog                |  5 +++++
 gcc/ada/sem_ch3.adb              |  4 ++++
 gcc/testsuite/ChangeLog          |  4 ++++
 gcc/testsuite/gnat.dg/warn24.adb | 15 +++++++++++++++
 4 files changed, 28 insertions(+)
 create mode 100644 gcc/testsuite/gnat.dg/warn24.adb

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 06e6421c202..f47d247281f 100644
--- 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 d8cd3485087..645a024b7e0 100644
--- 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 0f8b798f0a5..079f6e9d6f3 100644
--- 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
index 00000000000..e7c9f8a0466
--- /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;
-- 
2.30.2