diff mbox

[Fortran] PR 44857 [4.6 Regression] ICE in output_constructor_regular_field, at varasm.c:4996

Message ID 4C5915DA.5030104@net-b.de
State New
Headers show

Commit Message

Tobias Burnus Aug. 4, 2010, 7:25 a.m. UTC 
If there was an array constructor involved or an array-valued 
character PARAMETER, gfortran did not properly truncate/pad character 
strings in initialization expressions.

The non-init-expression code path seems to use the normal assignment, 
which handles the padding correctly.

Build on x86-64-linux and successfully regtested an earlier version of 
the patch; I am currently regtesting the current patch.
OK for the trunk, when successful?

Tobias

Comments

Daniel Kraft Aug. 4, 2010, 10:36 a.m. UTC | #1 
Tobias Burnus wrote:
>  If there was an array constructor involved or an array-valued character 
> PARAMETER, gfortran did not properly truncate/pad character strings in 
> initialization expressions.
> 
> The non-init-expression code path seems to use the normal assignment, 
> which handles the padding correctly.
> 
> Build on x86-64-linux and successfully regtested an earlier version of 
> the patch; I am currently regtesting the current patch.
> OK for the trunk, when successful?

Ok.  You may just consider to use "else if" instead of "if" for

+	  if (cons->expr->expr_type == EXPR_ARRAY)
+	    {

While it does not change anything of course, it seems clearer to me.

Thanks!
Daniel
Tobias Burnus Aug. 4, 2010, 11:52 a.m. UTC | #2 
On 08/04/2010 12:36 PM, Daniel Kraft wrote:
> Tobias Burnus wrote:
>> Build on x86-64-linux and successfully regtested an earlier version 
>> of the patch; I am currently regtesting the current patch.
>> OK for the trunk, when successful?
>
> Ok.  You may just consider to use "else if" instead of "if" for
>
> +      if (cons->expr->expr_type == EXPR_ARRAY)
> +        {
>
> While it does not change anything of course, it seems clearer to me.

Well, actually, it does: I replace the previous expression by a new one, 
an EXPR_ARRAY, to use the string-length machinery for EXPR_ARRAY. I will 
add a comment to make this clearer.

(The extra layer of expressions does not matter for PARAMETER as the 
whole expression gets reduced to a simple string literal as the dump shows.)

+         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.  */

I have committed now the patch as Rev. 162863.

Thanks for the review!

Tobias
H.J. Lu Aug. 4, 2010, 4:17 p.m. UTC | #3 
On Wed, Aug 4, 2010 at 4:52 AM, Tobias Burnus <burnus@net-b.de> wrote:
>  On 08/04/2010 12:36 PM, Daniel Kraft wrote:
>>
>> Tobias Burnus wrote:
>>>
>>> Build on x86-64-linux and successfully regtested an earlier version of
>>> the patch; I am currently regtesting the current patch.
>>> OK for the trunk, when successful?
>>
>> Ok.  You may just consider to use "else if" instead of "if" for
>>
>> +      if (cons->expr->expr_type == EXPR_ARRAY)
>> +        {
>>
>> While it does not change anything of course, it seems clearer to me.
>
> Well, actually, it does: I replace the previous expression by a new one, an
> EXPR_ARRAY, to use the string-length machinery for EXPR_ARRAY. I will add a
> comment to make this clearer.
>
> (The extra layer of expressions does not matter for PARAMETER as the whole
> expression gets reduced to a simple string literal as the dump shows.)
>
> +         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.  */
>
> I have committed now the patch as Rev. 162863.
>

gfortran.dg/derived_constructor_char_1.f90 failed on Linux/ia32:

http://gcc.gnu.org/bugzilla/show_bug.cgi?id=45183
diff mbox

Patch

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.

Index: gcc/fortran/array.c
===================================================================
--- gcc/fortran/array.c	(Revision 162853)
+++ gcc/fortran/array.c	(Arbeitskopie)
@@ -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);
 	    }
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(Revision 162853)
+++ gcc/fortran/resolve.c	(Arbeitskopie)
@@ -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
Index: gcc/testsuite/gfortran.dg/derived_constructor_char_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/derived_constructor_char_1.f90	(Revision 0)
+++ gcc/testsuite/gfortran.dg/derived_constructor_char_1.f90	(Revision 0)
@@ -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" } }
Index: gcc/testsuite/gfortran.dg/derived_constructor_char_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/derived_constructor_char_2.f90	(Revision 0)
+++ gcc/testsuite/gfortran.dg/derived_constructor_char_2.f90	(Revision 0)
@@ -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