PR fortran/19754

* resolve.c (compare_shapes):  New function.
(resolve_operator): Use it.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@95945 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 1490ed1..514b29a 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2005-03-05  Steven G. Kargl  <kargls@comcast.net> 
+
+       PR fortran/19754
+       * resolve.c (compare_shapes):  New function.
+       (resolve_operator): Use it.
+
 2005-03-05  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
 
        * trans-const.c (gfc_conv_constant_to_tree): Use correct tree

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 4d98f46..126f21f 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -1249,6 +1249,36 @@ resolve_call (gfc_code * c)
   return t;
 }
 
+/* Compare the shapes of two arrays that have non-NULL shapes.  If both
+   op1->shape and op2->shape are non-NULL return SUCCESS if their shapes
+   match.  If both op1->shape and op2->shape are non-NULL return FAILURE
+   if their shapes do not match.  If either op1->shape or op2->shape is
+   NULL, return SUCCESS.  */
+
+static try
+compare_shapes (gfc_expr * op1, gfc_expr * op2)
+{
+  try t;
+  int i;
+
+  t = SUCCESS;
+                 
+  if (op1->shape != NULL && op2->shape != NULL)
+    {
+      for (i = 0; i < op1->rank; i++)
+       {
+         if (mpz_cmp (op1->shape[i], op2->shape[i]) != 0)
+          {
+            gfc_error ("Shapes for operands at %L and %L are not conformable",
+                        &op1->where, &op2->where);
+            t = FAILURE;
+            break;
+          }
+       }
+    }
+
+  return t;
+}
 
 /* Resolve an operator expression node.  This can involve replacing the
    operation with a user defined function call.  */
@@ -1460,10 +1490,14 @@ resolve_operator (gfc_expr * e)
          if (op1->rank == op2->rank)
            {
              e->rank = op1->rank;
-
              if (e->shape == NULL)
+               {
+                 t = compare_shapes(op1, op2);
+                 if (t == FAILURE)
+                   e->shape = NULL;
+                 else
                e->shape = gfc_copy_shape (op1->shape, op1->rank);
-
+               }
            }
          else
            {
@@ -1499,10 +1533,12 @@ resolve_operator (gfc_expr * e)
   return t;
 
 bad_op:
+
   if (gfc_extend_expr (e) == SUCCESS)
     return SUCCESS;
 
   gfc_error (msg, &e->where);
+
   return FAILURE;
 }