2009-12-15 Tobias Burnus <burnus@net-b.de>

[pf3gnuchains/gcc-fork.git] / gcc / fortran / resolve.c

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 00bd441..78b0a78 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -1830,6 +1830,21 @@ resolve_global_procedure (gfc_symbol *sym, locus *where,
        gfc_error ("The reference to function '%s' at %L either needs an "
                   "explicit INTERFACE or the rank is incorrect", sym->name,
                   where);
+     
+      /* Non-assumed length character functions.  */
+      if (sym->attr.function && sym->ts.type == BT_CHARACTER
+         && gsym->ns->proc_name->ts.u.cl->length != NULL)
+       {
+         gfc_charlen *cl = sym->ts.u.cl;
+
+         if (!sym->attr.entry_master && sym->attr.if_source == IFSRC_UNKNOWN
+              && cl && cl->length && cl->length->expr_type != EXPR_CONSTANT)
+           {
+              gfc_error ("Nonconstant character-length function '%s' at %L "
+                        "must have an explicit interface", sym->name,
+                        &sym->declared_at);
+           }
+       }
 
       if (gfc_option.flag_whole_file == 1
            || ((gfc_option.warn_std & GFC_STD_LEGACY)
@@ -9038,23 +9053,12 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag)
             && resolve_charlen (cl) == FAILURE)
        return FAILURE;
 
-      if (!cl || !cl->length || cl->length->expr_type != EXPR_CONSTANT)
+      if ((!cl || !cl->length || cl->length->expr_type != EXPR_CONSTANT)
+         && sym->attr.proc == PROC_ST_FUNCTION)
        {
-         if (sym->attr.proc == PROC_ST_FUNCTION)
-           {
-             gfc_error ("Character-valued statement function '%s' at %L must "
-                        "have constant length", sym->name, &sym->declared_at);
-             return FAILURE;
-           }
-
-         if (sym->attr.external && sym->formal == NULL
-             && cl && cl->length && cl->length->expr_type != EXPR_CONSTANT)
-           {
-             gfc_error ("Automatic character length function '%s' at %L must "
-                        "have an explicit interface", sym->name,
-                        &sym->declared_at);
-             return FAILURE;
-           }
+         gfc_error ("Character-valued statement function '%s' at %L must "
+                    "have constant length", sym->name, &sym->declared_at);
+         return FAILURE;
        }
     }