mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-24 07:10:27 +08:00
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/82814 (ICE from submodule character function)

Browse Source 
2017-11-23  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/82814
	* trans-types.c (gfc_sym_type): If a character function result
	is missing the charlen backend_decl, use the one from the name-
	space procedure symbol, if present.

2017-11-23  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/82814
	* gfortran.dg/submodule_31.f08: New test.

From-SVN: r255094
This commit is contained in:
Paul Thomas 2017-11-23 09:52:04 +00:00
parent d7a160a45e
commit f36a7f04f6
4 changed files with 72 additions and 0 deletions

7
gcc/fortran/ChangeLog

@ -1,3 +1,10 @@
2017-11-23 Paul Thomas <pault@gcc.gnu.org>
PR fortran/82814
* trans-types.c (gfc_sym_type): If a character function result
is missing the charlen backend_decl, use the one from the name-
space procedure symbol, if present.
2017-11-22 David Malcolm <dmalcolm@redhat.com>
PR c++/62170

6
gcc/fortran/trans-types.c

@ -2201,6 +2201,12 @@ gfc_sym_type (gfc_symbol * sym)
if (sym->backend_decl && !sym->attr.function)
return TREE_TYPE (sym->backend_decl);
if (sym->attr.result
&& sym->ts.type == BT_CHARACTER
&& sym->ts.u.cl->backend_decl == NULL_TREE
&& sym->ns->proc_name->ts.u.cl->backend_decl != NULL_TREE)
sym->ts.u.cl->backend_decl = sym->ns->proc_name->ts.u.cl->backend_decl;
if (sym->ts.type == BT_CHARACTER
&& ((sym->attr.function && sym->attr.is_bind_c)
|| (sym->attr.result

5
gcc/testsuite/ChangeLog

@ -1,3 +1,8 @@
2017-11-23 Paul Thomas <pault@gcc.gnu.org>
PR fortran/82814
* gfortran.dg/submodule_31.f08: New test.
2017-11-23 Richard Biener <rguenther@suse.de>
PR tree-optimization/23094

54
gcc/testsuite/gfortran.dg/submodule_31.f08 Normal file

@ -0,0 +1,54 @@
! { dg-do run }
!
! Test the fix for PR82814 in which an ICE occurred for the submodule allocation.
!
! Contributed by "Werner Blokbuster" <werner.blokbuster@gmail.com>
!
module u
implicit none
interface unique
module function uniq_char(input) result(uniq)
character(*), intent(in) :: input(:)
character(size(input)), allocatable :: uniq(:)
end function uniq_char
end interface unique
contains
module function uniq2(input) result(uniq)
character(*), intent(in) :: input(:)
character(size(input)), allocatable :: uniq(:)
allocate(uniq(1))
uniq = 'A'
end function uniq2
end module u
submodule (u) z
implicit none
contains
module function uniq_char(input) result(uniq)
character(*), intent(in) :: input(:)
character(size(input)), allocatable :: uniq(:)
allocate(uniq(1)) ! This used to ICE
uniq = 'A'
end function uniq_char
end submodule z
program test_uniq
use u
implicit none
character(1), dimension(4) :: chr = ['1','2','1','2']
write(*,*) unique(chr)
write(*,*) uniq2(chr)
end program test_uniq