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

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index ae65b687849b2d71c8386b897cefa08b6e2dd345..30a9415555c8d3d236926a7f327bfb77496184cb 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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

diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
index e45f7e45c7f3865c4baacb30096155ed75628091..0d92e9275e3e87b6c7ddc167faa73aaa53e9b946 100644 (file)
--- 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 90d193cb14a9020a4887910e9477e8e0ba70fb5d..620df03a34d472070038a4c3a3a40cbcab1af6dd 100644 (file)
--- 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 960b7fe807d33b13f09cb05c872c25183c2e0138..b7ef5ed782a53234c9680be9804ba3e511d13473 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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

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 (file)
index 0000000..20f3cf9
--- /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 (file)
index 0000000..c812bce
--- /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