From patchwork Sat Feb 19 08:55:51 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Paul Richard Thomas X-Patchwork-Id: 83688 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 A670DB7108 for ; Sat, 19 Feb 2011 19:56:05 +1100 (EST) Received: (qmail 20829 invoked by alias); 19 Feb 2011 08:56:01 -0000 Received: (qmail 20812 invoked by uid 22791); 19 Feb 2011 08:55:59 -0000 X-SWARE-Spam-Status: No, hits=-2.1 required=5.0 tests=AWL, BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, FREEMAIL_FROM, RCVD_IN_DNSWL_LOW X-Spam-Check-By: sourceware.org Received: from mail-bw0-f47.google.com (HELO mail-bw0-f47.google.com) (209.85.214.47) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Sat, 19 Feb 2011 08:55:54 +0000 Received: by bwz10 with SMTP id 10so565753bwz.20 for ; Sat, 19 Feb 2011 00:55:52 -0800 (PST) MIME-Version: 1.0 Received: by 10.204.32.216 with SMTP id e24mr1501793bkd.204.1298105751931; Sat, 19 Feb 2011 00:55:51 -0800 (PST) Received: by 10.204.14.143 with HTTP; Sat, 19 Feb 2011 00:55:51 -0800 (PST) Date: Sat, 19 Feb 2011 09:55:51 +0100 Message-ID: Subject: [Patch, fortran] PR47348 - wrong string length with array constructor From: Paul Richard Thomas To: gcc-patches , fortran@gcc.gnu.org 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 The attached is straight forward. Instead of quitting the evaluation of the length of a substring if it is not constant, we now evaluate the expression for the constructor element. Whilst not as efficient as evaluating string-lengths directly, it is quite bomb-proof. bounds_check_10.f90 needed a wildcard for the run-time error message since the elements compared go from 1:2 to 1:3 as the level of optimization increases, changing this part of the message from "1/2" to "1/4". I am not sure why this happens but the error is still picked up and the message remains correct. Bootstrapped and regtested on Ubuntu/i686 - OK for trunk? Paul 2011-02-19 Paul Thomas PR fortran/47348 * trans-array.c (get_array_ctor_all_strlen): Move up in file. (get_array_ctor_var_strlen): Add block dummy and add call to get_array_ctor_all_strlen instead of giving up on substrings. Call gcc_unreachable for default case. (get_array_ctor_strlen): Add extra argument to in call to get_array_ctor_var_strlen. 2011-02-19 Paul Thomas PR fortran/47348 * gfortran.dg/array_constructor_36.f90 : New test. * gfortran.dg/bounds_check_10.f90 : Change dg-output message to allow for comparison between different elements of the array constructor at different levels of optimization. Index: gcc/fortran/trans-array.c =================================================================== *** gcc/fortran/trans-array.c (revision 169916) --- gcc/fortran/trans-array.c (working copy) *************** gfc_trans_array_constructor_value (stmtb *** 1495,1505 **** } /* Figure out the string length of a variable reference expression. Used by get_array_ctor_strlen. */ static void ! get_array_ctor_var_strlen (gfc_expr * expr, tree * len) { gfc_ref *ref; gfc_typespec *ts; --- 1495,1549 ---- } + /* A catch-all to obtain the string length for anything that is not a + a substring of non-constant length, a constant, array or variable. */ + + static void + get_array_ctor_all_strlen (stmtblock_t *block, gfc_expr *e, tree *len) + { + gfc_se se; + gfc_ss *ss; + + /* Don't bother if we already know the length is a constant. */ + if (*len && INTEGER_CST_P (*len)) + return; + + if (!e->ref && e->ts.u.cl && e->ts.u.cl->length + && e->ts.u.cl->length->expr_type == EXPR_CONSTANT) + { + /* This is easy. */ + gfc_conv_const_charlen (e->ts.u.cl); + *len = e->ts.u.cl->backend_decl; + } + else + { + /* Otherwise, be brutal even if inefficient. */ + ss = gfc_walk_expr (e); + gfc_init_se (&se, NULL); + + /* No function call, in case of side effects. */ + se.no_function_call = 1; + if (ss == gfc_ss_terminator) + gfc_conv_expr (&se, e); + else + gfc_conv_expr_descriptor (&se, e, ss); + + /* Fix the value. */ + *len = gfc_evaluate_now (se.string_length, &se.pre); + + gfc_add_block_to_block (block, &se.pre); + gfc_add_block_to_block (block, &se.post); + + e->ts.u.cl->backend_decl = *len; + } + } + + /* Figure out the string length of a variable reference expression. Used by get_array_ctor_strlen. */ static void ! get_array_ctor_var_strlen (stmtblock_t *block, gfc_expr * expr, tree * len) { gfc_ref *ref; gfc_typespec *ts; *************** get_array_ctor_var_strlen (gfc_expr * ex *** 1526,1532 **** case REF_SUBSTRING: if (ref->u.ss.start->expr_type != EXPR_CONSTANT || ref->u.ss.end->expr_type != EXPR_CONSTANT) ! break; mpz_init_set_ui (char_len, 1); mpz_add (char_len, char_len, ref->u.ss.end->value.integer); mpz_sub (char_len, char_len, ref->u.ss.start->value.integer); --- 1570,1580 ---- case REF_SUBSTRING: if (ref->u.ss.start->expr_type != EXPR_CONSTANT || ref->u.ss.end->expr_type != EXPR_CONSTANT) ! { ! /* Note that this might evaluate expr. */ ! get_array_ctor_all_strlen (block, expr, len); ! return; ! } mpz_init_set_ui (char_len, 1); mpz_add (char_len, char_len, ref->u.ss.end->value.integer); mpz_sub (char_len, char_len, ref->u.ss.start->value.integer); *************** get_array_ctor_var_strlen (gfc_expr * ex *** 1536,1545 **** return; default: ! /* TODO: Substrings are tricky because we can't evaluate the ! expression more than once. For now we just give up, and hope ! we can figure it out elsewhere. */ ! return; } } --- 1584,1590 ---- return; default: ! gcc_unreachable (); } } *************** get_array_ctor_var_strlen (gfc_expr * ex *** 1547,1595 **** } - /* A catch-all to obtain the string length for anything that is not a - constant, array or variable. */ - static void - get_array_ctor_all_strlen (stmtblock_t *block, gfc_expr *e, tree *len) - { - gfc_se se; - gfc_ss *ss; - - /* Don't bother if we already know the length is a constant. */ - if (*len && INTEGER_CST_P (*len)) - return; - - if (!e->ref && e->ts.u.cl && e->ts.u.cl->length - && e->ts.u.cl->length->expr_type == EXPR_CONSTANT) - { - /* This is easy. */ - gfc_conv_const_charlen (e->ts.u.cl); - *len = e->ts.u.cl->backend_decl; - } - else - { - /* Otherwise, be brutal even if inefficient. */ - ss = gfc_walk_expr (e); - gfc_init_se (&se, NULL); - - /* No function call, in case of side effects. */ - se.no_function_call = 1; - if (ss == gfc_ss_terminator) - gfc_conv_expr (&se, e); - else - gfc_conv_expr_descriptor (&se, e, ss); - - /* Fix the value. */ - *len = gfc_evaluate_now (se.string_length, &se.pre); - - gfc_add_block_to_block (block, &se.pre); - gfc_add_block_to_block (block, &se.post); - - e->ts.u.cl->backend_decl = *len; - } - } - - /* Figure out the string length of a character array constructor. If len is NULL, don't calculate the length; this happens for recursive calls when a sub-array-constructor is an element but not at the first position, --- 1592,1597 ---- *************** get_array_ctor_strlen (stmtblock_t *bloc *** 1633,1639 **** case EXPR_VARIABLE: is_const = false; if (len) ! get_array_ctor_var_strlen (c->expr, len); break; default: --- 1635,1641 ---- case EXPR_VARIABLE: is_const = false; if (len) ! get_array_ctor_var_strlen (block, c->expr, len); break; default: Index: gcc/testsuite/gfortran.dg/array_constructor_36.f90 =================================================================== *** gcc/testsuite/gfortran.dg/array_constructor_36.f90 (revision 0) --- gcc/testsuite/gfortran.dg/array_constructor_36.f90 (revision 0) *************** *** 0 **** --- 1,21 ---- + ! { dg-do run } + ! Test the fix for PR47348, in which the substring length + ! in the array constructor at line 19 would be missed and + ! the length of q used instead. + ! + ! Contributed by Thomas Koenig + ! + program main + implicit none + character(len = *), parameter :: fmt='(2(A,"|"))' + character(len = *), parameter :: test='xyc|aec|' + integer :: i + character(len = 4) :: q + character(len = 8) :: buffer + q = 'xy' + i = 2 + write (buffer, fmt) (/ trim(q), 'ae' /)//'c' + if (buffer .ne. test) Call abort + write (buffer, FMT) (/ q(1:i), 'ae' /)//'c' + if (buffer .ne. test) Call abort + end program main Index: gcc/testsuite/gfortran.dg/bounds_check_10.f90 =================================================================== *** gcc/testsuite/gfortran.dg/bounds_check_10.f90 (revision 169916) --- gcc/testsuite/gfortran.dg/bounds_check_10.f90 (working copy) *************** z = [y(1:1), y(1:1), x(1:len(trim(x)))] *** 12,15 **** z = [trim(x), trim(y), "aaaa"] ! [ "a", "cd", "aaaa" ] should catch first error end program array_char ! ! { dg-output "Different CHARACTER lengths .1/2. in array constructor" } --- 12,15 ---- z = [trim(x), trim(y), "aaaa"] ! [ "a", "cd", "aaaa" ] should catch first error end program array_char ! ! { dg-output "Different CHARACTER lengths .1/.. in array constructor" }