From 0c221916d67f27c903415581260d9d975d2b3578 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Sun, 31 Jan 2016 10:22:05 +0000 Subject: [PATCH] re PR fortran/67564 (Segfault on sourced allocattion statement with class(*) arrays) 2016-01-31 Paul Thomas 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 PR fortran/67564 * gfortran.dg/allocate_with_source_17.f03: New test. From-SVN: r233016 --- gcc/fortran/ChangeLog | 7 ++++ gcc/fortran/trans-expr.c | 3 +- gcc/testsuite/ChangeLog | 5 +++ .../gfortran.dg/allocate_with_source_17.f03 | 36 +++++++++++++++++++ 4 files changed, 50 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/allocate_with_source_17.f03 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e4401f7040b..ccc29c1d39d 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2016-01-31 Paul Thomas + + 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 PR fortran/69566 diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 74f519ed87b..08b20e60365 100644 --- 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 63a4bfa16f9..aebc6e016b1 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2016-01-31 Paul Thomas + + PR fortran/67564 + * gfortran.dg/allocate_with_source_17.f03: New test. + 2016-01-30 Jakub Jelinek 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 index 00000000000..bce71f5bbce --- /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 +! +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