expr.c (gfc_check_pointer_assign): Verify that rank of the LHS and RHS match.

* expr.c (gfc_check_pointer_assign): Verify that rank of the LHS
and RHS match. Return early if the RHS is NULL().

From-SVN: r84458

gcc/fortran/ChangeLog

 2004-07-10  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
 
+	* expr.c (gfc_check_pointer_assign): Verify that rank of the LHS
+	and RHS match. Return early if the RHS is NULL().
+
+2004-07-10  Tobias Schlueter  <tobias.schlueter@physik.uni-muenchen.de>
+
 	* trans-common.c: Fix whitespace issues, make variable names
 	more readable.
 	(create_common): Additionally, make loop logic more obvious.

gcc/fortran/expr.c

@@ -1807,8 +1807,8 @@ gfc_check_pointer_assign (gfc_expr * lvalue, gfc_expr * rvalue)
   /* If rvalue is a NULL() or NULLIFY, we're done. Otherwise the type,
      kind, etc for lvalue and rvalue must match, and rvalue must be a
      pure variable if we're in a pure function.  */
-  if (rvalue->expr_type != EXPR_NULL)
-    {
+  if (rvalue->expr_type == EXPR_NULL)
+    return SUCCESS;
 
   if (!gfc_compare_types (&lvalue->ts, &rvalue->ts))
     {
@@ -1819,27 +1819,30 @@ gfc_check_pointer_assign (gfc_expr * lvalue, gfc_expr * rvalue)
 
   if (lvalue->ts.kind != rvalue->ts.kind)
     {
-	  gfc_error
-	    ("Different kind type parameters in pointer assignment at %L",
-	     &lvalue->where);
+      gfc_error	("Different kind type parameters in pointer "
+		 "assignment at %L", &lvalue->where);
       return FAILURE;
     }
 
   attr = gfc_expr_attr (rvalue);
   if (!attr.target && !attr.pointer)
     {
-	  gfc_error
-	    ("Pointer assignment target is neither TARGET nor POINTER at "
-	     "%L", &rvalue->where);
+      gfc_error	("Pointer assignment target is neither TARGET "
+		 "nor POINTER at %L", &rvalue->where);
       return FAILURE;
     }
 
   if (is_pure && gfc_impure_variable (rvalue->symtree->n.sym))
     {
-	  gfc_error
-	    ("Bad target in pointer assignment in PURE procedure at %L",
-	     &rvalue->where);
+      gfc_error	("Bad target in pointer assignment in PURE "
+		 "procedure at %L", &rvalue->where);
     }
+
+  if (lvalue->rank != rvalue->rank)
+    {
+      gfc_error ("Unequal ranks %d and %d in pointer assignment at %L", 
+		 lvalue->rank, rvalue->rank, &rvalue->where);
+      return FAILURE;
     }
 
   return SUCCESS;