------- Comment #1 from pault at gcc dot gnu dot org  2009-12-18 06:47 -------
This fixes it and even bootstraps and regtests:

Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c     (revision 155192)
+++ gcc/fortran/interface.c     (working copy)
@@ -1375,6 +1375,29 @@
 }


+
+static void
+argument_rank_mismatch (const char *name, locus *where,
+                       int rank1, int rank2)
+{
+  if (rank1 == 0)
+    {
+      gfc_error ("Rank mismatch in argument '%s' at %L "
+                "(scalar and rank-%d)", name, where, rank2);
+    }
+  if (rank2 == 0)
+    {
+      gfc_error ("Rank mismatch in argument '%s' at %L "
+                "(rank-%d and scalar)", name, where, rank1);
+    }
+  else
+    {    
+      gfc_error ("Rank mismatch in argument '%s' at %L "
+                "(rank-%d and rank-%d)", name, where, rank1, rank2);
+    }
+}
+
+
 /* Given a symbol of a formal argument list and an expression, see if
    the two are compatible as arguments.  Returns nonzero if
    compatible, zero if not compatible.  */
@@ -1456,9 +1479,8 @@
       || (actual->rank == 0 && formal->as->type == AS_ASSUMED_SHAPE))
     {
       if (where)
-       gfc_error ("Rank mismatch in argument '%s' at %L (%d and %d)",
-                  formal->name, &actual->where, symbol_rank (formal),
-                  actual->rank);
+       argument_rank_mismatch (formal->name, &actual->where,
+                               symbol_rank (formal), actual->rank);
       return 0;
     }
   else if (actual->rank != 0 && (is_elemental || formal->attr.dimension))
@@ -1496,9 +1518,8 @@
   else if (ref == NULL)
     {
       if (where)
-       gfc_error ("Rank mismatch in argument '%s' at %L (%d and %d)",
-                  formal->name, &actual->where, symbol_rank (formal),
-                  actual->rank);
+       argument_rank_mismatch (formal->name, &actual->where,
+                               symbol_rank (formal), actual->rank);
       return 0;
     }


Cheers

Paul


-- 

pault at gcc dot gnu dot org changed:

           What    |Removed                     |Added
----------------------------------------------------------------------------
         AssignedTo|unassigned at gcc dot gnu   |pault at gcc dot gnu dot org
                   |dot org                     |
             Status|UNCONFIRMED                 |ASSIGNED
     Ever Confirmed|0                           |1
   Last reconfirmed|0000-00-00 00:00:00         |2009-12-18 06:47:14
               date|                            |


http://gcc.gnu.org/bugzilla/show_bug.cgi?id=40158

Reply via email to