public inbox for gcc-patches@gcc.gnu.org
 help / color / mirror / Atom feed
From: Harald Anlauf <anlauf@gmx.de>
To: Mikael Morin <morin-mikael@orange.fr>,
	fortran <fortran@gcc.gnu.org>,
	gcc-patches <gcc-patches@gcc.gnu.org>
Subject: Re: [PATCH] Fortran: fixes for procedures with ALLOCATABLE,INTENT(OUT) arguments [PR92178]
Date: Tue, 4 Jul 2023 21:00:23 +0200	[thread overview]
Message-ID: <f5110257-a266-96ce-611c-279dfac1a6c6@gmx.de> (raw)
In-Reply-To: <cc64dd5f-4ded-a4bb-9bd7-94b3383cbdac@orange.fr>

[-- Attachment #1: Type: text/plain, Size: 4278 bytes --]

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'll wrap up all pieces and resubmit when the dust settles.

We can then address the other findings later.

Harald

Am 04.07.23 um 15:35 schrieb Mikael Morin:
> Le 03/07/2023 à 22:49, Harald Anlauf a écrit :
>> Hi Mikael,
>>
>> Am 03.07.23 um 13:46 schrieb Mikael Morin:
>>> These look good, but I'm surprised that there is no similar change at
>>> the 6819 line.
>>> This is the class array actual vs class array dummy case.
>>> It seems to be checked by the "bar" subroutine in your testcase, except
>>> that the intent(out) argument comes last there, whereas it was coming
>>> first with the original testcases in the PR.
>>> Can you double check?
>>
>> I believe I tried that before and encountered regressions.
>> The change
>>
>> diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
>> index 16e8f037cfc..43e013fa720 100644
>> --- a/gcc/fortran/trans-expr.cc
>> +++ b/gcc/fortran/trans-expr.cc
>> @@ -6844,7 +6844,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol *
>> sym,
>>                    else
>>                      tmp = gfc_finish_block (&block);
>>
>> -                 gfc_add_expr_to_block (&se->pre, tmp);
>> +//               gfc_add_expr_to_block (&se->pre, tmp);
>> +                 gfc_add_expr_to_block (&dealloc_blk, tmp);
>>                  }
>>
>>                /* The conversion does not repackage the reference to a
>> class
>>
>> regresses on:
>> gfortran.dg/class_array_16.f90
>> gfortran.dg/finalize_12.f90
>> gfortran.dg/optional_class_1.f90
>>
>> A simplified testcase for further study:
>>
>> program p
>>    implicit none
>>    class(*),  allocatable :: c(:)
>>    c = [3, 4]
>>    call bar (allocated (c), c, allocated (c))
>>    if (allocated (c)) stop 14
>> contains
>>    subroutine bar (alloc, x, alloc2)
>>      logical :: alloc, alloc2
>>      class(*), allocatable, intent(out) :: x(:)
>>      if (allocated (x)) stop 5
>>      if (.not. alloc)   stop 6
>>      if (.not. alloc2)  stop 16
>>    end subroutine bar
>> end
>>
>> (This fails in a different place for the posted patch and for
>> the above trial change.  Need to go to the drawing board...)
>>
> I've had a quick look.
>
> The code originally generated looks like:
>
>      D.4343 = (void *[0:] * restrict) c._data.data != 0B;
>      if (c._data.data != 0B)
>        // free c._data.data
>      c._data.data = 0B;
>      ...
>      class.3._data = c._data;
>      ...
>      D.4345 = (void *[0:] * restrict) c._data.data != 0B;
>      bar (&D.4343, &class.3, &D.4345);
>
> this fails because D.4345 has the wrong value.
> With your change, it becomes:
>
>      D.4343 = (void *[0:] * restrict) c._data.data != 0B;
>      ...
>      class.3._data = c._data;
>      ...
>      D.4345 = (void *[0:] * restrict) c._data.data != 0B;
>      if (c._data.data != 0B)
>        // free c._data.data
>      c._data.data = 0B;
>      bar (&D.4343, &class.3, &D.4345);
>
> and then it is class.3._data that has the wrong value.
> So basically the initialization of class.3 should move with the
> deallocation.
>
> I can reproduce a similar problem with your unmodified patch on the
> following variant:
>
> program p
>    implicit none
>    class(*),  allocatable :: c
>    c = 3
>    call bar (c, allocated (c))
>    if (allocated (c)) stop 14
> contains
>    subroutine bar (x, alloc2)
>      logical :: alloc, alloc2
>      class(*), allocatable, intent(out) :: x(..)
>      if (allocated (x)) stop 5
>      if (.not. alloc)   stop 6
>      if (.not. alloc2)  stop 16
>    end subroutine bar
> end
>
>
>

[-- Attachment #2: pr92178-v2-partial.patch --]
[-- Type: text/x-patch, Size: 2317 bytes --]

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
@@ -6804,6 +6804,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 	      /* Pass a class array.  */
 	      parmse.use_offset = 1;
 	      gfc_conv_expr_descriptor (&parmse, e);
+	      bool defer_repackage = false;
 
 	      /* If an ALLOCATABLE dummy argument has INTENT(OUT) and is
 		 allocated on entry, it must be deallocated.  */
@@ -6844,7 +6845,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		  else
 		    tmp = gfc_finish_block (&block);
 
-		  gfc_add_expr_to_block (&se->pre, tmp);
+		  gfc_add_expr_to_block (&dealloc_blk, tmp);
+		  defer_repackage = true;
 		}
 
 	      /* The conversion does not repackage the reference to a class
@@ -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
 	    {
@@ -7131,17 +7137,12 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 
       /* If any actual argument of the procedure is allocatable and passed
 	 to an allocatable dummy with INTENT(OUT), we conservatively
-	 evaluate all actual argument expressions before deallocations are
+	 evaluate actual argument expressions before deallocations are
 	 performed and the procedure is executed.  This ensures we conform
-	 to F2023:15.5.3, 15.5.4.  Create temporaries except for constants,
-	 variables, and functions returning pointers that can appear in a
-	 variable definition context.  */
+	 to F2023:15.5.3, 15.5.4.  May create temporaries when needed.  */
       if (e && fsym && force_eval_args
-	  && e->expr_type != EXPR_VARIABLE
-	  && !gfc_is_constant_expr (e)
-	  && (e->expr_type != EXPR_FUNCTION
-	      || !(gfc_expr_attr (e).pointer
-		   || gfc_expr_attr (e).proc_pointer)))
+	  && fsym->attr.intent != INTENT_OUT
+	  && !gfc_is_constant_expr (e))
 	parmse.expr = gfc_evaluate_now (parmse.expr, &parmse.pre);
 
       if (fsym && need_interface_mapping && e)

WARNING: multiple messages have this Message-ID
From: Harald Anlauf <anlauf@gmx.de>
To: gcc-patches@gcc.gnu.org
Cc: fortran@gcc.gnu.org
Subject: Re: [PATCH] Fortran: fixes for procedures with ALLOCATABLE,INTENT(OUT) arguments [PR92178]
Date: Tue, 4 Jul 2023 21:00:23 +0200	[thread overview]
Message-ID: <f5110257-a266-96ce-611c-279dfac1a6c6@gmx.de> (raw)
Message-ID: <20230704190023.khharryC8WalmMCv2bftZM6Z8mjDDkVQNSbT2lnnHAs@z> (raw)
In-Reply-To: <cc64dd5f-4ded-a4bb-9bd7-94b3383cbdac@orange.fr>

[-- Attachment #1: Type: text/plain, Size: 4164 bytes --]

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'll wrap up all pieces and resubmit when the dust settles.

We can then address the other findings later.

Harald

Am 04.07.23 um 15:35 schrieb Mikael Morin:
> Le 03/07/2023 à 22:49, Harald Anlauf a écrit :
>> Hi Mikael,
>>
>> Am 03.07.23 um 13:46 schrieb Mikael Morin:
>>> These look good, but I'm surprised that there is no similar change at
>>> the 6819 line.
>>> This is the class array actual vs class array dummy case.
>>> It seems to be checked by the "bar" subroutine in your testcase, except
>>> that the intent(out) argument comes last there, whereas it was coming
>>> first with the original testcases in the PR.
>>> Can you double check?
>>
>> I believe I tried that before and encountered regressions.
>> The change
>>
>> diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
>> index 16e8f037cfc..43e013fa720 100644
>> --- a/gcc/fortran/trans-expr.cc
>> +++ b/gcc/fortran/trans-expr.cc
>> @@ -6844,7 +6844,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol *
>> sym,
>>                    else
>>                      tmp = gfc_finish_block (&block);
>>
>> -                 gfc_add_expr_to_block (&se->pre, tmp);
>> +//               gfc_add_expr_to_block (&se->pre, tmp);
>> +                 gfc_add_expr_to_block (&dealloc_blk, tmp);
>>                  }
>>
>>                /* The conversion does not repackage the reference to a 
>> class
>>
>> regresses on:
>> gfortran.dg/class_array_16.f90
>> gfortran.dg/finalize_12.f90
>> gfortran.dg/optional_class_1.f90
>>
>> A simplified testcase for further study:
>>
>> program p
>>    implicit none
>>    class(*),  allocatable :: c(:)
>>    c = [3, 4]
>>    call bar (allocated (c), c, allocated (c))
>>    if (allocated (c)) stop 14
>> contains
>>    subroutine bar (alloc, x, alloc2)
>>      logical :: alloc, alloc2
>>      class(*), allocatable, intent(out) :: x(:)
>>      if (allocated (x)) stop 5
>>      if (.not. alloc)   stop 6
>>      if (.not. alloc2)  stop 16
>>    end subroutine bar
>> end
>>
>> (This fails in a different place for the posted patch and for
>> the above trial change.  Need to go to the drawing board...)
>>
> I've had a quick look.
> 
> The code originally generated looks like:
> 
>      D.4343 = (void *[0:] * restrict) c._data.data != 0B;
>      if (c._data.data != 0B)
>        // free c._data.data
>      c._data.data = 0B;
>      ...
>      class.3._data = c._data;
>      ...
>      D.4345 = (void *[0:] * restrict) c._data.data != 0B;
>      bar (&D.4343, &class.3, &D.4345);
> 
> this fails because D.4345 has the wrong value.
> With your change, it becomes:
> 
>      D.4343 = (void *[0:] * restrict) c._data.data != 0B;
>      ...
>      class.3._data = c._data;
>      ...
>      D.4345 = (void *[0:] * restrict) c._data.data != 0B;
>      if (c._data.data != 0B)
>        // free c._data.data
>      c._data.data = 0B;
>      bar (&D.4343, &class.3, &D.4345);
> 
> and then it is class.3._data that has the wrong value.
> So basically the initialization of class.3 should move with the 
> deallocation.
> 
> I can reproduce a similar problem with your unmodified patch on the 
> following variant:
> 
> program p
>    implicit none
>    class(*),  allocatable :: c
>    c = 3
>    call bar (c, allocated (c))
>    if (allocated (c)) stop 14
> contains
>    subroutine bar (x, alloc2)
>      logical :: alloc, alloc2
>      class(*), allocatable, intent(out) :: x(..)
>      if (allocated (x)) stop 5
>      if (.not. alloc)   stop 6
>      if (.not. alloc2)  stop 16
>    end subroutine bar
> end
> 
> 
> 

[-- Attachment #2: pr92178-v2-partial.patch --]
[-- Type: text/x-patch, Size: 2317 bytes --]

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
@@ -6804,6 +6804,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 	      /* Pass a class array.  */
 	      parmse.use_offset = 1;
 	      gfc_conv_expr_descriptor (&parmse, e);
+	      bool defer_repackage = false;
 
 	      /* If an ALLOCATABLE dummy argument has INTENT(OUT) and is
 		 allocated on entry, it must be deallocated.  */
@@ -6844,7 +6845,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 		  else
 		    tmp = gfc_finish_block (&block);
 
-		  gfc_add_expr_to_block (&se->pre, tmp);
+		  gfc_add_expr_to_block (&dealloc_blk, tmp);
+		  defer_repackage = true;
 		}
 
 	      /* The conversion does not repackage the reference to a class
@@ -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
 	    {
@@ -7131,17 +7137,12 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
 
       /* If any actual argument of the procedure is allocatable and passed
 	 to an allocatable dummy with INTENT(OUT), we conservatively
-	 evaluate all actual argument expressions before deallocations are
+	 evaluate actual argument expressions before deallocations are
 	 performed and the procedure is executed.  This ensures we conform
-	 to F2023:15.5.3, 15.5.4.  Create temporaries except for constants,
-	 variables, and functions returning pointers that can appear in a
-	 variable definition context.  */
+	 to F2023:15.5.3, 15.5.4.  May create temporaries when needed.  */
       if (e && fsym && force_eval_args
-	  && e->expr_type != EXPR_VARIABLE
-	  && !gfc_is_constant_expr (e)
-	  && (e->expr_type != EXPR_FUNCTION
-	      || !(gfc_expr_attr (e).pointer
-		   || gfc_expr_attr (e).proc_pointer)))
+	  && fsym->attr.intent != INTENT_OUT
+	  && !gfc_is_constant_expr (e))
 	parmse.expr = gfc_evaluate_now (parmse.expr, &parmse.pre);
 
       if (fsym && need_interface_mapping && e)

  reply	other threads:[~2023-07-04 19:00 UTC|newest]

Thread overview: 20+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2023-07-02 20:38 Harald Anlauf
2023-07-03 11:46 ` Mikael Morin
2023-07-03 20:49   ` Harald Anlauf
2023-07-03 20:49     ` Harald Anlauf
2023-07-03 23:56     ` Steve Kargl
2023-07-04  9:26       ` Mikael Morin
2023-07-04 15:50         ` Steve Kargl
2023-07-04 13:35     ` Mikael Morin
2023-07-04 19:00       ` Harald Anlauf [this message]
2023-07-04 19:00         ` Harald Anlauf
2023-07-04 19:37         ` Mikael Morin
2023-07-05 14:54           ` Mikael Morin
2023-07-05 20:36             ` Harald Anlauf
2023-07-05 20:36               ` Harald Anlauf
2023-07-07 12:21               ` Mikael Morin
2023-07-07 18:23                 ` Harald Anlauf
2023-07-07 18:23                   ` Harald Anlauf
2023-07-08 12:07                   ` Mikael Morin
2023-07-08 14:20                     ` Harald Anlauf
2023-07-08 14:20                       ` Harald Anlauf

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=f5110257-a266-96ce-611c-279dfac1a6c6@gmx.de \
    --to=anlauf@gmx.de \
    --cc=fortran@gcc.gnu.org \
    --cc=gcc-patches@gcc.gnu.org \
    --cc=morin-mikael@orange.fr \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).