procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/44857 (ICE in output_constructor_regular_field, at varasm.c:4996)

Browse source 
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.

From-SVN: r162863
This commit is contained in:
Tobias Burnus 2010-08-04 13:51:32 +02:00 • committed by Tobias Burnus
parent 48176d8100
commit a48a91732b
6 changed files with 127 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
gcc/fortran/ChangeLog
View file

@ -1,3 +1,13 @@
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>
* trans-io.c (gfc_build_io_library_fndecls): Fix return

4
gcc/fortran/array.c
View file

@ -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);
}

46
gcc/fortran/resolve.c
View file

@ -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

6
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,9 @@
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.
2010-08-03 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/45159

50
gcc/testsuite/gfortran.dg/derived_constructor_char_1.f90 Normal file
View file

@ -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" } }

13
gcc/testsuite/gfortran.dg/derived_constructor_char_2.f90 Normal file
View file

@ -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