From patchwork Mon Feb 19 22:41:30 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Thomas Koenig X-Patchwork-Id: 875333 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-473565-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="OC4Z7DMO"; dkim-atps=neutral Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 3zldz115zNz9ryJ for ; Tue, 20 Feb 2018 09:41:48 +1100 (AEDT) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:to :from:subject:message-id:date:mime-version:content-type; q=dns; s=default; b=rl2DGLIE3r88SkXUvqOHz2HDne11LjFr1+OWTPrDl8xXFvdmkV t+N+FANhmIGbmAqzwG4SW+Fi9jxce07MfaxEL2dGUQDLQMc+H/qBc3wQG70ae3VK 4XFNgUlI21c0RNLQZJ57sGs6R/Tw3/VxSovCCg2ZiEMmw8oLw3hAGpQvQ= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:to :from:subject:message-id:date:mime-version:content-type; s= default; bh=cLK9ARdX7gzikKvQuylguUCfI3U=; b=OC4Z7DMOeaFSVnA86QeI L/n34ADUe5TQuVM8ZwVdr4qUcJKYf62nv2vGArgbbR8IGOHBnc76J+lVf7e24MUU INLPs/A+OsaNb5/wPWywmex38ZExeBuOYB0PbPvpaPQ01TqRFjiHKTAkm/+XryNF ZEr1JUjzLi5SONwHlGYONrQ= Received: (qmail 90573 invoked by alias); 19 Feb 2018 22:41:37 -0000 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 Received: (qmail 90552 invoked by uid 89); 19 Feb 2018 22:41:36 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-11.8 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_2, GIT_PATCH_3, RCVD_IN_DNSWL_LOW, SPF_PASS, T_RP_MATCHES_RCVD autolearn=ham version=3.3.2 spammy=innocent X-Spam-User: qpsmtpd, 2 recipients X-HELO: cc-smtpout1.netcologne.de Received: from cc-smtpout1.netcologne.de (HELO cc-smtpout1.netcologne.de) (89.1.8.211) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Mon, 19 Feb 2018 22:41:34 +0000 Received: from cc-smtpin1.netcologne.de (cc-smtpin1.netcologne.de [89.1.8.201]) by cc-smtpout1.netcologne.de (Postfix) with ESMTP id 358B613466; Mon, 19 Feb 2018 23:41:32 +0100 (CET) Received: from localhost (localhost [127.0.0.1]) by cc-smtpin1.netcologne.de (Postfix) with ESMTP id 297A111DDF; Mon, 19 Feb 2018 23:41:32 +0100 (CET) Received: from [78.35.157.23] (helo=cc-smtpin1.netcologne.de) by localhost with ESMTP (eXpurgate 4.1.9) (envelope-from ) id 5a8b529c-029d-7f0000012729-7f000001a8b0-1 for ; Mon, 19 Feb 2018 23:41:32 +0100 Received: from [192.168.178.20] (xdsl-78-35-157-23.netcologne.de [78.35.157.23]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by cc-smtpin1.netcologne.de (Postfix) with ESMTPSA; Mon, 19 Feb 2018 23:41:30 +0100 (CET) To: "fortran@gcc.gnu.org" , gcc-patches From: Thomas Koenig Subject: [patch, fortran] Fix character length in constructors Message-ID: Date: Mon, 19 Feb 2018 23:41:30 +0100 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:52.0) Gecko/20100101 Thunderbird/52.6.0 MIME-Version: 1.0 Hello world, when putting in a seemingly innocent simplification for PR 56342, I caused a regression in PR 82823, in PACK. The root cause of this one turned out to be PR 48890, in which structure constructors containing characters were not handled correctly if the lengths did not match. The attached patch fixes that. Regression-tested. OK for trunk? Regards Thomas 2018-02-19 Thomas Koenig PR fortran/48890 PR fortran/83823 * primary.c (gfc_convert_to_structure_constructor): For a constant string constructor, make sure the length is correct. 2018-02-19 Thomas Koenig PR fortran/48890 PR fortran/83823 * gfortran.dg/structure_constructor_14.f90: New test. Index: primary.c =================================================================== --- primary.c (Revision 257788) +++ primary.c (Arbeitskopie) @@ -2879,6 +2879,38 @@ gfc_convert_to_structure_constructor (gfc_expr *e, if (!this_comp) goto cleanup; + /* For a constant string constructor, make sure the length is correct; + truncate of fill with blanks if needed. */ + if (this_comp->ts.type == BT_CHARACTER && !this_comp->attr.allocatable + && this_comp->ts.u.cl && this_comp->ts.u.cl->length + && this_comp->ts.u.cl->length->expr_type == EXPR_CONSTANT + && actual->expr->expr_type == EXPR_CONSTANT) + { + ptrdiff_t c, e; + c = mpz_get_si (this_comp->ts.u.cl->length->value.integer); + e = actual->expr->value.character.length; + + if (c != e) + { + ptrdiff_t i, to; + gfc_char_t *dest; + dest = gfc_get_wide_string (c + 1); + + to = e < c ? e : c; + for (i = 0; i < to; i++) + dest[i] = actual->expr->value.character.string[i]; + + for (i = e; i < c; i++) + dest[i] = ' '; + + dest[c] = '\0'; + free (actual->expr->value.character.string); + + actual->expr->value.character.length = c; + actual->expr->value.character.string = dest; + } + } + comp_tail->val = actual->expr; if (actual->expr != NULL) comp_tail->where = actual->expr->where;