git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/58991 (ICE with associate and character string constant) 

2016-10-05  Steven G. Kargl  <kargls@gcc.gnu.org>

	PR fortran/58991
	PR fortran/58992
	* resolve.c (resolve_assoc_var):  Fix CHARACTER type-spec for a
	selector in ASSOCIATE.
	(resolve_fl_variable): Skip checks for an ASSOCIATE variable.


2016-10-05  Steven G. Kargl  <kargls@gcc.gnu.org>

	PR fortran/58991
	PR fortran/58992
	* gfortran.dg/associate_22.f90: New test.

From-SVN: r240812
This commit is contained in:
Steven G. Kargl 2016-10-05 21:14:14 +00:00
parent 908b82964e
commit 50b01e1d46
4 changed files with 64 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gcc/fortran/ChangeLog
View File

@ -1,3 +1,11 @@
2016-10-05 Steven G. Kargl <kargls@gcc.gnu.org>
PR fortran/58991
PR fortran/58992
* resolve.c (resolve_assoc_var): Fix CHARACTER type-spec for a
selector in ASSOCIATE.
(resolve_fl_variable): Skip checks for an ASSOCIATE variable.
2016-10-05 Fritz Reese <fritzoreese@gmail.com> 2016-10-05 Fritz Reese <fritzoreese@gmail.com>
* interface.c (gfc_compare_types): Don't compare BT_UNION components * interface.c (gfc_compare_types): Don't compare BT_UNION components

14
gcc/fortran/resolve.c
View File

@ -8304,6 +8304,18 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target)
/* Mark this as an associate variable. */ /* Mark this as an associate variable. */
sym->attr.associate_var = 1; sym->attr.associate_var = 1;
/* Fix up the type-spec for CHARACTER types. */
if (sym->ts.type == BT_CHARACTER && !sym->attr.select_type_temporary)
{
if (!sym->ts.u.cl)
sym->ts.u.cl = target->ts.u.cl;
if (!sym->ts.u.cl->length)
sym->ts.u.cl->length
= gfc_get_int_expr (gfc_default_integer_kind,
NULL, target->value.character.length);
}
/* If the target is a good class object, so is the associate variable. */ /* If the target is a good class object, so is the associate variable. */
if (sym->ts.type == BT_CLASS && gfc_expr_attr (target).class_ok) if (sym->ts.type == BT_CLASS && gfc_expr_attr (target).class_ok)
sym->attr.class_ok = 1; sym->attr.class_ok = 1;
@ -11577,7 +11589,7 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
if (!deferred_requirements (sym)) if (!deferred_requirements (sym))
return false; return false;
if (sym->ts.type == BT_CHARACTER) if (sym->ts.type == BT_CHARACTER && !sym->attr.associate_var)
{ {
/* Make sure that character string variables with assumed length are /* Make sure that character string variables with assumed length are
dummy arguments. */ dummy arguments. */

6
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,9 @@
2016-10-05 Steven G. Kargl <kargls@gcc.gnu.org>
PR fortran/58991
PR fortran/58992
* gfortran.dg/associate_22.f90: New test.
2016-10-05 Fritz Reese <fritzoreese@gmail.com> 2016-10-05 Fritz Reese <fritzoreese@gmail.com>
* gfortran.dg/dec_union_9.f90: New testcase. * gfortran.dg/dec_union_9.f90: New testcase.

37
gcc/testsuite/gfortran.dg/associate_22.f90 Normal file
View File

@ -0,0 +1,37 @@
! { dg-do run }
program foo
implicit none
character(len=4) :: s
character(len=10) :: a
! This works.
s = 'abc'
associate(t => s)
if (trim(t) /= 'abc') call abort
end associate
! This failed.
associate(u => 'abc')
if (trim(u) /= 'abc') call abort
end associate
! This failed.
a = s // 'abc'
associate(v => s // 'abc')
if (trim(v) /= trim(a)) call abort
end associate
! This failed.
a = trim(s) // 'abc'
associate(w => trim(s) // 'abc')
if (trim(w) /= trim(a)) call abort
end associate
! This failed.
associate(x => trim('abc'))
if (trim(x) /= 'abc') call abort
end associate
end program foo