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.
@@ -2732,14 +2732,19 @@ 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_current_intrinsic_arg[0]->name,
+ gfc_error ("'%s' argument of '%s' intrinsic at %L must be a POINTER or "
+ "ALLOCATABLE", 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;
@@ -0,0 +1,43 @@
+! { dg-do compile }
+! { dg-options "-std=f95" }
+!
+! PR fortran/34547
+! PR fortran/50375
+
+subroutine test_PR50375_1 ()
+ ! Contributed by Vittorio Zecca
+ interface gen1
+ subroutine s11 (pi)
+ integer, pointer :: pi
+ end subroutine
+ subroutine s12 (pr)
+ real, pointer :: pr
+ end subroutine
+ end interface
+ call gen1 (null ()) ! { dg-error "MOLD= required in NULL|There is no specific subroutine" }
+end subroutine test_PR50375_1
+
+subroutine test_PR50375_2 ()
+ interface gen2
+ subroutine s21 (pi)
+ integer, pointer :: pi
+ end subroutine
+ subroutine s22 (pr)
+ real, optional :: pr
+ end subroutine
+ end interface
+ call gen2 (null ()) ! OK in F95/F2003 (but not in F2008)
+end subroutine test_PR50375_2
+
+subroutine test_PR34547_1 ()
+ call proc (null ()) ! { dg-error "MOLD argument to NULL required" }
+end subroutine test_PR34547_1
+
+subroutine test_PR34547_2 ()
+ print *, null () ! { dg-error "in data transfer statement requires MOLD" }
+end subroutine test_PR34547_2
+
+subroutine test_PR34547_3 ()
+ integer, allocatable :: i(:)
+ print *, NULL(i) ! { dg-error "Fortran 2003: NULL intrinsic with allocatable MOLD" }
+end subroutine test_PR34547_3
@@ -0,0 +1,34 @@
+! { dg-do compile }
+! { dg-options "-std=f2008" }
+!
+! PR fortran/34547
+! PR fortran/50375
+
+subroutine test_PR50375_3 ()
+ interface gen3
+ subroutine s31 (pi)
+ integer, pointer :: pi
+ end subroutine
+ subroutine s32 (pr)
+ real, allocatable :: pr(:)
+ end subroutine
+ end interface
+ call gen3 (null ()) ! OK
+end subroutine test_PR50375_3
+
+subroutine test_PR50375_2 ()
+ interface gen2
+ subroutine s21 (pi)
+ integer, pointer :: pi
+ end subroutine
+ subroutine s22 (pr)
+ real, optional :: pr
+ end subroutine
+ end interface
+ call gen2 (null ()) ! { dg-error "MOLD= required in NULL|There is no specific subroutine" }
+end subroutine test_PR50375_2
+
+subroutine test_PR34547_3 ()
+ integer, allocatable :: i(:)
+ print *, NULL(i)
+end subroutine test_PR34547_3