From patchwork Wed Aug 4 07:25:14 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 60830 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id A1488B70A5 for ; Wed, 4 Aug 2010 17:26:04 +1000 (EST) Received: (qmail 7476 invoked by alias); 4 Aug 2010 07:26:00 -0000 Received: (qmail 7385 invoked by uid 22791); 4 Aug 2010 07:25:57 -0000 X-SWARE-Spam-Status: No, hits=-1.9 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE X-Spam-Check-By: sourceware.org Received: from mx02.qsc.de (HELO mx02.qsc.de) (213.148.130.14) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Wed, 04 Aug 2010 07:25:17 +0000 Received: from [192.168.178.22] (port-92-204-54-162.dynamic.qsc.de [92.204.54.162]) by mx02.qsc.de (Postfix) with ESMTP id 42A181EA1F; Wed, 4 Aug 2010 09:25:14 +0200 (CEST) Message-ID: <4C5915DA.5030104@net-b.de> Date: Wed, 04 Aug 2010 09:25:14 +0200 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; U; Linux x86_64; de; rv:1.9.2.7) Gecko/20100714 SUSE/3.1.1 Thunderbird/3.1.1 MIME-Version: 1.0 To: gcc patches , gfortran Subject: [Patch, Fortran] PR 44857 [4.6 Regression] ICE in output_constructor_regular_field, at varasm.c:4996 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org 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 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 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