From patchwork Mon Sep 27 18:50:31 2010 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Thomas Koenig X-Patchwork-Id: 65907 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 B220BB70CD for ; Tue, 28 Sep 2010 04:50:45 +1000 (EST) Received: (qmail 14514 invoked by alias); 27 Sep 2010 18:50:42 -0000 Received: (qmail 14498 invoked by uid 22791); 27 Sep 2010 18:50:41 -0000 X-SWARE-Spam-Status: No, hits=-0.8 required=5.0 tests=AWL, BAYES_00, KAM_STOCKGEN, RCVD_IN_DNSWL_NONE, TW_CP, T_RP_MATCHES_RCVD X-Spam-Check-By: sourceware.org Received: from smtp5.netcologne.de (HELO smtp5.netcologne.de) (194.8.194.25) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Mon, 27 Sep 2010 18:50:34 +0000 Received: from [192.168.0.196] (xdsl-87-79-52-18.netcologne.de [87.79.52.18]) by smtp5.netcologne.de (Postfix) with ESMTP id F2EC640D937; Mon, 27 Sep 2010 20:50:31 +0200 (CEST) Subject: [patch, fortran] Add string padding on assignment From: Thomas Koenig To: fortran@gcc.gnu.org Cc: gcc-patches@gcc.gnu.org Date: Mon, 27 Sep 2010 20:50:31 +0200 Message-ID: <1285613431.7401.5.camel@linux-fd1f.site> Mime-Version: 1.0 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 Hello world, this patch addresses the case where a constant string is assigned to a longer string, requiring padding with blanks. This adds the blanks in the front end, transforming character*2 a a = 'y' into character*2 a a = 'y ' To avoid bloat for strings, I set an arbitrary limit of <8 spaces to be padded, but of course I'd welcome better suggesionts. Regression-tested. OK for trunk with or without a better strategy? Thomas 2010-09-27 Thomas Koenig PR fortran/45636 * frontend-passes.c (optimize_assignment): In an assignment, fill up blanks on the right-hand side if fewer than STRING_PAD_LIMIT characters are missing. 2010-09-27 Thomas Koenig PR fortran/45636 * gfortran.dg/character_pad_1.f90: New test. Index: frontend-passes.c =================================================================== --- frontend-passes.c (Revision 164618) +++ frontend-passes.c (Arbeitskopie) @@ -165,10 +165,10 @@ optimize_assignment (gfc_code * c) lhs = c->expr1; rhs = c->expr2; - /* Optimize away a = trim(b), where a is a character variable. */ - if (lhs->ts.type == BT_CHARACTER) { + /* Optimize away a = trim(b), where a is a character variable. */ + if (rhs->expr_type == EXPR_FUNCTION && rhs->value.function.isym && rhs->value.function.isym->id == GFC_ISYM_TRIM) @@ -177,8 +177,69 @@ optimize_assignment (gfc_code * c) optimize_assignment (c); return; } + + /* Fill up blanks on the right-hand side on assignment, if they extend + the length by less than 8 bytes. This is an arbitrary limit.*/ + +#define STRING_PAD_LIMIT 8 + + if (rhs->expr_type == EXPR_CONSTANT) + { + mpz_t lhs_l, diff; + bool valid_lhs = false; + + mpz_init (lhs_l); + mpz_init (diff); + + if (lhs->ref && lhs->ref->type == REF_SUBSTRING) + { + if (lhs->ref->u.ss.start->expr_type == EXPR_CONSTANT + && lhs->ref->u.ss.end->expr_type == EXPR_CONSTANT) + { + mpz_sub (lhs_l, lhs->ref->u.ss.end->value.integer, + lhs->ref->u.ss.start->value.integer); + mpz_add_ui (lhs_l, lhs_l, 1u); + valid_lhs = true; + } + } + else if (lhs->ts.u.cl->length) + { + mpz_set (lhs_l, lhs->ts.u.cl->length->value.integer); + valid_lhs = true; + } + + if (valid_lhs) + { + mpz_sub_ui (diff, lhs_l, rhs->value.character.length); + if (mpz_cmp_si (diff, 0) > 0 + && mpz_cmp_si (diff, STRING_PAD_LIMIT) < 0) + { + long int sz; + int i; + gfc_char_t *v; + + sz = mpz_get_si (lhs_l); + v = gfc_get_wide_string (sz); + + memcpy (v, rhs->value.character.string, + rhs->value.character.length*sizeof(gfc_char_t)); + + for (i=rhs->value.character.length; ivalue.character.string); + rhs->value.character.string = v; + rhs->value.character.length = sz; + } + } + + mpz_clear (lhs_l); + mpz_clear(diff); + } } +#undef STRING_PAD_LIMIT + if (lhs->rank > 0 && gfc_check_dependency (lhs, rhs, true) == 0) optimize_binop_array_assignment (c, &rhs, false); }