This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[Patch, Fortran] PR 42936 - passing NULL() to array dummy


Hello,

another simple patch.

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

Tobias
2010-02-02  Tobias Burnus  <burnus@net-b.de>

	PR fortran/42936
	* interface.c (compare_parameter): Disable rank-checking
	for NULL().

2010-02-02  Tobias Burnus  <burnus@net-b.de>

	PR fortran/42936
	* gfortran.dg/null_4.f90: New test.

Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c	(revision 156452)
+++ gcc/fortran/interface.c	(working copy)
@@ -1449,9 +1449,11 @@ compare_parameter (gfc_symbol *formal, g
 
   rank_check = where != NULL && !is_elemental && formal->as
 	       && (formal->as->type == AS_ASSUMED_SHAPE
-		   || formal->as->type == AS_DEFERRED);
+		   || formal->as->type == AS_DEFERRED)
+	       && actual->expr_type != EXPR_NULL;
 
-  if (rank_check || ranks_must_agree || formal->attr.pointer
+  if (rank_check || ranks_must_agree
+      || (formal->attr.pointer && actual->expr_type != EXPR_NULL)
       || (actual->rank != 0 && !(is_elemental || formal->attr.dimension))
       || (actual->rank == 0 && formal->as->type == AS_ASSUMED_SHAPE))
     {
@@ -1493,7 +1495,7 @@ compare_parameter (gfc_symbol *formal, g
       else
 	return 1;
     }
-  else if (ref == NULL)
+  else if (ref == NULL && actual->expr_type != EXPR_NULL)
     {
       if (where)
 	gfc_error ("Rank mismatch in argument '%s' at %L (%d and %d)",
Index: gcc/testsuite/gfortran.dg/null_4.f90
===================================================================
--- gcc/testsuite/gfortran.dg/null_4.f90	(revision 0)
+++ gcc/testsuite/gfortran.dg/null_4.f90	(revision 0)
@@ -0,0 +1,14 @@
+! { dg-do run }
+!
+! PR fortran/42936
+!
+! Contributed by Mat Cross
+!
+PROGRAM PASSES_NULL
+  CALL SUB(NULL())
+CONTAINS
+  SUBROUTINE SUB(I)
+    INTEGER, POINTER :: I(:,:,:)
+    IF (ASSOCIATED (I)) CALL ABORT ()
+  END SUBROUTINE SUB
+END PROGRAM PASSES_NULL

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]