PR fortran/31250

fortran/
* decl.c (match_char_spec): Move check for negative CHARACTER
length ...
* resolve.c (resolve_charlen): ... here.
(resolve_types): Resolve CHARACTER lengths earlier.
teststuite/
* gfortran.dg/char_length_2.f90: New.


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

1 files changed, 14 insertions, 3 deletions

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 467ccf47681..8c4b46ac27f 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -5389,6 +5389,8 @@ resolve_index_expr (gfc_expr *e)
 static try
 resolve_charlen (gfc_charlen *cl)
 {
+  int i;
+
   if (cl->resolved)
     return SUCCESS;
 
@@ -5402,6 +5404,15 @@ resolve_charlen (gfc_charlen *cl)
       return FAILURE;
     }
 
+  /* "If the character length parameter value evaluates to a negative
+     value, the length of character entities declared is zero."  */
+  if (cl->length && !gfc_extract_int (cl->length, &i) && i <= 0)
+    {
+      gfc_warning_now ("CHARACTER variable has zero length at %L",
+		       &cl->length->where);
+      gfc_replace_expr (cl->length, gfc_int_expr (0));
+    }
+
   return SUCCESS;
 }
 
@@ -7270,6 +7281,9 @@ resolve_types (gfc_namespace *ns)
 
   resolve_contained_functions (ns);
 
+  for (cl = ns->cl_list; cl; cl = cl->next)
+    resolve_charlen (cl);
+
   gfc_traverse_ns (ns, resolve_symbol);
 
   resolve_fntype (ns);
@@ -7287,9 +7301,6 @@ resolve_types (gfc_namespace *ns)
   forall_flag = 0;
   gfc_check_interfaces (ns);
 
-  for (cl = ns->cl_list; cl; cl = cl->next)
-    resolve_charlen (cl);
-
   gfc_traverse_ns (ns, resolve_values);
 
   if (ns->save_all)