From patchwork Mon Sep 17 10:10:50 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Paul Richard Thomas X-Patchwork-Id: 970505 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-485749-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=fail (p=none dis=none) header.from=gmail.com Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="utPh4DPD"; dkim=fail reason="signature verification failed" (2048-bit key; unprotected) header.d=gmail.com header.i=@gmail.com header.b="njX88+jy"; 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 42DMMv2gcdz9sB5 for ; Mon, 17 Sep 2018 20:11:07 +1000 (AEST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :mime-version:from:date:message-id:subject:to:content-type; q= dns; s=default; b=f18AxgRea3YbMZrr/i0WCGaG31XGwizbu5eULnv3wmZoXJ rxp7ExEpT8KX63yoYZZZ4MOSfhbFbKxcIMxEJdT/n0ThpO6mYofw+YoxePH5CeU6 NybmdBQnHSjWIwIEXTjMkH2a7QdGvox7Ksd6PV0xwwZFPKTA8gGOwZECkfooU= 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 :mime-version:from:date:message-id:subject:to:content-type; s= default; bh=S2/4Rvru0g92Pj85HlFUbYsCMAc=; b=utPh4DPDoSLIwNvhnrvL C/hvhbYetmeKjcA/S/es18LOh+zuFgJ3mmKpe8W13WPejLzP08dYNSSDen21ErdA 7HCvm8lcxj23kjF8FGJd40zZzhSK8WrgCGGJyDovfxyHdfyH1AilNGU6cGGo5Bu4 vXBLKSkJ/KCkvxNxr0Y56Y4= Received: (qmail 95677 invoked by alias); 17 Sep 2018 10:10:55 -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 95655 invoked by uid 89); 17 Sep 2018 10:10:55 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-5.7 required=5.0 tests=AWL, BAYES_00, FREEMAIL_FROM, GIT_PATCH_2, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_PASS autolearn=ham version=3.3.2 spammy=sk:gfc_tra, francois-xavier, FrancoisXavier, Francois-Xavier X-HELO: mail-yb1-f171.google.com Received: from mail-yb1-f171.google.com (HELO mail-yb1-f171.google.com) (209.85.219.171) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Mon, 17 Sep 2018 10:10:53 +0000 Received: by mail-yb1-f171.google.com with SMTP id 13-v6so433888ybn.9; Mon, 17 Sep 2018 03:10:53 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=mime-version:from:date:message-id:subject:to; bh=RWq0JsyPXjQekELKhArt11dUiw9CqGkcDCbOeSB2EOc=; b=njX88+jyLycXzqAeEpGybK7q8nmeBeA6KJAV4CmwCUXtrt57qcGXsRE/yWX6f4BQck kAbqOwMQnrmkvi3CZpi/+9CqgRe3pSELZnVZCa0u5idjc+EAcZSWnp8TEDyrerbX8xVU e3vWzWc9BKZrKeKpOvDjqpD8FTu2vSSls4s5S2cZBqsb1bP6s/pYT4eTJKTIUhBYchy9 s2Emnwqs3VQvzRF0iI3Km6ahlq/4kD2f1zydnQIN2UO/oUWJxz7kFNNjkJMHSpajdylJ eKLN4bF8YgaNakVLoGKopW47uiuKhjkRNLiMPs8+in9nIXcdHM5tgULbl7dIwXMewJfR Ceyw== MIME-Version: 1.0 Received: by 2002:a81:7a4b:0:0:0:0:0 with HTTP; Mon, 17 Sep 2018 03:10:50 -0700 (PDT) From: Paul Richard Thomas Date: Mon, 17 Sep 2018 11:10:50 +0100 Message-ID: Subject: [Patch, fortran] PR64120 - [F03] Wrong handling of allocatable character string To: "fortran@gcc.gnu.org" , gcc-patches This patch is relatively trivial. This initialization of the string length was not being done. Bootstraps and regtests on FC28/x86_64. OK for trunk? Paul 2018-09-17 Paul Thomas PR fortran/64120 * trans-decl.c (gfc_get_symbol_decl): Flag allocatable, scalar characters with a variable length expression for deferred init. (gfc_trans_deferred_vars): Perform the assignment for these symbols by calling gfc_conv_string_length. 2018-09-17 Paul Thomas PR fortran/64120 * gfortran.dg/allocatable_scalar_14.f90 : New test. Index: gcc/fortran/trans-decl.c =================================================================== *** gcc/fortran/trans-decl.c (revision 264358) --- gcc/fortran/trans-decl.c (working copy) *************** gfc_get_symbol_decl (gfc_symbol * sym) *** 1745,1750 **** --- 1745,1757 ---- && !(sym->attr.use_assoc && !intrinsic_array_parameter))) gfc_defer_symbol_init (sym); + if (sym->ts.type == BT_CHARACTER + && sym->attr.allocatable + && !sym->attr.dimension + && sym->ts.u.cl && sym->ts.u.cl->length + && sym->ts.u.cl->length->expr_type == EXPR_VARIABLE) + gfc_defer_symbol_init (sym); + /* Associate names can use the hidden string length variable of their associated target. */ if (sym->ts.type == BT_CHARACTER *************** gfc_trans_deferred_vars (gfc_symbol * pr *** 4603,4608 **** --- 4610,4622 ---- gfc_set_backend_locus (&sym->declared_at); gfc_start_block (&init); + if (sym->ts.type == BT_CHARACTER + && sym->attr.allocatable + && !sym->attr.dimension + && sym->ts.u.cl && sym->ts.u.cl->length + && sym->ts.u.cl->length->expr_type == EXPR_VARIABLE) + gfc_conv_string_length (sym->ts.u.cl, NULL, &init); + if (!sym->attr.pointer) { /* Nullify and automatic deallocation of allocatable Index: gcc/testsuite/gfortran.dg/allocatable_scalar_14.f90 =================================================================== *** gcc/testsuite/gfortran.dg/allocatable_scalar_14.f90 (nonexistent) --- gcc/testsuite/gfortran.dg/allocatable_scalar_14.f90 (working copy) *************** *** 0 **** --- 1,17 ---- + ! { dg-do run } + ! + ! Test the fix for PR64120 in which the initialisation of the + ! string length of 's' was not being done. + ! + ! Contributed by Francois-Xavier Coudert + ! + call g(1) + call g(2) + contains + subroutine g(x) + integer :: x + character(len=x), allocatable :: s + allocate(s) + if (len(s) .ne. x) stop x + end subroutine + end