From patchwork Thu May 17 12:17:43 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: 915399 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-477852-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="f+KZu/bo"; 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 40mr0z67Dgz9s0y for ; Thu, 17 May 2018 22:17:55 +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=f9yfLiS2uiR/DCq1E+FZ1B3c0AxdBJAMmH5UiQyGAz+718 3oB6EdsHQdAkdRfggRqxZbZ7cEOSTlNgz6ymGRFlhuVjD7PtMe1xH/UZVMGCUgQP g5tNRYGZL6VC0qypTlFEalnERl6Zf8KiPjS8EBH/Zu1Ph5ZWYFGTb9TzxOw3s= 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=h95YI0Y4viprrz1XhqC89sLV3wc=; b=f+KZu/boiOo88SJO3Uql sODzUsKQcZ8siu5w3cK56IgJqTDAqvW5kIfcOL4MzWBFh4luYH0bkje6Sf5ca2ZK UA5Me09bN1duviqbwREdzqplAn3aOeFqE1eAOd7Y2mouujRVrQ7s7lr7M1/meRGe fpbR0eaiDVxwZS0yHpBvDdA= Received: (qmail 36345 invoked by alias); 17 May 2018 12:17:48 -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 36320 invoked by uid 89); 17 May 2018 12:17:47 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-5.6 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=7-branch, 7branch, Automatic, ts.type X-Spam-User: qpsmtpd, 2 recipients X-HELO: mail-yb0-f182.google.com Received: from mail-yb0-f182.google.com (HELO mail-yb0-f182.google.com) (209.85.213.182) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Thu, 17 May 2018 12:17:46 +0000 Received: by mail-yb0-f182.google.com with SMTP id o14-v6so1375174ybq.3; Thu, 17 May 2018 05:17:45 -0700 (PDT) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:mime-version:from:date:message-id:subject:to; bh=GM80ZlhZ1JiTtxXmpFKi7gzIuuvLmii8INRz94T/vI4=; b=CpDG3OwKTJJ3b6QdtVuEqaNq9WV4Usr0e9JXbZdPlNGcULCaVTrcNLYUq5dx2ae5C+ MX8fA/P3VdFpdW6tr4MuCFcpb3h3H2MA3gg+SJUiUMuXYjuCiUm98uDYzPq+6gE7WnHS aO2knewOL7e/OAwDqRUUn6b7M5BwkdyEDr+maRTh67lzS0DJdaUIBxUmdLfdV1HOUYrI +Log7+pmuF1OxtSim2FQO16/qT/qCN9RiZ72khG0rKiGgxAWRHArkGN4PEgskAuXOTL9 LKspNFODtqt5AqLPCRlEBlg6G+4rpd+dRDB3taQ8f2m6WdUtzA1t7q/KGjDroaH0QopR chEQ== X-Gm-Message-State: ALKqPwdEUesYVvtB0pERTGJ7/Ffrkl/vxurSdDsxQpaQYtKKzO/ezF2P g+rnF2EI65m81V0CkmEAH/Glqq85MVUud2cRpdoWWA== X-Google-Smtp-Source: AB8JxZroZbR44EODGcJYe9JbhqmshMEvJjUtbfEIPHviliJVUYPgFoyQa107fywzYZpVs7qeDQIB3VErBRhcfMh18zo= X-Received: by 2002:a25:2d0e:: with SMTP id t14-v6mr2434808ybt.42.1526559464164; Thu, 17 May 2018 05:17:44 -0700 (PDT) MIME-Version: 1.0 Received: by 10.13.215.196 with HTTP; Thu, 17 May 2018 05:17:43 -0700 (PDT) From: Paul Richard Thomas Date: Thu, 17 May 2018 13:17:43 +0100 Message-ID: Subject: [Patch, fortran] PR82923 - Automatic allocation of deferred length character using function result To: "fortran@gcc.gnu.org" , gcc-patches The ChangeLog and the comments in the patch tell all. Bootstrapped and regtested on FC27/x86_64. OK for 7-branch through to trunk? Paul 2018-05-17 Paul Thomas PR fortran/82923 * trans-array.c (gfc_alloc_allocatable_for_assignment): Set the charlen backend_decl of the rhs expr to ss->info->string_length so that the value in the current scope is used. 2018-05-17 Paul Thomas PR fortran/82923 * gfortran.dg/allocate_assumed_charlen_4.f90: New test. Index: gcc/fortran/trans-array.c =================================================================== *** gcc/fortran/trans-array.c (revision 260210) --- gcc/fortran/trans-array.c (working copy) *************** gfc_alloc_allocatable_for_assignment (gf *** 9698,9703 **** --- 9698,9709 ---- if (expr2 && rss == gfc_ss_terminator) return NULL_TREE; + /* Ensure that the string length from the current scope is used. */ + if (expr2->ts.type == BT_CHARACTER + && expr2->expr_type == EXPR_FUNCTION + && !expr2->value.function.isym) + expr2->ts.u.cl->backend_decl = rss->info->string_length; + gfc_start_block (&fblock); /* Since the lhs is allocatable, this must be a descriptor type. Index: gcc/testsuite/gfortran.dg/allocate_assumed_charlen_4.f90 =================================================================== *** gcc/testsuite/gfortran.dg/allocate_assumed_charlen_4.f90 (nonexistent) --- gcc/testsuite/gfortran.dg/allocate_assumed_charlen_4.f90 (working copy) *************** *** 0 **** --- 1,39 ---- + ! { dg-do run } + ! + ! Test the fix for PR82923, in which an ICE occurred because the + ! character length from 'getchars' scope was being used in the + ! automatic allocataion of 'mine'. + ! + ! Contributed by Werner Blokbuster + ! + module m + implicit none + contains + function getchars(my_len,my_size) + integer, intent(in) :: my_len, my_size + character(my_len) :: getchars(my_size) + getchars = 'A-' + end function getchars + + function getchars2(my_len) + integer, intent(in) :: my_len + character(my_len) :: getchars2 + getchars2 = 'B--' + end function getchars2 + end module m + + program testca + use m, only: getchars, getchars2 + implicit none + character(:), allocatable :: mine(:) + character(:), allocatable :: mine2 + integer :: i + + ! ICE occured at this line: + mine = getchars(2,4) + if (any (mine .ne. [('A-', i = 1, 4)])) stop 1 + + ! The scalar version was fine and this will keep it so: + mine2 = getchars2(3) + if (mine2 .ne. 'B--') stop 2 + end program testca