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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index f95d64a4345bc81769ebb68cba6a42157c19aad0..deb15661bb0867e74ca0215c6a1d38a7b2a45bd1 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+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

diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.c
index e9ed27040eee86ac4183e2afd6c8676d8fcd0b17..ad9f42a3f7c6305c041a35582e238f14eec369af 100644 (file)
--- a/gcc/fortran/expr.c
+++ b/gcc/fortran/expr.c
@@ -1807,39 +1807,42 @@ 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))
     {
+      gfc_error ("Different types in pointer assignment at %L",
+                &lvalue->where);
+      return FAILURE;
+    }
 
-      if (!gfc_compare_types (&lvalue->ts, &rvalue->ts))
-       {
-         gfc_error ("Different types in pointer assignment at %L",
-                    &lvalue->where);
-         return FAILURE;
-       }
+  if (lvalue->ts.kind != rvalue->ts.kind)
+    {
+      gfc_error        ("Different kind type parameters in pointer "
+                "assignment at %L", &lvalue->where);
+      return FAILURE;
+    }
 
-      if (lvalue->ts.kind != rvalue->ts.kind)
-       {
-         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);
+      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);
-         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);
+    }
 
-      if (is_pure && gfc_impure_variable (rvalue->symtree->n.sym))
-       {
-         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;