This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[Fortran, Patch] PR36476 - Fix ICE with PARAMETER and len=* strings
- From: Tobias Burnus <burnus at net-b dot de>
- To: "'fortran at gcc dot gnu dot org'" <fortran at gcc dot gnu dot org>, gcc-patches <gcc-patches at gcc dot gnu dot org>
- Date: Fri, 13 Jun 2008 11:53:12 +0200
- Subject: [Fortran, Patch] PR36476 - Fix ICE with PARAMETER and len=* strings
Without this patch, gfortran crashes (ICE) for:
CHARACTER (len=*) MY_STRING(1:3)
PARAMETER ( MY_STRING = (/ "A" , "B", "C" /) )
as "my_string" has an initialization but cl.length is not set. If one
changes the PARAMETER statement into a PARAMETER attribute or uses len=1
or uses a scalar, it works. I copied the cl.length==NULL (i.e. len=*)
case from add_init_expr_to_sym, which is used in case of the PARAMETER
attribute.
Bootstrapped and regtested on x86-64-linux. OK for the trunk?
Tobias
2008-06-13 Tobias Burnus <burnus@net-b.de>
PR fortran/36476
* decl.c (do_parm): Handle init expression for len=*.
2008-06-13 Tobias Burnus <burnus@net-b.de>
PR fortran/36476
* gfortran.dg/parameter_array_init_4.f90: New.
Index: gcc/fortran/decl.c
===================================================================
--- gcc/fortran/decl.c (Revision 136740)
+++ gcc/fortran/decl.c (Arbeitskopie)
@@ -5820,10 +5820,27 @@ do_parm (void)
&& sym->ts.cl->length != NULL
&& sym->ts.cl->length->expr_type == EXPR_CONSTANT
&& init->expr_type == EXPR_CONSTANT
- && init->ts.type == BT_CHARACTER
- && init->ts.kind == 1)
+ && init->ts.type == BT_CHARACTER)
gfc_set_constant_character_len (
mpz_get_si (sym->ts.cl->length->value.integer), init, false);
+ else if (sym->ts.type == BT_CHARACTER && sym->ts.cl != NULL
+ && sym->ts.cl->length == NULL)
+ {
+ int clen;
+ if (init->expr_type == EXPR_CONSTANT)
+ {
+ clen = init->value.character.length;
+ sym->ts.cl->length = gfc_int_expr (clen);
+ }
+ else if (init->expr_type == EXPR_ARRAY)
+ {
+ gfc_expr *p = init->value.constructor->expr;
+ clen = p->value.character.length;
+ sym->ts.cl->length = gfc_int_expr (clen);
+ }
+ else if (init->ts.cl && init->ts.cl->length)
+ sym->ts.cl->length = gfc_copy_expr (sym->value->ts.cl->length);
+ }
sym->value = init;
return MATCH_YES;
Index: gcc/testsuite/gfortran.dg/parameter_array_init_4.f90
===================================================================
--- gcc/testsuite/gfortran.dg/parameter_array_init_4.f90 (Revision 0)
+++ gcc/testsuite/gfortran.dg/parameter_array_init_4.f90 (Revision 0)
@@ -0,0 +1,37 @@
+! { dg-do run }
+! PR fortran/36476
+!
+IMPLICIT NONE
+CHARACTER (len=*) MY_STRING(1:3), my_string_s
+PARAMETER ( MY_STRING = (/ "A" , "B", "C" /) )
+PARAMETER ( MY_STRING_S = "AB C" )
+character(len=*), parameter :: str(2) = [ 'A','cc']
+character(len=*), parameter :: str_s = 'Acc'
+
+CHARACTER (kind=1,len=*) MY_STRING1(1:3), my_string_s1
+PARAMETER ( MY_STRING1 = (/ "A" , "B", "C" /) )
+PARAMETER ( MY_STRING_S1 = "AB C" )
+character(kind=1,len=*), parameter :: str1(2) = [ 1_'Ac',1_'cc']
+character(kind=1,len=*), parameter :: str_s1 = 'Acc'
+
+CHARACTER (kind=4,len=*) MY_STRING4(1:3), my_string_s4
+PARAMETER ( MY_STRING4 = (/ "A" , "B", "C" /) )
+PARAMETER ( MY_STRING_S4 = "AB C" )
+character(kind=4,len=*), parameter :: str4(2) = [ 1_'Ac',1_'cc']
+character(kind=4,len=*), parameter :: str_s4 = 'Acc'
+
+if(len(MY_STRING) /= 1) call abort()
+if(len(MY_STRING) /= 1) call abort()
+if(len(str) /= 2) call abort()
+if(len(str_s) /= 3) call abort()
+
+if(len(MY_STRING1) /= 1) call abort()
+if(len(MY_STRING1) /= 1) call abort()
+if(len(str1) /= 2) call abort()
+if(len(str_s1) /= 3) call abort()
+
+if(len(MY_STRING4) /= 1) call abort()
+if(len(MY_STRING4) /= 1) call abort()
+if(len(str4) /= 2) call abort()
+if(len(str_s4) /= 3) call abort()
+end