re PR fortran/31250 (Initialization expr as constant character length rejected)

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.

From-SVN: r123763

3 files changed, 24 insertions, 13 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 28e2d16..fe6b139 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2007-04-12  Tobias Schlüter  <tobi@gcc.gnu.org>
+
+	PR fortran/31250
+	* decl.c (match_char_spec): Move check for negative CHARACTER
+	length ...
+	* resolve.c (resolve_charlen): ... here.
+	(resolve_types): Resolve CHARACTER lengths earlier.
+
 2007-04-12  Daniel Franke  <franke.daniel@gmail.com>
 
 	PR fortran/31234
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 43e0235..9b54bca 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -1515,7 +1515,7 @@ no_match:
 static match
 match_char_spec (gfc_typespec *ts)
 {
-  int i, kind, seen_length;
+  int kind, seen_length;
   gfc_charlen *cl;
   gfc_expr *len;
   match m;
@@ -1646,15 +1646,7 @@ done:
   if (seen_length == 0)
     cl->length = gfc_int_expr (1);
   else
-    {
-      if (len == NULL || gfc_extract_int (len, &i) != NULL || i >= 0)
-	cl->length = len;
-      else
-	{
-	  gfc_free_expr (len);
-	  cl->length = gfc_int_expr (0);
-	}
-    }
+    cl->length = len;
 
   ts->cl = cl;
   ts->kind = kind;
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 467ccf4..8c4b46a 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)