From patchwork Sun Dec 23 10:29:10 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: 1017989 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-493057-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="XVoxRU68"; dkim=fail reason="signature verification failed" (2048-bit key; unprotected) header.d=gmail.com header.i=@gmail.com header.b="aXgg55Co"; 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 43MzDB62PLz9sCh for ; Sun, 23 Dec 2018 21:31:03 +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 :mime-version:from:date:message-id:subject:to:content-type; q= dns; s=default; b=qxokOawxgdu10UyTbrQKwRC3B+cTv+jB7GN694zqT6CHF4 5P+K9FR3yCAYUJgXqYW09NHRD7lx7sNSXTJ2/iox/JcSlornG5BH2fV4ZR4GSlhh ptQSuga7iV7I7+TYtZ48gmzJ2uaeFLUwDin/xQ20Amki5Rp4EYsoJZjjnacM4= 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=bv2iAFPWWC7o11p/Q9aOT3l0PYc=; b=XVoxRU68wHIb/6276+ql GTuxb6MwcU/C4MZD3+IiX5OXQMLJPH0KGteTy/PKzTpMsFqN+XKIgwpJxVcmAmfp Wgj/71F+yKzPC+LM0fB9WR8L0xioA9l6sYWz0tXbLgfrTwdsqe1UgO/y9AmysrsX UdKxWOhRqGlPwMhJVI8pyBI= Received: (qmail 52110 invoked by alias); 23 Dec 2018 10:30:53 -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 52026 invoked by uid 89); 23 Dec 2018 10:30:52 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-5.4 required=5.0 tests=BAYES_00, FREEMAIL_FROM, GIT_PATCH_2, KAM_ASCII_DIVIDERS, SPF_SOFTFAIL autolearn=unavailable version=3.3.2 spammy= X-HELO: eggs.gnu.org Received: from eggs.gnu.org (HELO eggs.gnu.org) (208.118.235.92) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Sun, 23 Dec 2018 10:30:50 +0000 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1gb120-0006ke-Ek for gcc-patches@gcc.gnu.org; Sun, 23 Dec 2018 05:30:49 -0500 Received: from mail-yb1-xb35.google.com ([2607:f8b0:4864:20::b35]:44982) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1gb11b-0006Ir-8d; Sun, 23 Dec 2018 05:30:23 -0500 Received: by mail-yb1-xb35.google.com with SMTP id d2so3900919ybs.11; Sun, 23 Dec 2018 02:30:23 -0800 (PST) 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=ljKi0OtLG1C0yYQdoY5X3PVEz11v0/CZ4rv/kI0L/CE=; b=aXgg55CocJhK0lHdkrFxpdCgfW2Ufa1MSfaIZidU9vGZsQBxXMLxL1KOjPL/WcV6F0 +KhwV/uaWITrProKsPraWvDCZ7LVfdjIMAN5aCfa1s5K2SkucRV6jzSPJuB8p0SxOBVr h1taNe9WGbxh9bCFNXGNyucf6CaO6cUGhC+JyBEcUoiS94+JBo2I+DasmVzZSUNW2kkE DBxNbgWUNO/ObJFx+OUHGm2t0Cqq0trmTgl+TL+Qphwq5JPV1nFhRnI+lDGiVbT1NBZ9 EVU8CiXj5ceeYYvbyt2hkXgAt0fLDrUrYB2H0sJ8hLJOViCV6zDPM78FikyQhYl8mf43 ULng== MIME-Version: 1.0 From: Paul Richard Thomas Date: Sun, 23 Dec 2018 10:29:10 +0000 Message-ID: Subject: [Patch, fortran] PR77703 - [7/8/9 Regression] ICE on assignment to pointer function To: "fortran@gcc.gnu.org" , gcc-patches X-detected-operating-system: by eggs.gnu.org: Genre and OS details not recognized. X-Received-From: 2607:f8b0:4864:20::b35 I will apply this as 'obvious' this evening, unless there are objections. The patch is entirely self-explanatory. Paul 2018-12-23 Paul Thomas PR fortran/77703 * resolve.c (get_temp_from_expr): Use the string length of constant character expressions. 2018-12-23 Paul Thomas PR fortran/77703 * gfortran.dg/ptr_func_assign_5.f08 : New test. Index: gcc/fortran/resolve.c =================================================================== *** gcc/fortran/resolve.c (revision 267336) --- gcc/fortran/resolve.c (working copy) *************** get_temp_from_expr (gfc_expr *e, gfc_nam *** 10637,10642 **** --- 10637,10647 ---- gfc_get_sym_tree (name, ns, &tmp, false); gfc_add_type (tmp->n.sym, &e->ts, NULL); + if (e->expr_type == EXPR_CONSTANT && e->ts.type == BT_CHARACTER) + tmp->n.sym->ts.u.cl->length = gfc_get_int_expr (gfc_charlen_int_kind, + NULL, + e->value.character.length); + as = NULL; ref = NULL; aref = NULL; Index: gcc/testsuite/gfortran.dg/ptr_func_assign_5.f08 =================================================================== *** gcc/testsuite/gfortran.dg/ptr_func_assign_5.f08 (nonexistent) --- gcc/testsuite/gfortran.dg/ptr_func_assign_5.f08 (working copy) *************** *** 0 **** --- 1,45 ---- + ! { dg-do run } + ! + ! Test the fix for PR77703, in which calls of the pointer function + ! caused an ICE in 'gfc_trans_auto_character_variable'. + ! + ! Contributed by Gerhard Steinmetz + ! + module m + implicit none + private + integer, parameter, public :: n = 2 + integer, parameter :: ell = 6 + + character(len=n*ell), target, public :: s + + public :: t + contains + function t( idx ) result( substr ) + integer, intent(in) :: idx + character(len=ell), pointer :: substr + + if ( (idx < 0).or.(idx > n) ) then + error stop + end if + substr => s((idx-1)*ell+1:idx*ell) + end function t + end module m + + program p + use m, only : s, t, n + integer :: i + + ! Define 's' + s = "123456789012" + + ! Then perform operations involving 't' + if (t(1) .ne. "123456") stop 1 + if (t(2) .ne. "789012") stop 2 + + ! Do the pointer function assignments + t(1) = "Hello " + if (s .ne. "Hello 789012") Stop 3 + t(2) = "World!" + if (s .ne. "Hello World!") Stop 4 + end program p