mirror of git://gcc.gnu.org/git/gcc.git
re PR fortran/34547 (NULL(): Fortran 2003 changes, accepts invalid, ICE on invalid)
2011-09-14 Tobias Burnus <burnus@net-b.de>
PR fortran/34547
PR fortran/50375
* check.c (gfc_check_null): Allow allocatables as MOLD to NULL.
* resolve.c (resolve_transfer): Reject NULL without MOLD.
* interface.c (gfc_procedure_use): Reject NULL without MOLD
if no explicit interface is known.
(gfc_search_interface): Reject NULL without MOLD if it would
lead to ambiguity.
2011-09-14 Tobias Burnus <burnus@net-b.de>
PR fortran/34547
PR fortran/50375
* gfortran.dg/null_5.f90: New.
* gfortran.dg/null_6.f90: New.
From-SVN: r178841
This commit is contained in:
parent
95a45b570d
commit
ea8ad3e527
|
|
@ -1,3 +1,14 @@
|
|||
2011-09-14 Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
PR fortran/34547
|
||||
PR fortran/50375
|
||||
* check.c (gfc_check_null): Allow allocatables as MOLD to NULL.
|
||||
* resolve.c (resolve_transfer): Reject NULL without MOLD.
|
||||
* interface.c (gfc_procedure_use): Reject NULL without MOLD
|
||||
if no explicit interface is known.
|
||||
(gfc_search_interface): Reject NULL without MOLD if it would
|
||||
lead to ambiguity.
|
||||
|
||||
2011-09-13 Janus Weil <janus@gcc.gnu.org>
|
||||
|
||||
PR fortran/50379
|
||||
|
|
|
|||
|
|
@ -2732,14 +2732,20 @@ gfc_check_null (gfc_expr *mold)
|
|||
|
||||
attr = gfc_variable_attr (mold, NULL);
|
||||
|
||||
if (!attr.pointer && !attr.proc_pointer)
|
||||
if (!attr.pointer && !attr.proc_pointer && !attr.allocatable)
|
||||
{
|
||||
gfc_error ("'%s' argument of '%s' intrinsic at %L must be a POINTER",
|
||||
gfc_error ("'%s' argument of '%s' intrinsic at %L must be a POINTER, "
|
||||
"ALLOCATABLE or procedure pointer",
|
||||
gfc_current_intrinsic_arg[0]->name,
|
||||
gfc_current_intrinsic, &mold->where);
|
||||
return FAILURE;
|
||||
}
|
||||
|
||||
if (attr.allocatable
|
||||
&& gfc_notify_std (GFC_STD_F2003, "Fortran 2003: NULL intrinsic with "
|
||||
"allocatable MOLD at %L", &mold->where) == FAILURE)
|
||||
return FAILURE;
|
||||
|
||||
/* F2008, C1242. */
|
||||
if (gfc_is_coindexed (mold))
|
||||
{
|
||||
|
|
|
|||
|
|
@ -2857,6 +2857,13 @@ gfc_procedure_use (gfc_symbol *sym, gfc_actual_arglist **ap, locus *where)
|
|||
"procedure '%s'", &a->expr->where, sym->name);
|
||||
break;
|
||||
}
|
||||
|
||||
if (a->expr && a->expr->expr_type == EXPR_NULL
|
||||
&& a->expr->ts.type == BT_UNKNOWN)
|
||||
{
|
||||
gfc_error ("MOLD argument to NULL required at %L", &a->expr->where);
|
||||
return;
|
||||
}
|
||||
}
|
||||
|
||||
return;
|
||||
|
|
@ -2949,6 +2956,20 @@ gfc_search_interface (gfc_interface *intr, int sub_flag,
|
|||
gfc_actual_arglist **ap)
|
||||
{
|
||||
gfc_symbol *elem_sym = NULL;
|
||||
gfc_symbol *null_sym = NULL;
|
||||
locus null_expr_loc;
|
||||
gfc_actual_arglist *a;
|
||||
bool has_null_arg = false;
|
||||
|
||||
for (a = *ap; a; a = a->next)
|
||||
if (a->expr && a->expr->expr_type == EXPR_NULL
|
||||
&& a->expr->ts.type == BT_UNKNOWN)
|
||||
{
|
||||
has_null_arg = true;
|
||||
null_expr_loc = a->expr->where;
|
||||
break;
|
||||
}
|
||||
|
||||
for (; intr; intr = intr->next)
|
||||
{
|
||||
if (sub_flag && intr->sym->attr.function)
|
||||
|
|
@ -2958,6 +2979,19 @@ gfc_search_interface (gfc_interface *intr, int sub_flag,
|
|||
|
||||
if (gfc_arglist_matches_symbol (ap, intr->sym))
|
||||
{
|
||||
if (has_null_arg && null_sym)
|
||||
{
|
||||
gfc_error ("MOLD= required in NULL() argument at %L: Ambiguity "
|
||||
"between specific functions %s and %s",
|
||||
&null_expr_loc, null_sym->name, intr->sym->name);
|
||||
return NULL;
|
||||
}
|
||||
else if (has_null_arg)
|
||||
{
|
||||
null_sym = intr->sym;
|
||||
continue;
|
||||
}
|
||||
|
||||
/* Satisfy 12.4.4.1 such that an elemental match has lower
|
||||
weight than a non-elemental match. */
|
||||
if (intr->sym->attr.elemental)
|
||||
|
|
@ -2969,6 +3003,9 @@ gfc_search_interface (gfc_interface *intr, int sub_flag,
|
|||
}
|
||||
}
|
||||
|
||||
if (null_sym)
|
||||
return null_sym;
|
||||
|
||||
return elem_sym ? elem_sym : NULL;
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -8150,6 +8150,13 @@ resolve_transfer (gfc_code *code)
|
|||
&& exp->value.op.op == INTRINSIC_PARENTHESES)
|
||||
exp = exp->value.op.op1;
|
||||
|
||||
if (exp && exp->expr_type == EXPR_NULL && exp->ts.type == BT_UNKNOWN)
|
||||
{
|
||||
gfc_error ("NULL intrinsic at %L in data transfer statement requires "
|
||||
"MOLD=", &exp->where);
|
||||
return;
|
||||
}
|
||||
|
||||
if (exp == NULL || (exp->expr_type != EXPR_VARIABLE
|
||||
&& exp->expr_type != EXPR_FUNCTION))
|
||||
return;
|
||||
|
|
|
|||
|
|
@ -1,3 +1,10 @@
|
|||
2011-09-14 Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
PR fortran/34547
|
||||
PR fortran/50375
|
||||
* gfortran.dg/null_5.f90: New.
|
||||
* gfortran.dg/null_6.f90: New.
|
||||
|
||||
2011-09-13 Bernd Schmidt <bernds@codesourcery.com>
|
||||
|
||||
* gcc.c-torture/compile/20110913-1.c: New test.
|
||||
|
|
|
|||
Loading…
Reference in New Issue