[PATCH] PR fortran/64124,70409 -- Reduce a charlen

[Steve Kargl <sgk@troutmask.apl.washington.edu>]

[-- Attachment #1: Type: text/plain, Size: 1041 bytes --]

All,

As everyone knows, gfortran reads source into a trees and
and at some point she passes those trees to a resolution
phases.  There are instances, for example the new tests,
where resolution fails to use the character length 
parameter in declaration statements.  The attach patch
seems to cure this problem.

Previously, after reading the scalar-integer-expr, gfortran
would assign the expression to the charlen without trying
to reduce it to a constant (which should happen but doesn't
in the resolution phase).  The patch now tries to reduce
the scalar-integer-expr to a constant, and then assigns 
that constant to the charlen.

Bootstrap and regression tested on 7-branch and trunk.
OK to commit?

2018-03-06  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/64124
	PR fortran/70409
	* decl.c (gfc_match_char_spec): Try to reduce a charlen to a constant.

2018-03-06  Steven G. Kargl  <kargl@gcc.gnu.org>

	PR fortran/64124
	PR fortran/70409
	* gfortran.dg/pr64124.f90: New tests.
	* gfortran.dg/pr70409.f90: New tests.

-- 
Steve

[-- Attachment #2: pr70409.diff --]
[-- Type: text/x-diff, Size: 2386 bytes --]

Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c	(revision 258304)
+++ gcc/fortran/decl.c	(working copy)
@@ -3147,7 +3147,24 @@ done:
   if (seen_length == 0)
     cl->length = gfc_get_int_expr (gfc_charlen_int_kind, NULL, 1);
   else
-    cl->length = len;
+    {
+      /* If gfortran ends up here, then the len may be reducible to a
+	 constant.  Try to do that here.  If it does not reduce, simply
+	 assign len to the charlen.  */
+      if (len && len->expr_type != EXPR_CONSTANT)
+	{
+	  gfc_expr *e;
+	  e = gfc_copy_expr (len);
+	  gfc_reduce_init_expr (e);
+	  if (e->expr_type == EXPR_CONSTANT)
+	    gfc_replace_expr (len, e);
+	  else
+	    gfc_free_expr (e);
+	  cl->length = len;
+	}
+      else
+	cl->length = len;
+    }
 
   ts->u.cl = cl;
   ts->kind = kind == 0 ? gfc_default_character_kind : kind;
Index: gcc/testsuite/gfortran.dg/pr64124.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr64124.f90	(nonexistent)
+++ gcc/testsuite/gfortran.dg/pr64124.f90	(working copy)
@@ -0,0 +1,5 @@
+! { dg-do compile }
+! PR fortran/64124.f90
+  character(len=kind(1)) x
+  integer(len(x)) y
+  end
Index: gcc/testsuite/gfortran.dg/pr70409.f90
===================================================================
--- gcc/testsuite/gfortran.dg/pr70409.f90	(nonexistent)
+++ gcc/testsuite/gfortran.dg/pr70409.f90	(working copy)
@@ -0,0 +1,23 @@
+! { dg-do run }
+! PR fortran/70409
+! Contriubted by Harald Anlauf  <anlauf at gmx dot de>
+program foo
+  integer, parameter :: huge_1 = huge(0_1)
+  character(    huge_1      ), parameter :: x = 'abc'
+  character(    huge(0_1)   ), parameter :: y = 'abc'
+  character(    huge(0_1)+0 ), parameter :: z = 'abcdef'
+  character(    huge(0_1)   )            :: a = 'abc'
+  integer, parameter :: huge_2 = huge(0_2)
+  character(    huge_2      ), parameter :: u = 'abc'
+  character(    huge(0_2)   ), parameter :: v = 'abc'
+  character(int(huge(0_2),4)), parameter :: w = 'abcdef'
+  character(    huge(0_2)   )            :: b = 'abc'
+  if (len(x) /= huge_1) stop 1
+  if (len(y) /= huge_1) stop 2
+  if (len(z) /= huge_1) stop 3
+  if (len(a) /= huge_1) stop 4
+  if (len(u) /= huge_2) stop 5
+  if (len(v) /= huge_2) stop 6
+  if (len(w) /= huge_2) stop 7
+  if (len(b) /= huge_2) stop 8
+end program foo