From: Fritz Reese <fritzoreese@gmail.com>
Date: Wed, 5 Oct 2016 20:24:48 +0000 (+0000)
Subject: Fix ICE due to comparison between UNION components.
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=908b82964e0985f2f97e5848ba10cda7e77ce8cb;p=gcc.git

Fix ICE due to comparison between UNION components.

2016-10-05  Fritz Reese  <fritzoreese@gmail.com>

Fix ICE due to comparison between UNION components.

	gcc/fortran/
	* interface.c (gfc_compare_types): Don't compare BT_UNION components
	until we know they're both UNIONs.
	* interface.c (gfc_compare_union_types): Guard against empty
	components.

	gcc/testsuite/gfortran.dg/
	* dec_union_9.f90: New testcase.
	* dec_union_10.f90: New testcase.

From-SVN: r240810
---

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e01c4bfb2ae..f7156a1a9a0 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2016-10-05  Fritz Reese  <fritzoreese@gmail.com>
+
+	* interface.c (gfc_compare_types): Don't compare BT_UNION components
+	until we know they're both UNIONs.
+	* interface.c (gfc_compare_union_types): Guard against empty
+	components.
+
 2016-10-05  Louis Krupp  <louis.krupp@zoho.com>
 
 	PR fortran/67524
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 04ad0e295f7..e7f18785783 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -531,6 +531,12 @@ gfc_compare_union_types (gfc_symbol *un1, gfc_symbol *un2)
   if (un1->attr.flavor != FL_UNION || un2->attr.flavor != FL_UNION)
     return 0;
 
+  if (un1->attr.zero_comp != un2->attr.zero_comp)
+    return 0;
+
+  if (un1->attr.zero_comp)
+    return 1;
+
   map1 = un1->components;
   map2 = un2->components;
 
@@ -694,13 +700,14 @@ gfc_compare_types (gfc_typespec *ts1, gfc_typespec *ts2)
       && (ts1->u.derived->attr.sequence || ts1->u.derived->attr.is_bind_c))
     return 1;
 
-  if (ts1->type == BT_UNION && ts2->type == BT_UNION)
-    return gfc_compare_union_types (ts1->u.derived, ts2->u.derived);
-
   if (ts1->type != ts2->type
-      && ((!gfc_bt_struct (ts1->type) && ts1->type != BT_CLASS)
-	  || (!gfc_bt_struct (ts2->type) && ts2->type != BT_CLASS)))
+      && ((ts1->type != BT_DERIVED && ts1->type != BT_CLASS)
+	  || (ts2->type != BT_DERIVED && ts2->type != BT_CLASS)))
     return 0;
+
+  if (ts1->type == BT_UNION)
+    return gfc_compare_union_types (ts1->u.derived, ts2->u.derived);
+
   if (ts1->type != BT_DERIVED && ts1->type != BT_CLASS)
     return (ts1->kind == ts2->kind);
 
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 8a7e21e98d5..3d96a06609d 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2016-10-05  Fritz Reese  <fritzoreese@gmail.com>
+
+	* gfortran.dg/dec_union_9.f90: New testcase.
+	* gfortran.dg/dec_union_10.f90: New testcase.
+
 2016-10-05  Jakub Jelinek  <jakub@redhat.com>
 
 	PR sanitizer/66343
diff --git a/gcc/testsuite/gfortran.dg/dec_union_10.f90 b/gcc/testsuite/gfortran.dg/dec_union_10.f90
new file mode 100644
index 00000000000..8c91aedb497
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_union_10.f90
@@ -0,0 +1,27 @@
+! { dg-do compile }
+! { dg-options "-fdec-structure" }
+!
+! Check for regression where gfc_compare_union_types wasn't properly guarded
+! against empty unions.
+!
+
+subroutine sub1(r)
+  structure /s/
+    union
+    end union
+  end structure
+  record /s/ r
+end subroutine
+
+subroutine sub2()
+  structure /s/
+    union
+    end union
+  end structure
+  record /s/ r
+  call sub1(r)
+end subroutine
+
+call sub2()
+
+end
diff --git a/gcc/testsuite/gfortran.dg/dec_union_9.f90 b/gcc/testsuite/gfortran.dg/dec_union_9.f90
new file mode 100644
index 00000000000..2cb38fca0fa
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dec_union_9.f90
@@ -0,0 +1,26 @@
+! { dg-do compile }
+! { dg-options "-fdec-structure" }
+!
+! Test a regression where union components could compare equal to structure/map
+! components, causing an ICE in gfc_conv_component_ref.
+!
+
+implicit none
+
+structure /s1/
+  integer(4) i
+end structure
+
+structure /s2/
+  union
+    map
+      record /s1/ r
+    end map
+  end union
+end structure
+
+record /s2/ x
+
+x.r.i = 0
+
+end