[Bug fortran/49638] [OOP] length parameter is ignored when overriding type bound character functions with constant length.

[janus at gcc dot gnu.org]

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

--- Comment #3 from janus at gcc dot gnu.org 2011-07-31 11:05:24 UTC ---
A check for different ranks can be added like this:


Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c    (revision 176967)
+++ gcc/fortran/interface.c    (working copy)
@@ -501,7 +501,7 @@ gfc_compare_types (gfc_typespec *ts1, gfc_typespec
    and types.  Returns nonzero if they have the same rank and type,
    zero otherwise.  */

-static int
+int
 compare_type_rank (gfc_symbol *s1, gfc_symbol *s2)
 {
   int r1, r2;
Index: gcc/fortran/gfortran.h
===================================================================
--- gcc/fortran/gfortran.h    (revision 176967)
+++ gcc/fortran/gfortran.h    (working copy)
@@ -2810,6 +2810,7 @@ gfc_try gfc_ref_dimen_size (gfc_array_ref *, int d
 void gfc_free_interface (gfc_interface *);
 int gfc_compare_derived_types (gfc_symbol *, gfc_symbol *);
 int gfc_compare_types (gfc_typespec *, gfc_typespec *);
+int compare_type_rank (gfc_symbol *, gfc_symbol *);
 int gfc_compare_interfaces (gfc_symbol*, gfc_symbol*, const char *, int, int,
                 char *, int);
 void gfc_check_interfaces (gfc_namespace *);
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c    (revision 176971)
+++ gcc/fortran/resolve.c    (working copy)
@@ -10760,11 +10760,10 @@ check_typebound_override (gfc_symtree* proc, gfc_s
       /* FIXME:  Do more comprehensive checking (including, for instance, the
      rank and array-shape).  */
       gcc_assert (proc_target->result && old_target->result);
-      if (!gfc_compare_types (&proc_target->result->ts,
-                  &old_target->result->ts))
+      if (!compare_type_rank (proc_target->result, old_target->result))
     {
       gfc_error ("'%s' at %L and the overridden FUNCTION should have"
-             " matching result types", proc->name, &where);
+             " matching result types and ranks", proc->name, &where);