2010-08-04 Tobias Burnus <burnus@net-b.de>
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 <burnus@net-b.de>
PR fortran/44857
* gfortran.dg/derived_constructor_char_1.f90: New.
* gfortran.dg/derived_constructor_char_2.f90: New.
===================================================================
@@ -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);
}
===================================================================
@@ -901,6 +901,48 @@ 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)
+ {
+ 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
===================================================================
@@ -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" } }
===================================================================
@@ -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