From ea8ad3e527332487c4e395a95d9588873a58a99b Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Wed, 14 Sep 2011 08:26:07 +0200 Subject: [PATCH] re PR fortran/34547 (NULL(): Fortran 2003 changes, accepts invalid, ICE on invalid) 2011-09-14 Tobias Burnus 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 PR fortran/34547 PR fortran/50375 * gfortran.dg/null_5.f90: New. * gfortran.dg/null_6.f90: New. From-SVN: r178841 --- gcc/fortran/ChangeLog | 11 +++++++++++ gcc/fortran/check.c | 10 ++++++++-- gcc/fortran/interface.c | 37 +++++++++++++++++++++++++++++++++++++ gcc/fortran/resolve.c | 7 +++++++ gcc/testsuite/ChangeLog | 7 +++++++ 5 files changed, 70 insertions(+), 2 deletions(-) diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 6e82538cc31..eeb462f7fc2 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,14 @@ +2011-09-14 Tobias Burnus + + 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 PR fortran/50379 diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 3d4f4c88378..5b692eec151 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -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)) { diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c index a9b3d702727..7962403a505 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.c @@ -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; } diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index b038402ac29..9aab8365e45 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -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; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 95a064337cb..5488b1cf484 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,10 @@ +2011-09-14 Tobias Burnus + + PR fortran/34547 + PR fortran/50375 + * gfortran.dg/null_5.f90: New. + * gfortran.dg/null_6.f90: New. + 2011-09-13 Bernd Schmidt * gcc.c-torture/compile/20110913-1.c: New test. -- 2.30.2