From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from smtp.smtpout.orange.fr (smtp-18.smtpout.orange.fr [80.12.242.18]) by sourceware.org (Postfix) with ESMTPS id C48913858423 for ; Wed, 5 Jul 2023 14:54:59 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org C48913858423 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=orange.fr Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=orange.fr Received: from [192.168.1.16] ([86.215.161.51]) by smtp.orange.fr with ESMTPA id H3u8qy4WAJGUmH3uDq3cAt; Wed, 05 Jul 2023 16:54:58 +0200 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=orange.fr; s=t20230301; t=1688568898; bh=um+7Hj+5tJoiDSjwLLBEeZc9tN2A+gDueKmUNm8+11Q=; h=Date:Subject:From:To:References:In-Reply-To; b=IhRlh3KAzYXsSkxya97zXR3gUYRy/7FZlnGUqmyV9BwBq4ywJvAavFt1lVhrc0XHe XrU4Zhb2TVhqqhy5yVTlYkh6EjAU0agEfK9asm2GnEhCOLsx/zaexTJ/ZYiw+QMvRU khQ4yDxFxH2t8Okh6zTy7SJzxgIc0s7ByOTDf1HunlGIFAHgm9IXlyvifwOoO3TQkS QqIQLfY/lK0aMbQDc7xqLpsQzzHJWPQG0cdIONSTcGZTKvIyFSD83DMQXFifOvEZEy 2oR40LVjFKD6K/093/qDSKmGVk1RVwN7MaAipl8hQCjTidImSZQAD+19ZOg5cfja3g lROb4cLL+qsjA== X-ME-Helo: [192.168.1.16] X-ME-Auth: bW9yaW4tbWlrYWVsQG9yYW5nZS5mcg== X-ME-Date: Wed, 05 Jul 2023 16:54:58 +0200 X-ME-IP: 86.215.161.51 Message-ID: Date: Wed, 5 Jul 2023 16:54:51 +0200 MIME-Version: 1.0 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:102.0) Gecko/20100101 Thunderbird/102.12.0 Subject: Re: [PATCH] Fortran: fixes for procedures with ALLOCATABLE,INTENT(OUT) arguments [PR92178] From: Mikael Morin To: Harald Anlauf , fortran , gcc-patches References: <5a5306ae-0db1-c7e2-e744-a3beced17636@orange.fr> <3adc2904-9876-74d6-2b5d-3cc1896866c3@gmx.de> <3e31cc66-b7ae-adb0-f1a8-18b8bcc11c46@orange.fr> Content-Language: fr In-Reply-To: <3e31cc66-b7ae-adb0-f1a8-18b8bcc11c46@orange.fr> Content-Type: text/plain; charset=UTF-8; format=flowed Content-Transfer-Encoding: 8bit X-Spam-Status: No, score=-11.3 required=5.0 tests=BAYES_00,BODY_8BITS,DKIM_SIGNED,DKIM_VALID,DKIM_VALID_AU,DKIM_VALID_EF,FREEMAIL_FROM,GIT_PATCH_0,JMQ_SPF_NEUTRAL,NICE_REPLY_A,RCVD_IN_DNSWL_NONE,RCVD_IN_MSPIKE_H3,RCVD_IN_MSPIKE_WL,SPF_HELO_PASS,SPF_PASS,TXREP,T_SCC_BODY_TEXT_LINE autolearn=unavailable autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org List-Id: Le 04/07/2023 à 21:37, Mikael Morin a écrit : > Le 04/07/2023 à 21:00, Harald Anlauf a écrit : >> Hi Mikael, all, >> >> I think I've found it: there is a call to gfc_conv_class_to_class >> that - according to a comment - does a repackaging to a class array. >> Deferring that repackaging along with the deallocation not only fixes >> the regression, but also the cases I tested. >> >> Attached is a "sneak preview", hoping that the experts (Paul, Mikael, >> ...) can tell if I am going down the wrong road. >> > I think that's it mostly.  There is one last thing that I am not sure... > >> diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc >> index 16e8f037cfc..a68c8d33acc 100644 >> --- a/gcc/fortran/trans-expr.cc >> +++ b/gcc/fortran/trans-expr.cc >> @@ -6858,6 +6860,10 @@ gfc_conv_procedure_call (gfc_se * se, >> gfc_symbol * sym, >>                       && e->symtree->n.sym->attr.optional, >>                       CLASS_DATA (fsym)->attr.class_pointer >>                       || CLASS_DATA (fsym)->attr.allocatable); >> + >> +          /* Defer repackaging after deallocation.  */ >> +          if (defer_repackage) >> +        gfc_add_block_to_block (&dealloc_blk, &parmse.pre); >>          } >>        else >>          { > > ... whether you will not be deferring too much here.  That is parmse.pre > contains both the argument evaluation and the class container setup from > gfc_conv_class_to_class.  If it's safe to defer both, that's fine, > otherwise a separate gfc_se struct should be passed to > gfc_conv_class_to_class so that only the latter part can be deferred. > Need to think of an example... Here is an example, admittedly artificial. Fails with the above change, but fails with master as well. program p implicit none type t integer :: i end type t type u class(t), allocatable :: ta(:) end type u type(u), allocatable, target :: c(:) c = [u([t(1), t(3)]), u([t(4), t(9)])] call bar (allocated (c(c(1)%ta(1)%i)%ta), c(c(1)%ta(1)%i)%ta, allocated (c(c(1)%ta(1)%i)%ta)) if (allocated(c(1)%ta)) stop 11 if (.not. allocated(c(2)%ta)) stop 12 contains subroutine bar (alloc, x, alloc2) logical :: alloc, alloc2 class(t), allocatable, intent(out) :: x(:) if (allocated (x)) stop 1 if (.not. alloc) stop 2 if (.not. alloc2) stop 3 end subroutine bar end