Fix ICE due to map typespecs with different sized charlens being copied.

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

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 50a0d4229433d73a2bd601937f7454b573c91227..49054dd9955caa9ba4ca3e7c6378c779b340e5b3 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,7 @@
+2016-10-07  Fritz Reese  <fritzoreese@gmail.com>
+
+       * interface.c (compare_components): Check charlen for BT_CHAR.
+
 2016-10-07  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        PR fortran/77406

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 2a9af0f7638b2555e93dbde9a6c23ec986a8ace1..dc81ab5991c15dc2f2370f0d7affebedf9bd794f 100644 (file)
--- 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 4d79c787c79fb40e86362a6f8d34764b12fc7e6e..2214179cbd4bb4be5dd52e22413f0e42e8d3b2d8 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2016-10-07  Fritz Reese  <fritzoreese@gmail.com>
+
+       * gfortran.dg/dec_union_11.f90: New testcase.
+
 2016-10-07  Nathan Sidwell  <nathan@acm.org>
 
        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 (file)
index 0000000..3ff4b49
--- /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