re PR fortran/67564 (Segfault on sourced allocattion statement with class(*) arrays)

2016-01-31  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/67564
	* trans-expr.c (gfc_conv_procedure_call): For the vtable copy
	subroutines, add a string length argument, when the actual
	argument is an unlimited polymorphic class object.

2016-01-31  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/67564
	* gfortran.dg/allocate_with_source_17.f03: New test.

From-SVN: r233016

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e4401f7040b780758718829cc225a5de7978f1c5..ccc29c1d39d8697387b45db9ce84a7f66f62a6c5 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2016-01-31  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/67564
+       * trans-expr.c (gfc_conv_procedure_call): For the vtable copy
+       subroutines, add a string length argument, when the actual
+       argument is an unlimited polymorphic class object.
+
 2016-01-30  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/69566

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 74f519ed87bce23033b2f1f5d5bc8d3373297bf5..08b20e603655e4abac2dac17ec62715a5dd1e848 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -5621,7 +5621,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
       if (sym->name[0] == '_' && e && e->ts.type == BT_CHARACTER
          && strncmp (sym->name, "__vtab_CHARACTER", 16) == 0
          && arg->next && arg->next->expr
-         && arg->next->expr->ts.type == BT_DERIVED
+         && (arg->next->expr->ts.type == BT_DERIVED
+             || arg->next->expr->ts.type == BT_CLASS)
          && arg->next->expr->ts.u.derived->attr.unlimited_polymorphic)
        vec_safe_push (stringargs, parmse.string_length);
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 63a4bfa16f928e50bc88df9dffba384860e22006..aebc6e016b1b0266c443f257b321b89537c3caa6 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2016-01-31  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/67564
+       * gfortran.dg/allocate_with_source_17.f03: New test.
+
 2016-01-30  Jakub Jelinek  <jakub@redhat.com>
 
        PR tree-optimization/69546

diff --git a/gcc/testsuite/gfortran.dg/allocate_with_source_17.f03 b/gcc/testsuite/gfortran.dg/allocate_with_source_17.f03
new file mode 100644 (file)
index 0000000..bce71f5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/allocate_with_source_17.f03
@@ -0,0 +1,36 @@
+! { dg-do compile }
+!
+! Tests the fix for PR67564 in which allocate with source for an unlimited
+! polymorphic array and a character source would ICE.
+!
+! Contributed by Neil Carlson  <neil.n.carlson@gmail.com>
+!
+program main
+  type :: any_vector
+    class(*), allocatable :: x(:)
+  end type
+  type(any_vector) :: a
+  character(kind = 1, len = 5) :: chr1(3) = ["one  ","two  ","three"]
+  character(kind = 4, len = 2) :: chr4(2) = [character(kind=4) :: 4_"ab", 4_"cd"]
+  real(8) :: r(2) = [1d0,2d0]
+
+  allocate (a%x(3), source = chr1)
+  call check
+  allocate (a%x(2), source = chr4)
+  call check
+  allocate (a%x(2), source = r)
+  call check
+
+contains
+  subroutine check
+    select type (z => a%x)
+      type is (real(8))
+        if (any (z .ne. r)) call abort
+      type is (character(kind = 1, len = *))
+        if (any(z .ne. chr1)) call abort
+      type is (character(kind = 4, len = *))
+        if (any(z .ne. chr4)) call abort
+    end select
+    deallocate (a%x)
+  end subroutine
+end program