From 908b82964e0985f2f97e5848ba10cda7e77ce8cb Mon Sep 17 00:00:00 2001 From: Fritz Reese Date: Wed, 5 Oct 2016 20:24:48 +0000 Subject: [PATCH] Fix ICE due to comparison between UNION components. 2016-10-05 Fritz Reese 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 --- gcc/fortran/ChangeLog | 7 ++++++ gcc/fortran/interface.c | 17 ++++++++++---- gcc/testsuite/ChangeLog | 5 ++++ gcc/testsuite/gfortran.dg/dec_union_10.f90 | 27 ++++++++++++++++++++++ gcc/testsuite/gfortran.dg/dec_union_9.f90 | 26 +++++++++++++++++++++ 5 files changed, 77 insertions(+), 5 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/dec_union_10.f90 create mode 100644 gcc/testsuite/gfortran.dg/dec_union_9.f90 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 + + * 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 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 + + * gfortran.dg/dec_union_9.f90: New testcase. + * gfortran.dg/dec_union_10.f90: New testcase. + 2016-10-05 Jakub Jelinek 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 -- 2.30.2