re PR fortran/56852 (ICE on invalid: "Bad array reference" for an undeclared loop variable)
2013-04-09 Paul Thomas <pault@gcc.gnu.org> PR fortran/56852 * primary.c (gfc_variable_attr): Avoid ICE on AR_UNKNOWN if any of the index variables are untyped and errors are present. 2013-04-09 Paul Thomas <pault@gcc.gnu.org> PR fortran/56852 * gfortran.dg/pr56852.f90 : New test From-SVN: r221955
This commit is contained in:
Paul Thomas
parent
86c5a5c3bb
commit
bf1b77dd09
|
|
@ -1,3 +1,9 @@
|
|||
2013-04-09 Paul Thomas <pault@gcc.gnu.org>
|
||||
|
||||
PR fortran/56852
|
||||
* primary.c (gfc_variable_attr): Avoid ICE on AR_UNKNOWN if any
|
||||
of the index variables are untyped and errors are present.
|
||||
|
||||
2015-04-07 Andre Vehreschild <vehre@gmx.de>
|
||||
|
||||
PR fortran/65548
|
||||
|
|
@ -63,7 +69,7 @@
|
|||
then, which calls ->vptr->copy () with four arguments adding
|
||||
the length information ->vptr->copy(from, to, from_len, to_cap).
|
||||
(gfc_conv_procedure_call): Switch to new function name for
|
||||
getting a class' vtab's field.
|
||||
getting a class' vtab's field.
|
||||
(alloc_scalar_allocatable_for_assignment): Use the string_length
|
||||
as computed by gfc_conv_expr and not the statically backend_decl
|
||||
which may be incorrect when ref-ing.
|
||||
|
|
@ -88,7 +94,7 @@
|
|||
Added gfc_find_and_cut_at_last_class_ref () and
|
||||
gfc_reset_len () routine prototype. Added flag to
|
||||
gfc_copy_class_to_class () prototype to signal an unlimited
|
||||
polymorphic entity to copy.
|
||||
polymorphic entity to copy.
|
||||
|
||||
2015-03-24 Iain Sandoe <iain@codesourcery.com>
|
||||
Tobias Burnus <burnus@net-b.de>
|
||||
|
|
|
|||
|
|
@ -143,8 +143,8 @@ gfc_check_digit (char c, int radix)
|
|||
|
||||
|
||||
/* Match the digit string part of an integer if signflag is not set,
|
||||
the signed digit string part if signflag is set. If the buffer
|
||||
is NULL, we just count characters for the resolution pass. Returns
|
||||
the signed digit string part if signflag is set. If the buffer
|
||||
is NULL, we just count characters for the resolution pass. Returns
|
||||
the number of characters matched, -1 for no match. */
|
||||
|
||||
static int
|
||||
|
|
@ -192,7 +192,7 @@ match_digits (int signflag, int radix, char *buffer)
|
|||
}
|
||||
|
||||
|
||||
/* Match an integer (digit string and optional kind).
|
||||
/* Match an integer (digit string and optional kind).
|
||||
A sign will be accepted if signflag is set. */
|
||||
|
||||
static match
|
||||
|
|
@ -259,7 +259,7 @@ match_hollerith_constant (gfc_expr **result)
|
|||
gfc_expr *e = NULL;
|
||||
const char *msg;
|
||||
int num, pad;
|
||||
int i;
|
||||
int i;
|
||||
|
||||
old_loc = gfc_current_locus;
|
||||
gfc_gobble_whitespace ();
|
||||
|
|
@ -518,7 +518,7 @@ match_real_constant (gfc_expr **result, int signflag)
|
|||
if (seen_dp)
|
||||
goto done;
|
||||
|
||||
/* Check to see if "." goes with a following operator like
|
||||
/* Check to see if "." goes with a following operator like
|
||||
".eq.". */
|
||||
temp_loc = gfc_current_locus;
|
||||
c = gfc_next_ascii_char ();
|
||||
|
|
@ -1504,7 +1504,7 @@ match_actual_arg (gfc_expr **result)
|
|||
|
||||
if (sym->attr.in_common && !sym->attr.proc_pointer)
|
||||
{
|
||||
if (!gfc_add_flavor (&sym->attr, FL_VARIABLE,
|
||||
if (!gfc_add_flavor (&sym->attr, FL_VARIABLE,
|
||||
sym->name, &sym->declared_at))
|
||||
return MATCH_ERROR;
|
||||
break;
|
||||
|
|
@ -2138,7 +2138,7 @@ check_substring:
|
|||
symbol_attribute
|
||||
gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts)
|
||||
{
|
||||
int dimension, codimension, pointer, allocatable, target;
|
||||
int dimension, codimension, pointer, allocatable, target, n;
|
||||
symbol_attribute attr;
|
||||
gfc_ref *ref;
|
||||
gfc_symbol *sym;
|
||||
|
|
@ -2195,7 +2195,25 @@ gfc_variable_attr (gfc_expr *expr, gfc_typespec *ts)
|
|||
break;
|
||||
|
||||
case AR_UNKNOWN:
|
||||
gfc_internal_error ("gfc_variable_attr(): Bad array reference");
|
||||
/* If any of start, end or stride is not integer, there will
|
||||
already have been an error issued. */
|
||||
for (n = 0; n < ref->u.ar.as->rank; n++)
|
||||
{
|
||||
int errors;
|
||||
gfc_get_errors (NULL, &errors);
|
||||
if (((ref->u.ar.start[n]
|
||||
&& ref->u.ar.start[n]->ts.type == BT_UNKNOWN)
|
||||
||
|
||||
(ref->u.ar.end[n]
|
||||
&& ref->u.ar.end[n]->ts.type == BT_UNKNOWN)
|
||||
||
|
||||
(ref->u.ar.stride[n]
|
||||
&& ref->u.ar.stride[n]->ts.type == BT_UNKNOWN))
|
||||
&& errors > 0)
|
||||
break;
|
||||
}
|
||||
if (n == ref->u.ar.as->rank)
|
||||
gfc_internal_error ("gfc_variable_attr(): Bad array reference");
|
||||
}
|
||||
|
||||
break;
|
||||
|
|
@ -2347,8 +2365,8 @@ build_actual_constructor (gfc_structure_ctor_component **comp_head,
|
|||
&gfc_current_locus);
|
||||
value->ts = comp->ts;
|
||||
|
||||
if (!build_actual_constructor (comp_head,
|
||||
&value->value.constructor,
|
||||
if (!build_actual_constructor (comp_head,
|
||||
&value->value.constructor,
|
||||
comp->ts.u.derived))
|
||||
{
|
||||
gfc_free_expr (value);
|
||||
|
|
@ -2500,7 +2518,7 @@ gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **c
|
|||
actual->expr = NULL;
|
||||
|
||||
/* Check if this component is already given a value. */
|
||||
for (comp_iter = comp_head; comp_iter != comp_tail;
|
||||
for (comp_iter = comp_head; comp_iter != comp_tail;
|
||||
comp_iter = comp_iter->next)
|
||||
{
|
||||
gcc_assert (comp_iter);
|
||||
|
|
@ -2597,13 +2615,13 @@ gfc_convert_to_structure_constructor (gfc_expr *e, gfc_symbol *sym, gfc_expr **c
|
|||
expr->expr_type = EXPR_STRUCTURE;
|
||||
}
|
||||
|
||||
gfc_current_locus = old_locus;
|
||||
gfc_current_locus = old_locus;
|
||||
if (parent)
|
||||
*arglist = actual;
|
||||
return true;
|
||||
|
||||
cleanup:
|
||||
gfc_current_locus = old_locus;
|
||||
gfc_current_locus = old_locus;
|
||||
|
||||
for (comp_iter = comp_head; comp_iter; )
|
||||
{
|
||||
|
|
@ -2770,7 +2788,7 @@ gfc_match_rvalue (gfc_expr **result)
|
|||
|| sym->ns == gfc_current_ns->parent))
|
||||
{
|
||||
gfc_entry_list *el = NULL;
|
||||
|
||||
|
||||
for (el = sym->ns->entries; el; el = el->next)
|
||||
if (sym == el->sym)
|
||||
goto variable;
|
||||
|
|
@ -2800,7 +2818,7 @@ gfc_match_rvalue (gfc_expr **result)
|
|||
|
||||
case FL_PARAMETER:
|
||||
/* A statement of the form "REAL, parameter :: a(0:10) = 1" will
|
||||
end up here. Unfortunately, sym->value->expr_type is set to
|
||||
end up here. Unfortunately, sym->value->expr_type is set to
|
||||
EXPR_CONSTANT, and so the if () branch would be followed without
|
||||
the !sym->as check. */
|
||||
if (sym->value && sym->value->expr_type != EXPR_ARRAY && !sym->as)
|
||||
|
|
@ -3058,7 +3076,7 @@ gfc_match_rvalue (gfc_expr **result)
|
|||
if (m2 != MATCH_YES)
|
||||
{
|
||||
/* Try to figure out whether we're dealing with a character type.
|
||||
We're peeking ahead here, because we don't want to call
|
||||
We're peeking ahead here, because we don't want to call
|
||||
match_substring if we're dealing with an implicitly typed
|
||||
non-character variable. */
|
||||
implicit_char = false;
|
||||
|
|
@ -3079,7 +3097,7 @@ gfc_match_rvalue (gfc_expr **result)
|
|||
e->expr_type = EXPR_VARIABLE;
|
||||
|
||||
if (sym->attr.flavor != FL_VARIABLE
|
||||
&& !gfc_add_flavor (&sym->attr, FL_VARIABLE,
|
||||
&& !gfc_add_flavor (&sym->attr, FL_VARIABLE,
|
||||
sym->name, NULL))
|
||||
{
|
||||
m = MATCH_ERROR;
|
||||
|
|
@ -3300,7 +3318,7 @@ match_variable (gfc_expr **result, int equiv_flag, int host_flag)
|
|||
implicit_ns = gfc_current_ns;
|
||||
else
|
||||
implicit_ns = sym->ns;
|
||||
|
||||
|
||||
if (gfc_peek_ascii_char () == '%'
|
||||
&& sym->ts.type == BT_UNKNOWN
|
||||
&& gfc_get_default_type (sym->name, implicit_ns)->type == BT_DERIVED)
|
||||
|
|
|
|||
|
|
@ -1,3 +1,8 @@
|
|||
2013-04-09 Paul Thomas <pault@gcc.gnu.org>
|
||||
|
||||
PR fortran/56852
|
||||
* gfortran.dg/pr56852.f90 : New test
|
||||
|
||||
2015-04-09 Marek Polacek <polacek@redhat.com>
|
||||
Jakub Jelinek <jakub@redhat.com>
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,11 @@
|
|||
! { dg-do compile }
|
||||
! Test the fix for pr56852, where an ICE would occur after the error.
|
||||
!
|
||||
! Contributed by Lorenz Huedepohl <bugs@stellardeath.org>
|
||||
!
|
||||
program test
|
||||
implicit none
|
||||
real :: a(4)
|
||||
! integer :: i
|
||||
read(0) (a(i),i=1,4) ! { dg-error "has no IMPLICIT type" }
|
||||
end program
|
||||
Loading…
Reference in New Issue