From 96bba5e69b93ae01d7f49dd1c12c94ddb462c381 Mon Sep 17 00:00:00 2001
From: Eric Botcazou <ebotcazou@adacore.com>
Date: Fri, 23 Jul 2010 19:53:29 +0000
Subject: [PATCH] utils.c (gnat_types_compatible_p): Revert latest change and
recurse only for multidimensional array types instead.
* gcc-interface/utils.c (gnat_types_compatible_p): Revert latest change
and recurse only for multidimensional array types instead.
From-SVN: r162485
---
gcc/ada/ChangeLog | 5 +++++
gcc/ada/gcc-interface/utils.c | 6 ++++--
gcc/testsuite/ChangeLog | 5 +++++
gcc/testsuite/gnat.dg/aggr16.adb | 26 ++++++++++++++++++++++++++
gcc/testsuite/gnat.dg/aggr16.ads | 5 +++++
gcc/testsuite/gnat.dg/aggr16_pkg.ads | 27 +++++++++++++++++++++++++++
6 files changed, 72 insertions(+), 2 deletions(-)
create mode 100644 gcc/testsuite/gnat.dg/aggr16.adb
create mode 100644 gcc/testsuite/gnat.dg/aggr16.ads
create mode 100644 gcc/testsuite/gnat.dg/aggr16_pkg.ads
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index f631f84bd8b0..1ef253c4494b 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,8 @@
+2010-07-23 Eric Botcazou <ebotcazou@adacore.com>
+
+ * gcc-interface/utils.c (gnat_types_compatible_p): Revert latest change
+ and recurse only for multidimensional array types instead.
+
2010-07-22 Eric Botcazou <ebotcazou@adacore.com>
PR ada/44892
diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c
index 541f7bb3f919..7752edb4b689 100644
--- a/gcc/ada/gcc-interface/utils.c
+++ b/gcc/ada/gcc-interface/utils.c
@@ -2081,7 +2081,7 @@ gnat_types_compatible_p (tree t1, tree t2)
return 1;
/* Array types are also compatible if they are constrained and have the same
- domain and compatible component types. */
+ domain(s) and the same component type. */
if (code == ARRAY_TYPE
&& (TYPE_DOMAIN (t1) == TYPE_DOMAIN (t2)
|| (TYPE_DOMAIN (t1)
@@ -2090,7 +2090,9 @@ gnat_types_compatible_p (tree t1, tree t2)
TYPE_MIN_VALUE (TYPE_DOMAIN (t2)))
&& tree_int_cst_equal (TYPE_MAX_VALUE (TYPE_DOMAIN (t1)),
TYPE_MAX_VALUE (TYPE_DOMAIN (t2)))))
- && gnat_types_compatible_p (TREE_TYPE (t1), TREE_TYPE (t2)))
+ && (TREE_TYPE (t1) == TREE_TYPE (t2)
+ || (TREE_CODE (TREE_TYPE (t1)) == ARRAY_TYPE
+ && gnat_types_compatible_p (TREE_TYPE (t1), TREE_TYPE (t2)))))
return 1;
/* Padding record types are also compatible if they pad the same
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 9e8c046b2aa4..bdc2660cbbec 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2010-07-23 Eric Botcazou <ebotcazou@adacore.com>
+
+ * gnat.dg/aggr16.ad[sb]: New test.
+ * gnat.dg/aggr16_pkg.ads: New helper.
+
2010-07-23 Richard Guenther <rguenther@suse.de>
PR lto/43071
diff --git a/gcc/testsuite/gnat.dg/aggr16.adb b/gcc/testsuite/gnat.dg/aggr16.adb
new file mode 100644
index 000000000000..2f559da25f9b
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/aggr16.adb
@@ -0,0 +1,26 @@
+-- { dg-do compile }
+
+with Aggr16_Pkg; use Aggr16_Pkg;
+
+package body Aggr16 is
+
+ type Arr is array (1 .. 4) of Time;
+
+ type Change_Type is (One, Two, Three);
+
+ type Change (D : Change_Type) is record
+ case D is
+ when Three =>
+ A : Arr;
+ when Others =>
+ B : Boolean;
+ end case;
+ end record;
+
+ procedure Proc is
+ C : Change (Three);
+ begin
+ C.A := (others => Null_Time);
+ end;
+
+end Aggr16;
diff --git a/gcc/testsuite/gnat.dg/aggr16.ads b/gcc/testsuite/gnat.dg/aggr16.ads
new file mode 100644
index 000000000000..3a4b0d1dfa8d
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/aggr16.ads
@@ -0,0 +1,5 @@
+package Aggr16 is
+
+ procedure Proc;
+
+end Aggr16;
diff --git a/gcc/testsuite/gnat.dg/aggr16_pkg.ads b/gcc/testsuite/gnat.dg/aggr16_pkg.ads
new file mode 100644
index 000000000000..8bacbc9b04fb
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/aggr16_pkg.ads
@@ -0,0 +1,27 @@
+package Aggr16_Pkg is
+
+ type Time_Type is (A, B);
+
+ type Time (D : Time_Type := A) is private;
+
+ Null_Time : constant Time;
+
+private
+
+ type Hour is record
+ I1 : Integer;
+ I2 : Integer;
+ end record;
+
+ type Time (D : Time_Type := A) is record
+ case D is
+ when A =>
+ A_Time : Integer;
+ when B =>
+ B_Time : Hour;
+ end case;
+ end record;
+
+ Null_Time : constant Time := (A, 0);
+
+end Aggr16_Pkg;
--
GitLab