[gfortran] Fix PR 31250: Resolution of CHARACTER lengths

[Tobias Schlüter <tobias dot schlueter at physik dot uni-muenchen dot de>]

Hi,

this patch has got me wondering about the interactions during
resolution.  Before this patch, CHARACTER lengths were resolved after
the variables they correspond to were resolved, which lead to this PR,
as simplification of expressions happens during resolution, and
therefore checks for constantness of CHARACTER lengths could
mistakenly fail. My astonishment is revolving around the question why
one would ever think it a good idea to write the original code in the
original order.  Even worse is that I seem to remember that I wrote this 
in the first place, and don't believe that I have gotten any smarter 
during the past few years.

Anyway, during my investigations, and thanks to the testcase in the
PR, I found out that negative lengths were folded to zero in the
matchers (arithmetic expressions are folded during matching, so "2-3"
will be matched as a constant gfc_expr with value "-1"), but since
something like "min(-2,4)" will be folded to -2 only during
resolution, we'll have to do the same exercise in resolve_charlen
anyway, so I decided to move that code into resolve_charlen.

Built and tested on i386-darwin.  New testcase included.  Ok?

- Tobi


	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.
	

Index: fortran/decl.c
===================================================================
--- fortran/decl.c	(revision 123625)
+++ fortran/decl.c	(working copy)
@@ -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;
Index: fortran/resolve.c
===================================================================
--- fortran/resolve.c	(revision 123625)
+++ fortran/resolve.c	(working copy)
@@ -5388,6 +5388,8 @@ resolve_index_expr (gfc_expr *e)
 static try
 resolve_charlen (gfc_charlen *cl)
 {
+  int i;
+
   if (cl->resolved)
     return SUCCESS;
 
@@ -5401,6 +5403,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;
 }
 
@@ -7265,6 +7276,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);
@@ -7282,9 +7296,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)
Index: testsuite/gfortran.dg/char_length_2.f90
===================================================================
--- testsuite/gfortran.dg/char_length_2.f90	(revision 0)
+++ testsuite/gfortran.dg/char_length_2.f90	(revision 0)
@@ -0,0 +1,21 @@
+! { dg-do link }
+! Tests the fix for PR 31250
+! CHARACTER lengths weren't reduced early enough for all checks of
+! them to be meaningful.  Furthermore negative string lengths weren't
+! dealt with correctly.
+CHARACTER(len=0) :: c1  ! { dg-warning "CHARACTER variable has zero length" }
+CHARACTER(len=-1) :: c2  ! { dg-warning "CHARACTER variable has zero length" }
+PARAMETER(I=-100)
+CHARACTER(len=I) :: c3   ! { dg-warning "CHARACTER variable has zero length" }
+CHARACTER(len=min(I,500)) :: c4  ! { dg-warning "CHARACTER variable has zero length" }
+CHARACTER(len=max(I,500)) :: d1  ! no warning
+CHARACTER(len=5) :: d2   ! no warning
+
+if (len(c1) .ne. 0) call link_error ()
+if (len(c2) .ne. len(c1)) call link_error ()
+if (len(c3) .ne. len(c2)) call link_error ()
+if (len(c4) .ne. len(c3)) call link_error ()
+
+if (len(d1) .ne. 500) call link_error ()
+if (len(d2) .ne. 5) call link_error ()
+END