[Bug fortran/26716] [4.1,4.2 regression] gfortran: incorrect choice of overloaded function

["pault at gcc dot gnu dot org" <gcc-bugzilla at gcc dot gnu dot org>]

------- Comment #3 from pault at gcc dot gnu dot org  2006-03-17 18:02 -------
I have a patch that fixes this and regtests OK; I will get it ready for
submission tomorrow.

Index: gcc/fortran/interface.c
===================================================================
*** gcc/fortran/interface.c     (revision 112139)
--- gcc/fortran/interface.c     (working copy)
*************** compare_actual_formal (gfc_actual_arglis
*** 1178,1183 ****
--- 1178,1184 ----
    gfc_actual_arglist **new, *a, *actual, temp;
    gfc_formal_arglist *f;
    int i, n, na;
+   bool rank_check;

    actual = *ap;

*************** compare_actual_formal (gfc_actual_arglis
*** 1260,1270 ****
          return 0;
        }

        if (!compare_parameter
!         (f->sym, a->expr,
!          ranks_must_agree && f->sym->as
!            && f->sym->as->type == AS_ASSUMED_SHAPE,
!          is_elemental))
        {
          if (where)
            gfc_error ("Type/rank mismatch in argument '%s' at %L",
--- 1261,1274 ----
          return 0;
        }

+       rank_check = where != NULL
+                    && !is_elemental
+                    && f->sym->as
+                    && (f->sym->as->type == AS_ASSUMED_SHAPE
+                          || f->sym->as->type == AS_DEFERRED);
+ 
        if (!compare_parameter
!         (f->sym, a->expr, ranks_must_agree || rank_check, is_elemental))
        {
          if (where)
            gfc_error ("Type/rank mismatch in argument '%s' at %L",
*************** check_intents (gfc_formal_arglist * f, g
*** 1595,1603 ****
  void
  gfc_procedure_use (gfc_symbol * sym, gfc_actual_arglist ** ap, locus * where)
  {
-   int ranks_must_agree;
-   ranks_must_agree = !sym->attr.elemental && (sym->attr.contained
-                       || sym->attr.if_source == IFSRC_IFBODY);

    /* Warn about calls with an implicit interface.  */
    if (gfc_option.warn_implicit_interface
--- 1599,1604 ----
*************** gfc_procedure_use (gfc_symbol * sym, gfc
*** 1606,1612 ****
                   sym->name, where);

    if (sym->attr.if_source == IFSRC_UNKNOWN
!       || !compare_actual_formal (ap, sym->formal, ranks_must_agree,
                                 sym->attr.elemental, where))
      return;

--- 1607,1613 ----
                   sym->name, where);

    if (sym->attr.if_source == IFSRC_UNKNOWN
!       || !compare_actual_formal (ap, sym->formal, 0,
                                 sym->attr.elemental, where))
      return;



-- 


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