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:
parent
03e79d4fa1
commit
0c221916d6
4 changed files with 50 additions and 1 deletions
|
@ -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
|
||||
|
|
|
@ -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);
|
||||
|
||||
|
|
|
@ -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
|
||||
|
|
36
gcc/testsuite/gfortran.dg/allocate_with_source_17.f03
Normal file
36
gcc/testsuite/gfortran.dg/allocate_with_source_17.f03
Normal 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
|
Loading…
Add table
Reference in a new issue