re PR fortran/42936 (Result of passing NULL() as actual arg doesn't inherit…

re PR fortran/42936 (Result of passing NULL() as actual arg doesn't inherit characteristics from the corresponding dummy arg)

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

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

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

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

From-SVN: r156461

gcc/fortran/ChangeLog

+2010-02-03  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/42650

gcc/fortran/interface.c

@@ -1449,9 +1449,11 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
 
   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, gfc_expr *actual,
       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)",

gcc/testsuite/ChangeLog

+2010-02-03  Tobias Burnus  <burnus@net-b.de>
+
+	PR fortran/42936
+	* gfortran.dg/null_4.f90: New test.
+
 2010-02-02  Jason Merrill  <jason@redhat.com>
 
 	PR c++/41090

gcc/testsuite/gfortran.dg/null_4.f90

+! { 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