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

re PR fortran/79072 (ICE with class(*) pointer function result and character value)

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

	PR fortran/79072
	* trans-stmt.c (trans_associate_var): Weaken the over strong
	condition for using the fake result decl.

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

	PR fortran/79072
	* gfortran.dg/class_result_6.f90: New test for comment 10 of
	the PR.

From-SVN: r255053
This commit is contained in:
Paul Thomas 2017-11-22 11:37:16 +00:00
parent e350134d72
commit a7d3cd407c
4 changed files with 37 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 @@
2017-11-22 Paul Thomas <pault@gcc.gnu.org>
PR fortran/79072
* trans-stmt.c (trans_associate_var): Weaken the over strong
condition for using the fake result decl.
2017-11-20 Paul Thomas <pault@gcc.gnu.org>
PR fortran/79072

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

@ -1828,8 +1828,7 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block)
tmp = e->symtree->n.sym->ts.u.cl->backend_decl;
}
else if (e->symtree->n.sym->attr.function
&& e->symtree->n.sym == e->symtree->n.sym->result
&& e->symtree->n.sym == e->symtree->n.sym->ns->proc_name)
&& e->symtree->n.sym == e->symtree->n.sym->result)
{
tmp = gfc_get_fake_result_decl (e->symtree->n.sym, 0);
tmp = gfc_class_len_get (tmp);

6
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,9 @@
2017-11-22 Paul Thomas <pault@gcc.gnu.org>
PR fortran/79072
* gfortran.dg/class_result_6.f90: New test for comment 10 of
the PR.
2017-11-22 Jakub Jelinek <jakub@redhat.com>
PR debug/83084

24
gcc/testsuite/gfortran.dg/class_result_6.f90 Normal file
View File

@ -0,0 +1,24 @@
! { dg-do run }
!
! Test the fix for PR79072 comment #12. A description of the problem
! is to be found in class_result_5.f90.
!
! Contributed by Neil Carlson <neil.n.carlson@gmail.com>
!
character(3), target :: a = 'foo'
class(*), pointer :: b
b => ptr()
select type (b)
type is (character(*))
if (a .ne. "bar") call abort
end select
contains
function ptr()
class(*), pointer :: ptr
ptr => a
select type (ptr)
type is (character(*))
ptr = "bar"
end select
end function
end