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 e01c4bfb2ae3ac84a221c719b6b7eed2a52aab0c..f7156a1a9a0678c8d9e03aed20603809dfa3f461 100644 (file)
--- 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 04ad0e295f7687013d1a5a9e37c22f81b0b8c8dd..e7f187857835fda7e4884567fa6d72abc00b7807 100644 (file)
--- 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 8a7e21e98d5eca1837225ca010e10e5ddd19de09..3d96a06609d38870affe6e89ed19223f29883b22 100644 (file)
--- 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 (file)
index 0000000..8c91aed
--- /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 (file)
index 0000000..2cb38fc
--- /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