Fortran : ICE in gfc_conv_array_constructor_expr PR93497

Invalid expressions, such as those involving array constructors,
used for the length of character types will cause an ICE.

2020-05-11  Mark Eggleston  <markeggleston@gcc.gnu.org>

Backported from master
2020-05-13  Steven G. Kargl  <kargl@gcc.gnu.org>

gcc/fortran/

	PR fortran/93497
	* decl.c (char_len_param_value): Check whether character
	length expression is of type EXPR_OP and if so simplify it.
	* resolve.c (resolve_charlen): Reject length if it has a
	rank.

2020-05-11  Mark Eggleston  <markeggleston@gcc.gnu.org>

Backported from master
2020-05-13  Mark Eggleston  <markeggleston@gcc.gnu.org>

gcc/testsuite/

	PR fortran/93497
	* gfortran.dg/pr88025.f90: Change in wording of error.
	* gfortran.dg/pr93497.f90: New test.
	* gfortran.dg/pr93714_1.f90: Change in wording of errors.
	* gfortran.dg/pr93714_2.f90: Change in wording of errors.

gcc/fortran/ChangeLog

+2020-05-13  Mark Eggleston  <markeggleston@gcc.gnu.org>
+
+	Backported from master
+	2020-05-13  Steven G. Kargl  <kargl@gcc.gnu.org>
+
+	PR fortran/93497
+	* decl.c (char_len_param_value): Check whether character
+	length expression is of type EXPR_OP and if so simplify it.
+	* resolve.c (resolve_charlen): Reject length if it has a
+	rank.
+
 2020-05-12  Tobias Burnus  <tobias@codesourcery.com>
 
 	Backported from mainline

gcc/fortran/decl.c

@@ -1077,6 +1077,11 @@ char_len_param_value (gfc_expr **expr, bool *deferred)
   if (!gfc_expr_check_typed (*expr, gfc_current_ns, false))
     return MATCH_ERROR;
 
+  /* If gfortran gets an EXPR_OP, try to simplifiy it.  This catches things
+     like CHARACTER(([1])).   */
+  if ((*expr)->expr_type == EXPR_OP)
+    gfc_simplify_expr (*expr, 1);
+
   if ((*expr)->expr_type == EXPR_FUNCTION)
     {
       if ((*expr)->ts.type == BT_INTEGER

gcc/fortran/resolve.c

@@ -12358,7 +12358,7 @@ resolve_charlen (gfc_charlen *cl)
 	}
 
       /* cl->length has been resolved.  It should have an integer type.  */
-      if (cl->length->ts.type != BT_INTEGER)
+      if (cl->length->ts.type != BT_INTEGER || cl->length->rank != 0)
 	{
 	  gfc_error ("Scalar INTEGER expression expected at %L",
 		     &cl->length->where);

gcc/testsuite/ChangeLog

+2020-05-13  Mark Eggleston  <markeggleston@gcc.gnu.org>
+
+	Backport from master
+        2020-05-13  Mark Eggleston  <markeggleston@gcc.gnu.org>
+
+	PR fortran/93497
+	* gfortran.dg/pr88025.f90: Change in wording of error.
+	* gfortran.dg/pr93497.f90: New test.
+	* gfortran.dg/pr93714_1.f90: Change in wording of errors.
+	* gfortran.dg/pr93714_2.f90: Change in wording of errors.
+
 2020-05-12  Richard Biener  <rguenther@suse.de>
 
 	Backport from mainline

gcc/testsuite/gfortran.dg/pr88025.f90

@@ -2,6 +2,6 @@
 ! PR fortran/88025
 program p
    type t
-      character(('')) :: c = 'c'    ! { dg-error "must be of INTEGER type" }
+      character(('')) :: c = 'c'  ! { dg-error "Scalar INTEGER expression expected" }
    end type
 end

gcc/testsuite/gfortran.dg/pr93497.f90

+! { dg-do compile } 
+
+program p
+   print *, [character(((/1/))) :: 'a','b'] ! { dg-error "Scalar INTEGER expression expected" }
+   print *, [character(([1])) :: 'a','b']   ! { dg-error "Scalar INTEGER expression expected" }
+   print *, [character(1+[1]) :: 'a','b']   ! { dg-error "Scalar INTEGER expression expected" }
+end
+

gcc/testsuite/gfortran.dg/pr93714_1.f90

@@ -7,5 +7,5 @@ program test
    character, pointer :: b => a
 end program
 
-! { dg-error "must be of INTEGER type" " " { target *-*-* } 6 }
-! { dg-error "does not have the TARGET attribute" " " { target *-*-* } 7 }
+! { dg-error "Scalar INTEGER expression expected" " " { target *-*-* } 6 }
+! { dg-error "Different types in pointer assignment" " " { target *-*-* } 7 }

gcc/testsuite/gfortran.dg/pr93714_2.f90

@@ -7,5 +7,5 @@ program test
    character(:), pointer :: b => a
 end program
 
-! { dg-error "must be of INTEGER type" " " { target *-*-* } 6 }
-! { dg-error "does not have the TARGET attribute" " " { target *-*-* } 7 }
+! { dg-error "Scalar INTEGER expression expected" " " { target *-*-* } 6 }
+! { dg-error "Different types in pointer assignment" " " { target *-*-* } 7 }