Patchwork [PRs,34547/50375] Fixes to NULL with MOLD= check

login
register
mail settings
Submitter Tobias Burnus
Date Sept. 13, 2011, 10:12 p.m.
Message ID <4E6FD554.5040206@net-b.de>
Download mbox | patch
Permalink /patch/114566/
State New
Headers show

Comments

Tobias Burnus - Sept. 13, 2011, 10:12 p.m.
NULL requires a MOLD argument if the mold cannot be determined from the 
context:

a) print *, null()   - was ICEing
b) call foo(null()) - [implicit interface] was accepted but no dummy is 
available to get the type
c) call generic(null()) - need to reject it, if it would match several 
specific functions
d) null(allocatable) - now allowed (F2003), was rejected before.

(c) is PR 50375, the rest is PR 34547; see PR for the quote from the 
standards.

Build and regtested on x86-64-linux.
OK for the trunk?

Tobias
Steve Kargl - Sept. 13, 2011, 10:31 p.m.
On Wed, Sep 14, 2011 at 12:12:36AM +0200, Tobias Burnus wrote:
> NULL requires a MOLD argument if the mold cannot be determined from the 
> context:
> 
> a) print *, null()   - was ICEing
> b) call foo(null()) - [implicit interface] was accepted but no dummy is 
> available to get the type
> c) call generic(null()) - need to reject it, if it would match several 
> specific functions
> d) null(allocatable) - now allowed (F2003), was rejected before.
> 
> (c) is PR 50375, the rest is PR 34547; see PR for the quote from the 
> standards.
> 
> Build and regtested on x86-64-linux.
> OK for the trunk?

Yes.

I was wondering if we need to change the error message
in the following code to include procedure pointer?

-  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;
     }

Should this be "... a POINTER, ALLOCATABLE, or PROCEDURE POINTER..."?
Tobias Burnus - Sept. 14, 2011, 6:35 a.m.
Steve Kargl wrote:
> I was wondering if we need to change the error message
> in the following code to include procedure pointer?
>
> +      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;
>       }
>
> Should this be "... a POINTER, ALLOCATABLE, or PROCEDURE POINTER..."?

Good suggestion. I have changed it accordingly - except that I wrote 
procedure pointer in minuscules.

Committed as Revs. 178841/178842.

Tobias

Patch

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.

diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c
index 3d4f4c8..1e9e719 100644
--- a/gcc/fortran/check.c
+++ b/gcc/fortran/check.c
@@ -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))
     {
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index a9b3d70..7962403 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 b038402..9aab836 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;

--- /dev/null	2011-09-13 08:06:22.075577943 +0200
+++ gcc/gcc/testsuite/gfortran.dg/null_5.f90	2011-09-13 23:58:13.000000000 +0200
@@ -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
--- /dev/null	2011-09-13 08:06:22.075577943 +0200
+++ gcc/gcc/testsuite/gfortran.dg/null_6.f90	2011-09-13 23:18:01.000000000 +0200
@@ -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