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

re PR fortran/90498 (ICE with select type/associate and derived type argument containing class(*))

Browse Source 
2019-05-19  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/90498
	* trans-stmt.c (trans_associate_var) Do not use the saved
	descriptor if the expression is a COMPONENT_REF.

2019-05-19  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/90498
	* gfortran.dg/associate_48.f90 : New test.

From-SVN: r271380
This commit is contained in:
Paul Thomas 2019-05-19 12:32:55 +00:00
parent 20733f1b0d
commit d05ccada17
4 changed files with 55 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 @@
2019-05-19 Paul Thomas <pault@gcc.gnu.org>
PR fortran/90498
* trans-stmt.c (trans_associate_var) Do not use the saved
descriptor if the expression is a COMPONENT_REF.
2019-05-19 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/90329

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

@ -1858,7 +1858,8 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
{
if (e->symtree
&& DECL_LANG_SPECIFIC (e->symtree->n.sym->backend_decl)
&& GFC_DECL_SAVED_DESCRIPTOR (e->symtree->n.sym->backend_decl))
&& GFC_DECL_SAVED_DESCRIPTOR (e->symtree->n.sym->backend_decl)
&& TREE_CODE (target_expr) != COMPONENT_REF)
/* Use the original class descriptor stored in the saved
descriptor to get the target_expr. */
target_expr =

7
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2019-05-19 Paul Thomas <pault@gcc.gnu.org>
PR fortran/90498
* gfortran.dg/associate_48.f90 : New test.
2019-05-19 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/78290
@ -429,7 +434,7 @@
2019-05-15 Iain Sandoe <iain@sandoe.co.uk>
* lib/target-supports.exp
* lib/target-supports.exp
(check_effective_target_powerpc_p8vector_ok): No support for Darwin.
(check_effective_target_powerpc_p9vector_ok): Likewise.
(check_effective_target_powerpc_float128_sw_ok): Likewise.

41
gcc/testsuite/gfortran.dg/associate_48.f90 Normal file
View File

@ -0,0 +1,41 @@
! { dg=do run }
!
! Test the fix for PR90498.
!
! Contributed by Vladimir Fuka <vladimir.fuka@gmail.com>
!
type field_names_a
class(*), pointer :: var(:) =>null()
end type
type(field_names_a),pointer :: a(:)
allocate (a(2))
allocate (a(1)%var(2), source = ["hello"," vlad"])
allocate (a(2)%var(2), source = ["HELLO"," VLAD"])
call s(a)
deallocate (a(1)%var)
deallocate (a(2)%var)
deallocate (a)
contains
subroutine s(a)
type(field_names_a) :: a(:)
select type (var => a(1)%var)
type is (character(*))
if (any (var .ne. ["hello"," vlad"])) stop 1
class default
stop
end select
associate (var => a(2)%var)
select type (var)
type is (character(*))
if (any (var .ne. ["HELLO"," VLAD"])) stop 2
class default
stop
end select
end associate
end
end