Skip to content

R
riscv-gcc-1
Commit 5b3b1d09 by Paul Thomas
Options

re PR fortran/38907 (ICE when contained function has same name as module… 

re PR fortran/38907 (ICE when contained function has same name as module function and used in expression)

2009-01-20  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/38907
	* resolve.c (check_host_association): Remove the matching to
	correct an incorrect host association and use manipulation of
	the expression instead.

2009-01-20  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/38907
	* gfortran.dg/host_assoc_function_7.f90: New test.

From-SVN: r143530
parent 53f506ed
Showing with 112 additions and 31 deletions
gcc/fortran/ChangeLog
2009-01-20 Paul Thomas <pault@gcc.gnu.org>
PR fortran/38907
* resolve.c (check_host_association): Remove the matching to
correct an incorrect host association and use manipulation of
the expression instead.
2009-01-20 Tobias Burnus <burnus@net-b.de>
* invoke.texi (RANGE): RANGE also takes INTEGER arguments.
......
gcc/fortran/resolve.c
......@@ -4289,15 +4289,17 @@ resolve_procedure:
/* Checks to see that the correct symbol has been host associated.
The only situation where this arises is that in which a twice
contained function is parsed after the host association is made.
Therefore, on detecting this, the line is rematched, having got
rid of the existing references and actual_arg_list. */
Therefore, on detecting this, change the symbol in the expression
and convert the array reference into an actual arglist if the old
symbol is a variable. */
static bool
check_host_association (gfc_expr *e)
{
gfc_symbol *sym, *old_sym;
locus temp_locus;
gfc_expr *expr;
gfc_symtree *st;
int n;
gfc_ref *ref;
gfc_actual_arglist *arg, *tail;
bool retval = e->expr_type == EXPR_FUNCTION;
/* If the expression is the result of substitution in
......@@ -4313,26 +4315,16 @@ check_host_association (gfc_expr *e)
if (gfc_current_ns->parent
&& old_sym->ns != gfc_current_ns)
{
/* Use the 'USE' name so that renamed module symbols are
correctly handled. */
gfc_find_symbol (e->symtree->name, gfc_current_ns, 1, &sym);
if (sym && old_sym != sym
&& sym->ts.type == old_sym->ts.type
&& sym->attr.flavor == FL_PROCEDURE
&& sym->attr.contained)
{
temp_locus = gfc_current_locus;
gfc_current_locus = e->where;
gfc_buffer_error (1);
gfc_free_ref_list (e->ref);
e->ref = NULL;
if (retval)
{
gfc_free_actual_arglist (e->value.function.actual);
e->value.function.actual = NULL;
}
/* Clear the shape, since it might not be valid. */
if (e->shape != NULL)
{
for (n = 0; n < e->rank; n++)
......@@ -4341,22 +4333,58 @@ check_host_association (gfc_expr *e)
gfc_free (e->shape);
}
/* TODO - Replace this gfc_match_rvalue with a straight replacement of
actual arglists for function to function substitutions and with a
conversion of the reference list to an actual arglist in the case of
a variable to function replacement. This should be quite easy since
only integers and vectors can be involved. */
gfc_match_rvalue (&expr);
gfc_clear_error ();
gfc_buffer_error (0);
/* Give the symbol a symtree in the right place! */
gfc_get_sym_tree (sym->name, gfc_current_ns, &st);
st->n.sym = sym;
gcc_assert (expr && sym == expr->symtree->n.sym);
if (old_sym->attr.flavor == FL_PROCEDURE)
{
/* Original was function so point to the new symbol, since
the actual argument list is already attached to the
expression. */
e->value.function.esym = NULL;
e->symtree = st;
}
else
{
/* Original was variable so convert array references into
an actual arglist. This does not need any checking now
since gfc_resolve_function will take care of it. */
e->value.function.actual = NULL;
e->expr_type = EXPR_FUNCTION;
e->symtree = st;
*e = *expr;
gfc_free (expr);
sym->refs++;
/* Ambiguity will not arise if the array reference is not
the last reference. */
for (ref = e->ref; ref; ref = ref->next)
if (ref->type == REF_ARRAY && ref->next == NULL)
break;
gfc_current_locus = temp_locus;
gcc_assert (ref->type == REF_ARRAY);
/* Grab the start expressions from the array ref and
copy them into actual arguments. */
for (n = 0; n < ref->u.ar.dimen; n++)
{
arg = gfc_get_actual_arglist ();
arg->expr = gfc_copy_expr (ref->u.ar.start[n]);
if (e->value.function.actual == NULL)
tail = e->value.function.actual = arg;
else
{
tail->next = arg;
tail = arg;
}
}
/* Dump the reference list and set the rank. */
gfc_free_ref_list (e->ref);
e->ref = NULL;
e->rank = sym->as ? sym->as->rank : 0;
}
gfc_resolve_expr (e);
sym->refs++;
}
}
/* This might have changed! */
......
gcc/testsuite/ChangeLog
2009-01-20 Paul Thomas <pault@gcc.gnu.org>
PR fortran/38907
* gfortran.dg/host_assoc_function_7.f90: New test
2009-01-20 Andrew Pinski <andrew_pinski@playstation.sony.com>
Richard Guenther <rguenther@suse.de>
......
gcc/testsuite/gfortran.dg/host_assoc_function_7.f90 0 → 100644
! { dg-do run }
! Tests the fix for PR38907, in which any expressions, including unary plus,
! in front of the call to S_REAL_SUM_I (marked) would throw the mechanism
! for correcting invalid host association.
!
! Contributed by Dick Hendrickson <dick.hendrickson@gmail.com>
!
module sa0054_stuff
REAL :: S_REAL_SUM_2(10) = [(REAL (I), I = 1, 10)]
contains
ELEMENTAL FUNCTION S_REAL_SUM_I (A)
REAL :: S_REAL_SUM_I
REAL, INTENT(IN) :: A
X = 1.0
S_REAL_SUM_I = X
END FUNCTION S_REAL_SUM_I
SUBROUTINE SA0054 (RDA)
REAL RDA(:)
RDA = + S_REAL_SUM_I (RDA) ! Reported problem => ICE
RDA = RDA + S_REAL_SUM_2 (INT (RDA)) ! Also failed
CONTAINS
ELEMENTAL FUNCTION S_REAL_SUM_I (A)
REAL :: S_REAL_SUM_I
REAL, INTENT(IN) :: A
S_REAL_SUM_I = 2.0 * A
END FUNCTION S_REAL_SUM_I
ELEMENTAL FUNCTION S_REAL_SUM_2 (A)
REAL :: S_REAL_SUM_2
INTEGER, INTENT(IN) :: A
S_REAL_SUM_2 = 2.0 * A
END FUNCTION S_REAL_SUM_2
END SUBROUTINE
end module sa0054_stuff
use sa0054_stuff
REAL :: RDA(10) = [(REAL(I), I = 1, 10)]
call SA0054 (RDA)
IF (ANY (INT (RDA) .ne. [(6 * I, I = 1, 10)])) print *, rda
END
! { dg-final { cleanup-modules "sa0054_stuff" } }
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment