diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index ae65b687849..30a9415555c 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2010-08-04 Tobias Burnus + + PR fortran/44857 + * resolve.c (resolve_structure_cons): Fix handling of + initialization structcture constructors with character + elements of the wrong length. + * array.c (gfc_check_iter_variable): Add NULL check. + (gfc_resolve_character_array_constructor): Also truncate + character length. + 2010-08-04 Tobias Burnus * trans-io.c (gfc_build_io_library_fndecls): Fix return diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c index e45f7e45c7f..0d92e9275e3 100644 --- a/gcc/fortran/array.c +++ b/gcc/fortran/array.c @@ -1207,7 +1207,7 @@ gfc_check_iter_variable (gfc_expr *expr) sym = expr->symtree->n.sym; - for (c = base; c; c = c->previous) + for (c = base; c && c->iterator; c = c->previous) if (sym == c->iterator->var->symtree->n.sym) return SUCCESS; @@ -1829,7 +1829,7 @@ got_charlen: has_ts = (expr->ts.u.cl && expr->ts.u.cl->length_from_typespec); if (! cl - || (current_length != -1 && current_length < found_length)) + || (current_length != -1 && current_length != found_length)) gfc_set_constant_character_len (found_length, p->expr, has_ts ? -1 : found_length); } diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 90d193cb14a..620df03a34d 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -901,6 +901,52 @@ resolve_structure_cons (gfc_expr *expr) t = gfc_convert_type (cons->expr, &comp->ts, 1); } + /* For strings, the length of the constructor should be the same as + the one of the structure, ensure this if the lengths are known at + compile time and when we are dealing with PARAMETER or structure + constructors. */ + if (cons->expr->ts.type == BT_CHARACTER && comp->ts.u.cl + && comp->ts.u.cl->length + && comp->ts.u.cl->length->expr_type == EXPR_CONSTANT + && cons->expr->ts.u.cl && cons->expr->ts.u.cl->length + && cons->expr->ts.u.cl->length->expr_type == EXPR_CONSTANT + && mpz_cmp (cons->expr->ts.u.cl->length->value.integer, + comp->ts.u.cl->length->value.integer) != 0) + { + if (cons->expr->expr_type == EXPR_VARIABLE + && cons->expr->symtree->n.sym->attr.flavor == FL_PARAMETER) + { + /* Wrap the parameter in an array constructor (EXPR_ARRAY) + to make use of the gfc_resolve_character_array_constructor + machinery. The expression is later simplified away to + an array of string literals. */ + gfc_expr *para = cons->expr; + cons->expr = gfc_get_expr (); + cons->expr->ts = para->ts; + cons->expr->where = para->where; + cons->expr->expr_type = EXPR_ARRAY; + cons->expr->rank = para->rank; + cons->expr->shape = gfc_copy_shape (para->shape, para->rank); + gfc_constructor_append_expr (&cons->expr->value.constructor, + para, &cons->expr->where); + } + if (cons->expr->expr_type == EXPR_ARRAY) + { + gfc_constructor *p; + p = gfc_constructor_first (cons->expr->value.constructor); + if (cons->expr->ts.u.cl != p->expr->ts.u.cl) + { + gfc_free_expr (cons->expr->ts.u.cl->length); + gfc_free (cons->expr->ts.u.cl); + } + + cons->expr->ts.u.cl = gfc_get_charlen (); + cons->expr->ts.u.cl->length_from_typespec = true; + cons->expr->ts.u.cl->length = gfc_copy_expr (comp->ts.u.cl->length); + gfc_resolve_character_array_constructor (cons->expr); + } + } + if (cons->expr->expr_type == EXPR_NULL && !(comp->attr.pointer || comp->attr.allocatable || comp->attr.proc_pointer diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 960b7fe807d..b7ef5ed782a 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2010-08-04 Tobias Burnus + + PR fortran/44857 + * gfortran.dg/derived_constructor_char_1.f90: New. + * gfortran.dg/derived_constructor_char_2.f90: New. + 2010-08-03 Thomas Koenig PR fortran/45159 diff --git a/gcc/testsuite/gfortran.dg/derived_constructor_char_1.f90 b/gcc/testsuite/gfortran.dg/derived_constructor_char_1.f90 new file mode 100644 index 00000000000..20f3cf93e21 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/derived_constructor_char_1.f90 @@ -0,0 +1,50 @@ +! { dg-do compile } +! { dg-options "-fdump-tree-original" } +! +! PR fortran/44857 +! +! + Type :: t5 + character (len=5) :: txt(4) + End Type t5 + + character (len=3), parameter :: str3(2) = [ "ABC", "ZYX" ] + character (len=5), parameter :: str5(2) = [ "AbCdE", "ZyXwV" ] + character (len=5), parameter :: str7(2) = [ "aBcDeFg", "zYxWvUt" ] + + Type (t5) :: one = t5((/ "12345", "67890" /)) + Type (t5) :: two = t5((/ "123", "678" /)) + Type (t5) :: three = t5((/ "1234567", "abcdefg" /)) + Type (t5) :: four = t5(str3) + Type (t5) :: five = t5(str5) + Type (t5) :: six = t5(str7) + print '(2a)', one, two, three, four, five, six +End + +subroutine wasICEing() + implicit none + + Type :: Err_Text_Type + integer :: nlines + character (len=132), dimension(5) :: txt + End Type Err_Text_Type + + Type (Err_Text_Type) :: Mess_FindFMT = & + Err_Text_Type(0, (/" "," "," "," "," "/)) +end subroutine wasICEing + +subroutine anotherCheck() + Type :: t + character (len=3) :: txt(2) + End Type + Type (t) :: tt = t((/ character(len=5) :: "12345", "67890" /)) + print *, tt +end subroutine + +! { dg-final { scan-tree-dump-times "one = ..txt=..12345., .67890...;" 1 "original" } } +! { dg-final { scan-tree-dump-times "two = ..txt=..123 ., .678 ...;" 1 "original" } } +! { dg-final { scan-tree-dump-times "three = ..txt=..12345., .abcde...;" 1 "original" } } +! { dg-final { scan-tree-dump-times "four = ..txt=..ABC ., .ZYX ...;" 1 "original" } } +! { dg-final { scan-tree-dump-times "five = ..txt=..AbCdE., .ZyXwV...;" 1 "original" } } +! { dg-final { scan-tree-dump-times "six = ..txt=..aBcDe., .zYxWv...;" 1 "original" } } +! { dg-final { cleanup-tree-dump "original" } } diff --git a/gcc/testsuite/gfortran.dg/derived_constructor_char_2.f90 b/gcc/testsuite/gfortran.dg/derived_constructor_char_2.f90 new file mode 100644 index 00000000000..c812bceeb09 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/derived_constructor_char_2.f90 @@ -0,0 +1,13 @@ +! { dg-do compile } +! { dg-options "-fdump-tree-original" } +! +! PR fortran/44857 +! +! + + Type :: t + character (len=5) :: txt(2) + End Type + character (len=5) :: str(2) = [ "12345", "67890" ] + Type (t) :: tt = t( [str] ) ! { dg-error "does not reduce to a constant" } +End