From patchwork Sun Sep 30 14:00:20 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: 976888 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-486686-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="dMFe05W1"; dkim=fail reason="signature verification failed" (2048-bit key; unprotected) header.d=gmail.com header.i=@gmail.com header.b="Er4pWBUv"; 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 42NRs96dRZz9s3x for ; Mon, 1 Oct 2018 00:01:00 +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:references:in-reply-to:from:date:message-id :subject:to:cc:content-type; q=dns; s=default; b=lBKbfXtjYGMMG2d 3ccgmJzXpbaGQpzmmd2XGhWsH/OmI6lf9C07uh0OENOKlnigx46mREMGAtAxpabF nmW/mNqAnYa1KmLI63zWqwdkT85cyekeip8jIHPQ/3KQi1DxVRWU9UsAvntt4TnE CdK2FvcxaeF3XeIa2Ypbv/p3YQzk= 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:references:in-reply-to:from:date:message-id :subject:to:cc:content-type; s=default; bh=75lzq03pLcjDqARCCI3rB ZEPWOc=; b=dMFe05W1UbQhgLaN9TIlq7SfMDVVTStwbXrfql1sMf4hCcn4fIxeL Im/KrCtdmUmfqLVOWXEIx2oHtU8QewzfC9+4nzW3KAaHlv2/yX4T3rbuy0+FpBXs zWzWAOthbtuESO9lcVqnmfYC0wL1bNIR9FzikURrS3nnFRhOEv6H1Q= Received: (qmail 53377 invoked by alias); 30 Sep 2018 14:00:44 -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 53289 invoked by uid 89); 30 Sep 2018 14:00:38 -0000 Authentication-Results: sourceware.org; auth=none X-Spam-SWARE-Status: No, score=-6.1 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=inout, HCc:D*fr, deallocate X-HELO: mail-yb1-f169.google.com Received: from mail-yb1-f169.google.com (HELO mail-yb1-f169.google.com) (209.85.219.169) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Sun, 30 Sep 2018 14:00:34 +0000 Received: by mail-yb1-f169.google.com with SMTP id e190-v6so4564705ybb.5; Sun, 30 Sep 2018 07:00:34 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=mime-version:references:in-reply-to:from:date:message-id:subject:to :cc; bh=8yPrcqaO/MtuA46csjlIITq4mKfZg2UM/ZZUyXC4lG0=; b=Er4pWBUvaKww51H8Q3w4IbrbJrLEjeTYJN+nkm9FzuNYedTQYOGFOJ/rFZRaeu2EZN W0scQVjpt2PzCV0XAF+T1DBHJaMNIGW8wyNmBMcIYEpA2jhNkshXbbWX5z4ght5ayA7K CMSI7o2J4JWdVI+koJeivG2AgupOTul4qj8NtPuVvd61BH/NcvX8J+VofIG2uyLiJrI5 5fuOy60wzr53lZw0JlBL6hUvYo5JGU+IR8ym+kI+1jJ67aisOreBpcSE8Q1nhhwy/piE nrYNfYZ/V+HsAUT+Q1yHrMku1+zGFdDNglas0ikqSttNYGdPn9TG9tN/kdQep2z0r/xK NjXg== MIME-Version: 1.0 References: In-Reply-To: From: Paul Richard Thomas Date: Sun, 30 Sep 2018 15:00:20 +0100 Message-ID: Subject: [Patch, fortran] PR87359 [9 regression] pointer being freed was not allocated To: "fortran@gcc.gnu.org" , gcc-patches Cc: Dominique Dhumieres , =?utf-8?q?J=C3=BCrgen_Reuter?= After testing by Dominique and Juergen. Committed as revision 264725. Thanks to Dominique and juergen for doing all the hard work! Cheers Paul 2018-09-30 Paul Thomas PR fortran/87359 * trans-array.c (gfc_is_reallocatable_lhs): Correct the problem introduced by r264358, which prevented components of associate names from being reallocated on assignment. 2018-09-30 Paul Thomas PR fortran/87359 * gfortran.dg/associate_40.f90 : New test. Index: gcc/fortran/trans-array.c =================================================================== *** gcc/fortran/trans-array.c (revision 264724) --- gcc/fortran/trans-array.c (working copy) *************** gfc_is_reallocatable_lhs (gfc_expr *expr *** 9574,9584 **** sym = expr->symtree->n.sym; ! if (sym->attr.associate_var) return false; /* An allocatable class variable with no reference. */ if (sym->ts.type == BT_CLASS && CLASS_DATA (sym)->attr.allocatable && expr->ref && expr->ref->type == REF_COMPONENT && strcmp (expr->ref->u.c.component->name, "_data") == 0 --- 9574,9585 ---- sym = expr->symtree->n.sym; ! if (sym->attr.associate_var && !expr->ref) return false; /* An allocatable class variable with no reference. */ if (sym->ts.type == BT_CLASS + && !sym->attr.associate_var && CLASS_DATA (sym)->attr.allocatable && expr->ref && expr->ref->type == REF_COMPONENT && strcmp (expr->ref->u.c.component->name, "_data") == 0 *************** gfc_is_reallocatable_lhs (gfc_expr *expr *** 9587,9595 **** /* An allocatable variable. */ if (sym->attr.allocatable ! && expr->ref ! && expr->ref->type == REF_ARRAY ! && expr->ref->u.ar.type == AR_FULL) return true; /* All that can be left are allocatable components. */ --- 9588,9597 ---- /* An allocatable variable. */ if (sym->attr.allocatable ! && !sym->attr.associate_var ! && expr->ref ! && expr->ref->type == REF_ARRAY ! && expr->ref->u.ar.type == AR_FULL) return true; /* All that can be left are allocatable components. */ Index: gcc/testsuite/gfortran.dg/associate_40.f90 =================================================================== *** gcc/testsuite/gfortran.dg/associate_40.f90 (nonexistent) --- gcc/testsuite/gfortran.dg/associate_40.f90 (working copy) *************** *** 0 **** --- 1,96 ---- + ! { dg-do compile } + ! { dg-options "-fdump-tree-original" } + ! + ! Test the fix for the second part of PR87359 in which the reallocation on + ! assignment for components of associate names was disallowed by r264358. + ! -fcheck-all exposed the mismatch in array shapes. The deallocations at + ! the end of the main program are there to make sure that valgrind does + ! not report an memory leaks. + ! + ! Contributed by Juergen Reuter + ! + module phs_fks + implicit none + private + public :: phs_identifier_t + public :: phs_fks_t + type :: phs_identifier_t + integer, dimension(:), allocatable :: contributors + contains + procedure :: init => phs_identifier_init + end type phs_identifier_t + + type :: phs_fks_t + type(phs_identifier_t), dimension(:), allocatable :: phs_identifiers + end type phs_fks_t + contains + + subroutine phs_identifier_init & + (phs_id, contributors) + class(phs_identifier_t), intent(out) :: phs_id + integer, intent(in), dimension(:) :: contributors + allocate (phs_id%contributors (size (contributors))) + phs_id%contributors = contributors + end subroutine phs_identifier_init + + end module phs_fks + + !!!!! + + module instances + use phs_fks + implicit none + private + public :: process_instance_t + + type :: nlo_event_deps_t + type(phs_identifier_t), dimension(:), allocatable :: phs_identifiers + end type nlo_event_deps_t + + type :: process_instance_t + type(phs_fks_t), pointer :: phs => null () + type(nlo_event_deps_t) :: event_deps + contains + procedure :: init => process_instance_init + procedure :: setup_real_event_kinematics => pi_setup_real_event_kinematics + end type process_instance_t + + contains + + subroutine process_instance_init (instance) + class(process_instance_t), intent(out), target :: instance + integer :: i + integer :: i_born, i_real + allocate (instance%phs) + end subroutine process_instance_init + + subroutine pi_setup_real_event_kinematics (process_instance) + class(process_instance_t), intent(inout) :: process_instance + integer :: i_real, i + associate (event_deps => process_instance%event_deps) + i_real = 2 + associate (phs => process_instance%phs) + allocate (phs%phs_identifiers (3)) + call phs%phs_identifiers(1)%init ([1]) + call phs%phs_identifiers(2)%init ([1,2]) + call phs%phs_identifiers(3)%init ([1,2,3]) + process_instance%event_deps%phs_identifiers = phs%phs_identifiers ! Error: mismatch in array shapes. + end associate + end associate + end subroutine pi_setup_real_event_kinematics + + end module instances + + !!!!! + + program main + use instances, only: process_instance_t + implicit none + type(process_instance_t), allocatable, target :: process_instance + allocate (process_instance) + call process_instance%init () + call process_instance%setup_real_event_kinematics () + if (associated (process_instance%phs)) deallocate (process_instance%phs) + if (allocated (process_instance)) deallocate (process_instance) + end program main + ! { dg-final { scan-tree-dump-times "__builtin_realloc" 2 "original" } }