From 56d3a930ae50cd8ab744a1d2ea4ed803995b47bf Mon Sep 17 00:00:00 2001 From: Fritz Reese Date: Fri, 7 Oct 2016 21:25:16 +0000 Subject: [PATCH] Fix ICE due to map typespecs with different sized charlens being copied. 2016-10-07 Fritz Reese Fix ICE due to map typespecs with different sized charlens being copied. gcc/fortran/ * interface.c (compare_components): Check charlen for BT_CHAR. gcc/testsuite/gfortran.dg/ * dec_union_11.f90: New testcase. From-SVN: r240875 --- gcc/fortran/ChangeLog | 4 ++ gcc/fortran/interface.c | 11 ++++ gcc/testsuite/ChangeLog | 4 ++ gcc/testsuite/gfortran.dg/dec_union_11.f90 | 63 ++++++++++++++++++++++ 4 files changed, 82 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/dec_union_11.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 50a0d422943..49054dd9955 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,7 @@ +2016-10-07 Fritz Reese + + * interface.c (compare_components): Check charlen for BT_CHAR. + 2016-10-07 Steven G. Kargl PR fortran/77406 diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index 2a9af0f7638..dc81ab5991c 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -495,6 +495,17 @@ compare_components (gfc_component *cmp1, gfc_component *cmp2, if (cmp1->attr.dimension && gfc_compare_array_spec (cmp1->as, cmp2->as) == 0) return 0; + if (cmp1->ts.type == BT_CHARACTER && cmp2->ts.type == BT_CHARACTER) + { + gfc_charlen *l1 = cmp1->ts.u.cl; + gfc_charlen *l2 = cmp2->ts.u.cl; + if (l1 && l2 && l1->length && l2->length + && l1->length->expr_type == EXPR_CONSTANT + && l2->length->expr_type == EXPR_CONSTANT + && gfc_dep_compare_expr (l1->length, l2->length) != 0) + return 0; + } + /* Make sure that link lists do not put this function into an endless recursive loop! */ if (!(cmp1->ts.type == BT_DERIVED && derived1 == cmp1->ts.u.derived) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 4d79c787c79..2214179cbd4 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2016-10-07 Fritz Reese + + * gfortran.dg/dec_union_11.f90: New testcase. + 2016-10-07 Nathan Sidwell PR c++/66443 diff --git a/gcc/testsuite/gfortran.dg/dec_union_11.f90 b/gcc/testsuite/gfortran.dg/dec_union_11.f90 new file mode 100644 index 00000000000..3ff4b49b62f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dec_union_11.f90 @@ -0,0 +1,63 @@ +! { dg-do compile } +! { dg-options "-g -fdec-structure" } +! +! Test a regression where typespecs of unions containing character buffers of +! different lengths where copied, resulting in a bad gimple tree state. +! + +subroutine sub2 (otherbuf) + integer, parameter :: L_bbuf = 65536 + integer, parameter :: L_bbuf2 = 24 + + structure /buffer2/ + union + map + character(L_bbuf2) sbuf + end map + end union + end structure + structure /buffer/ + union + map + character(L_bbuf) sbuf + end map + end union + end structure + + record /buffer/ buf1 + record /buffer2/ buf2 + common /c/ buf1, buf2 + + record /buffer2/ otherbuf +end subroutine + +subroutine sub() + integer, parameter :: L_bbuf = 65536 + integer, parameter :: L_bbuf2 = 24 + + structure /buffer2/ + union + map + character(L_bbuf2) sbuf + end map + end union + end structure + structure /buffer/ + union + map + character(L_bbuf) sbuf + end map + end union + end structure + + record /buffer/ buf1 + record /buffer2/ buf2 + common /c/ buf1, buf2 + + call sub2 (buf1) ! { dg-warning "Type mismatch" } + return +end subroutine + +call sub() + +end -- 2.30.2