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

[Janne Blomqvist]

On Wed, Mar 7, 2018 at 2:20 AM, Steve Kargl
 wrote:
> 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  
>
> 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  
>
> PR fortran/64124
> PR fortran/70409
> * gfortran.dg/pr64124.f90: New tests.
> * gfortran.dg/pr70409.f90: New tests.

Ok, thanks.


-- 
Janne Blomqvist

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

[Steve Kargl]

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  

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  

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

-- 
Steve
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  
+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