OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/57445 ([OOP] ICE in gfc_conv_class_to_class - for OPTIONAL polymorphic array) 

2013-11-04  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/57445
	* trans-expr.c (gfc_conv_class_to_class): Remove spurious
	assert.

2013-11-04  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/57445
	* gfortran.dg/optional_class_1.f90 : New test

From-SVN: r204356
This commit is contained in:
Paul Thomas 2013-11-04 19:42:24 +00:00
parent efaf512c94
commit 4ca469cf46
4 changed files with 57 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
gcc/fortran/ChangeLog
View File

@ -1,3 +1,9 @@
2013-11-04 Paul Thomas <pault@gcc.gnu.org>
PR fortran/57445
* trans-expr.c (gfc_conv_class_to_class): Remove spurious
assert.
2013-10-29 Tobias Burnus <burnus@net-b.de>
PR fortran/44350

3
gcc/fortran/trans-expr.c
View File

@ -737,7 +737,6 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e, gfc_typespec class_ts,
gfc_add_modify (&parmse->post, vptr,
fold_convert (TREE_TYPE (vptr), ctree));
gcc_assert (!optional || (optional && !copyback));
if (optional)
{
tree tmp2;
@ -7769,7 +7768,7 @@ is_runtime_conformable (gfc_expr *expr1, gfc_expr *expr2)
e1 = a->expr;
if (e1->rank > 0 && !is_runtime_conformable (expr1, e1))
return false;
}
}
return true;
}
else if (expr2->value.function.isym

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2013-11-04 Paul Thomas <pault@gcc.gnu.org>
PR fortran/57445
* gfortran.dg/optional_class_1.f90 : New test
2013-11-04 Vladimir Makarov <vmakarov@redhat.com>
PR rtl-optimization/58968

45
gcc/testsuite/gfortran.dg/optional_class_1.f90 Normal file
View File

@ -0,0 +1,45 @@
! { dg-do run }
!
! PR fortran/57445
!
! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
!
! Spurious assert was added at revision 192495
!
module m
implicit none
type t
integer :: i
end type t
contains
subroutine opt(xa, xc, xaa, xca)
type(t), allocatable, intent(out), optional :: xa
class(t), allocatable, intent(out), optional :: xc
type(t), allocatable, intent(out), optional :: xaa(:)
class(t), allocatable, intent(out), optional :: xca(:)
if (present (xca)) call foo_opt(xca=xca)
end subroutine opt
subroutine foo_opt(xa, xc, xaa, xca)
type(t), allocatable, intent(out), optional :: xa
class(t), allocatable, intent(out), optional :: xc
type(t), allocatable, intent(out), optional :: xaa(:)
class(t), allocatable, intent(out), optional :: xca(:)
if (present (xca)) then
if (allocated (xca)) deallocate (xca)
allocate (xca(3), source = [t(9),t(99),t(999)])
end if
end subroutine foo_opt
end module m
use m
class(t), allocatable :: xca(:)
allocate (xca(1), source = t(42))
select type (xca)
type is (t)
if (any (xca%i .ne. [42])) call abort
end select
call opt (xca = xca)
select type (xca)
type is (t)
if (any (xca%i .ne. [9,99,999])) call abort
end select
end