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
This commit is contained in:
Paul Thomas 2016-01-31 10:22:05 +00:00
parent 03e79d4fa1
commit 0c221916d6
4 changed files with 50 additions and 1 deletions

View file

@ -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

View file

@ -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);

View file

@ -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

View file

@ -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