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

re PR fortran/91588 (ICE in check_inquiry, at fortran/expr.c:2673) 

2019-09-17  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/91588
	* expr.c (check_inquiry): Remove extended component refs by
	using symbol pointers. If a function argument is an associate
	variable with a constant target, copy the target expression in
	place of the argument expression. Check that the charlen is not
	NULL before using the string length.
	(gfc_check_assign): Remove extraneous space.

2019-09-17  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/91588
	* gfortran.dg/associate_49.f90 : New test.

From-SVN: r275800
This commit is contained in:
Paul Thomas 2019-09-17 08:30:50 +00:00
parent ecd4d80cb2
commit c4ccdc0e63
4 changed files with 94 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
gcc/fortran/ChangeLog
View File

@ -1,3 +1,13 @@
2019-09-17 Paul Thomas <pault@gcc.gnu.org>
PR fortran/91588
* expr.c (check_inquiry): Remove extended component refs by
using symbol pointers. If a function argument is an associate
variable with a constant target, copy the target expression in
place of the argument expression. Check that the charlen is not
NULL before using the string length.
(gfc_check_assign): Remove extraneous space.
2019-09-15 Steven G. Kargl <kargl@gcc.gnu.org>
PR fortran/91727

79
gcc/fortran/expr.c
View File

@ -2610,6 +2610,8 @@ check_inquiry (gfc_expr *e, int not_restricted)
int i = 0;
gfc_actual_arglist *ap;
gfc_symbol *sym;
gfc_symbol *asym;
if (!e->value.function.isym
|| !e->value.function.isym->inquiry)
@ -2619,20 +2621,22 @@ check_inquiry (gfc_expr *e, int not_restricted)
if (e->symtree == NULL)
return MATCH_NO;
if (e->symtree->n.sym->from_intmod)
sym = e->symtree->n.sym;
if (sym->from_intmod)
{
if (e->symtree->n.sym->from_intmod == INTMOD_ISO_FORTRAN_ENV
&& e->symtree->n.sym->intmod_sym_id != ISOFORTRAN_COMPILER_OPTIONS
&& e->symtree->n.sym->intmod_sym_id != ISOFORTRAN_COMPILER_VERSION)
if (sym->from_intmod == INTMOD_ISO_FORTRAN_ENV
&& sym->intmod_sym_id != ISOFORTRAN_COMPILER_OPTIONS
&& sym->intmod_sym_id != ISOFORTRAN_COMPILER_VERSION)
return MATCH_NO;
if (e->symtree->n.sym->from_intmod == INTMOD_ISO_C_BINDING
&& e->symtree->n.sym->intmod_sym_id != ISOCBINDING_C_SIZEOF)
if (sym->from_intmod == INTMOD_ISO_C_BINDING
&& sym->intmod_sym_id != ISOCBINDING_C_SIZEOF)
return MATCH_NO;
}
else
{
name = e->symtree->n.sym->name;
name = sym->name;
functions = inquiry_func_gnu;
if (gfc_option.warn_std & GFC_STD_F2003)
@ -2657,41 +2661,48 @@ check_inquiry (gfc_expr *e, int not_restricted)
if (!ap->expr)
continue;
asym = ap->expr->symtree ? ap->expr->symtree->n.sym : NULL;
if (ap->expr->ts.type == BT_UNKNOWN)
{
if (ap->expr->symtree->n.sym->ts.type == BT_UNKNOWN
&& !gfc_set_default_type (ap->expr->symtree->n.sym, 0, gfc_current_ns))
if (asym && asym->ts.type == BT_UNKNOWN
&& !gfc_set_default_type (asym, 0, gfc_current_ns))
return MATCH_NO;
ap->expr->ts = ap->expr->symtree->n.sym->ts;
ap->expr->ts = asym->ts;
}
/* Assumed character length will not reduce to a constant expression
with LEN, as required by the standard. */
if (i == 5 && not_restricted && ap->expr->symtree
&& ap->expr->symtree->n.sym->ts.type == BT_CHARACTER
&& (ap->expr->symtree->n.sym->ts.u.cl->length == NULL
|| ap->expr->symtree->n.sym->ts.deferred))
{
gfc_error ("Assumed or deferred character length variable %qs "
"in constant expression at %L",
ap->expr->symtree->n.sym->name,
&ap->expr->where);
return MATCH_ERROR;
}
else if (not_restricted && !gfc_check_init_expr (ap->expr))
return MATCH_ERROR;
if (asym && asym->assoc && asym->assoc->target
&& asym->assoc->target->expr_type == EXPR_CONSTANT)
{
gfc_free_expr (ap->expr);
ap->expr = gfc_copy_expr (asym->assoc->target);
}
if (not_restricted == 0
&& ap->expr->expr_type != EXPR_VARIABLE
&& !check_restricted (ap->expr))
/* Assumed character length will not reduce to a constant expression
with LEN, as required by the standard. */
if (i == 5 && not_restricted && asym
&& asym->ts.type == BT_CHARACTER
&& ((asym->ts.u.cl && asym->ts.u.cl->length == NULL)
|| asym->ts.deferred))
{
gfc_error ("Assumed or deferred character length variable %qs "
"in constant expression at %L",
asym->name, &ap->expr->where);
return MATCH_ERROR;
}
else if (not_restricted && !gfc_check_init_expr (ap->expr))
return MATCH_ERROR;
if (not_restricted == 0
&& ap->expr->expr_type == EXPR_VARIABLE
&& ap->expr->symtree->n.sym->attr.dummy
&& ap->expr->symtree->n.sym->attr.optional)
return MATCH_NO;
if (not_restricted == 0
&& ap->expr->expr_type != EXPR_VARIABLE
&& !check_restricted (ap->expr))
return MATCH_ERROR;
if (not_restricted == 0
&& ap->expr->expr_type == EXPR_VARIABLE
&& asym->attr.dummy && asym->attr.optional)
return MATCH_NO;
}
return MATCH_YES;
@ -3683,7 +3694,7 @@ gfc_check_assign (gfc_expr *lvalue, gfc_expr *rvalue, int conform,
gfc_error ("BOZ literal constant near %L cannot be assigned to a "
"%qs variable", &rvalue->where, gfc_typename (&lvalue->ts));
return false;
}

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2019-09-17 Paul Thomas <pault@gcc.gnu.org>
PR fortran/91588
* gfortran.dg/associate_49.f90 : New test.
2019-09-17 Yannick Moy <moy@adacore.com>
* gnat.dg/fixedpnt7.adb: New testcase.

34
gcc/testsuite/gfortran.dg/associate_49.f90 Normal file
View File

@ -0,0 +1,34 @@
! { dg-do run }
!
! Test the fix for PR91588, in which the declaration of 'a' caused
! an ICE.
!
! Contributed by Gerhardt Steinmetz <gscfq@t-online.de>
!
program p
character(4), parameter :: parm = '7890'
associate (z => '1234')
block
integer(len(z)) :: a
if (kind(a) .ne. 4) stop 1
end block
end associate
associate (z => '123')
block
integer(len(z)+1) :: a
if (kind(a) .ne. 4) stop 2
end block
end associate
associate (z => 1_8)
block
integer(kind(z)) :: a
if (kind(a) .ne. 8) stop 3
end block
end associate
associate (z => parm)
block
integer(len(z)) :: a
if (kind(a) .ne. 4) stop 4
end block
end associate
end