[Patch, Fortran] PR 41872 - Fixes for allocatable scalars (part 1)

[Tobias Burnus]

Hello,

allocatable scalars have several issues. This patch fixes the some of
them. (For more issues, see PR.)

Especially the following now works:

* Passing allocatable scalars as argument. The problem before was that
the allocatable scalar was passed by value and not by reference.

* Auto-deallocation of allocatable actual arguments when passing them to
allocatable INTENT(OUT) dummies.

* Going out of scope does no longer nullify the variable; this is not
needed as the variable cannot be accessed. (missed optimization)

Build and regtested on x86-64-linux.
OK for the trunk?

Tobias

[alloc_scalar.diff]

---

2009-11-01  Tobias Burnus  <burnus@...>

        PR fortran/41872
        * trans-decl.c (gfc_trans_deferred_vars): Do not nullify
        autodeallocated allocatable scalars at the end of scope.
        (gfc_generate_function_code): Fix indention.
        * trans-expr.c (gfc_conv_procedure_call): For allocatable
        scalars, fix calling by reference and autodeallocating
        of intent out variables.

2009-11-01  Tobias Burnus  <burnus@...>

        PR fortran/41872
        * gfortran.dg/allocatable_scalar_4.f90: New test.

Index: gcc/fortran/trans-decl.c
===================================================================
--- gcc/fortran/trans-decl.c (revision 153794)
+++ gcc/fortran/trans-decl.c (working copy)
@@ -3193,7 +3193,7 @@ gfc_trans_deferred_vars (gfc_symbol * pr
   gfc_expr *e;
   gfc_se se;
   stmtblock_t block;
-  
+
   e = gfc_lval_expr_from_sym (sym);
   if (sym->ts.type == BT_CLASS)
     gfc_add_component_ref (e, "$data");
@@ -3206,13 +3206,9 @@ gfc_trans_deferred_vars (gfc_symbol * pr
   gfc_start_block (&block);
   gfc_add_expr_to_block (&block, fnbody);
 
+  /* Note: Nullifying is not needed.  */
   tmp = gfc_deallocate_with_status (se.expr, NULL_TREE, true, NULL);
   gfc_add_expr_to_block (&block, tmp);
-
-  tmp = fold_build2 (MODIFY_EXPR, void_type_node,
-     se.expr, build_int_cst (TREE_TYPE (se.expr), 0));
-  gfc_add_expr_to_block (&block, tmp);
-
   fnbody = gfc_finish_block (&block);
  }
       else if (sym->ts.type == BT_CHARACTER)
@@ -4396,10 +4392,10 @@ gfc_generate_function_code (gfc_namespac
 
       /* Reset recursion-check variable.  */
       if ((gfc_option.rtcheck & GFC_RTCHECK_RECURSION) && !is_recursive)
-      {
- gfc_add_modify (&block, recurcheckvar, boolean_false_node);
- recurcheckvar = NULL;
-      }
+ {
+  gfc_add_modify (&block, recurcheckvar, boolean_false_node);
+  recurcheckvar = NULL;
+ }
 
       if (result == NULL_TREE)
  {
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c (revision 153794)
+++ gcc/fortran/trans-expr.c (working copy)
@@ -2892,6 +2892,37 @@ gfc_conv_procedure_call (gfc_se * se, gf
       else
  {
   gfc_conv_expr_reference (&parmse, e);
+
+  /* If an ALLOCATABLE dummy argument has INTENT(OUT) and is
+     allocated on entry, it must be deallocated.  */
+  if (fsym && fsym->attr.allocatable
+      && fsym->attr.intent == INTENT_OUT)
+    {
+      stmtblock_t block;
+
+      gfc_init_block  (&block);
+      tmp = gfc_deallocate_with_status (parmse.expr, NULL_TREE,
+ true, NULL);
+      gfc_add_expr_to_block (&block, tmp);
+      tmp = fold_build2 (MODIFY_EXPR, void_type_node,
+ parmse.expr, null_pointer_node);
+      gfc_add_expr_to_block (&block, tmp);
+
+      if (fsym->attr.optional
+  && e->expr_type == EXPR_VARIABLE
+  && e->symtree->n.sym->attr.optional)
+ {
+  tmp = fold_build3 (COND_EXPR, void_type_node,
+     gfc_conv_expr_present (e->symtree->n.sym),
+    gfc_finish_block (&block),
+    build_empty_stmt (input_location));
+ }
+      else
+ tmp = gfc_finish_block (&block);
+
+      gfc_add_expr_to_block (&se->pre, tmp);
+    }
+
   if (fsym && e->expr_type != EXPR_NULL
       && ((fsym->attr.pointer
    && fsym->attr.flavor != FL_PROCEDURE)
@@ -2899,7 +2930,8 @@ gfc_conv_procedure_call (gfc_se * se, gf
       && !(e->expr_type == EXPR_VARIABLE
       && e->symtree->n.sym->attr.dummy))
   || (e->expr_type == EXPR_VARIABLE
-      && gfc_is_proc_ptr_comp (e, NULL))))
+      && gfc_is_proc_ptr_comp (e, NULL))
+  || fsym->attr.allocatable))
     {
       /* Scalar pointer dummy args require an extra level of
  indirection. The null pointer already contains
@@ -3169,7 +3201,7 @@ gfc_conv_procedure_call (gfc_se * se, gf
   cl.backend_decl = formal->sym->ts.u.cl->backend_decl;
     }
         }
-        else
+      else
         {
   tree tmp;
 
Index: gcc/testsuite/gfortran.dg/allocatable_scalar_4.f90
===================================================================
--- gcc/testsuite/gfortran.dg/allocatable_scalar_4.f90 (revision 0)
+++ gcc/testsuite/gfortran.dg/allocatable_scalar_4.f90 (revision 0)
@@ -0,0 +1,95 @@
+! { dg-do run }
+!
+! PR fortran/41872
+!
+!
+program test
+  implicit none
+  integer, allocatable :: a
+  integer, allocatable :: b
+  allocate(a)
+  call foo(a)
+  if(.not. allocated(a)) call abort()
+  if (a /= 5) call abort()
+
+  call bar(a)
+  if (a /= 7) call abort()
+
+  deallocate(a)
+  if(allocated(a)) call abort()
+  call check3(a)
+  if(.not. allocated(a)) call abort()
+  if(a /= 6874) call abort()
+  call check4(a)
+  if(.not. allocated(a)) call abort()
+  if(a /= -478) call abort()
+
+  allocate(b)
+  b = 7482
+  call checkOptional(.false.,.true., 7482)
+  if (b /= 7482) call abort()
+  call checkOptional(.true., .true., 7482, b)
+  if (b /= 46) call abort()
+contains
+  subroutine foo(a)
+    integer, allocatable, intent(out)  :: a
+    if(allocated(a)) call abort()
+    allocate(a)
+    a = 5
+  end subroutine foo
+
+  subroutine bar(a)
+    integer, allocatable, intent(inout)  :: a
+    if(.not. allocated(a)) call abort()
+    if (a /= 5) call abort()
+    a = 7
+  end subroutine bar
+
+  subroutine check3(a)
+    integer, allocatable, intent(inout)  :: a
+    if(allocated(a)) call abort()
+    allocate(a)
+    a = 6874
+  end subroutine check3
+
+  subroutine check4(a)
+    integer, allocatable, intent(inout)  :: a
+    if(.not.allocated(a)) call abort()
+    if (a /= 6874) call abort
+    deallocate(a)
+    if(allocated(a)) call abort()
+    allocate(a)
+    if(.not.allocated(a)) call abort()
+    a = -478
+  end subroutine check4
+
+  subroutine checkOptional(prsnt, alloc, val, x)
+    logical, intent(in) :: prsnt, alloc
+    integer, allocatable, optional :: x
+    integer, intent(in) :: val
+    if (present(x) .neqv. prsnt) call abort()
+    if (present(x)) then
+      if (allocated(x) .neqv. alloc) call abort()
+    end if
+    if (present(x)) then
+      if (allocated(x)) then
+        if (x /= val) call abort()
+      end if
+    end if
+    call checkOptional2(x)
+    if (present(x)) then
+      if (.not. allocated(x)) call abort()
+      if (x /= -6784) call abort()
+      x = 46
+    end if
+    call checkOptional2()
+  end subroutine checkOptional
+  subroutine checkOptional2(x)
+    integer, allocatable, optional, intent(out) :: x
+    if (present(x)) then
+      if (allocated(x)) call abort()
+      allocate(x)
+      x = -6784
+    end if
+  end subroutine checkOptional2
+end program test

---

[Daniel Kraft-4]

Tobias Burnus wrote:

> Hello,
>
> allocatable scalars have several issues. This patch fixes the some of
> them. (For more issues, see PR.)
>
> Especially the following now works:
>
> * Passing allocatable scalars as argument. The problem before was that
> the allocatable scalar was passed by value and not by reference.
>
> * Auto-deallocation of allocatable actual arguments when passing them to
> allocatable INTENT(OUT) dummies.
>
> * Going out of scope does no longer nullify the variable; this is not
> needed as the variable cannot be accessed. (missed optimization)
>
> Build and regtested on x86-64-linux.
> OK for the trunk?

Ok.  Thanks for the patch!

I'm just wondering if that "large" new code block for deallocating
allocatable scalars passed to INTENT(OUT) can't be somehow be simplified
-- actually, there should already be code to do this for non-scalar
allocatables; is it possible to merge this somehow?  But I guess it's
not, because stuff is probably too different there.

Yours,
Daniel

--
Done:  Arc-Bar-Cav-Ran-Rog-Sam-Tou-Val-Wiz
To go: Hea-Kni-Mon-Pri

[Tobias Burnus]

Daniel Kraft wrote:
> Tobias Burnus wrote:
>> allocatable scalars have several issues. This patch fixes the some of
>> them. [...]
> I'm just wondering if that "large" new code block for deallocating
> allocatable scalars passed to INTENT(OUT) can't be somehow be
> simplified -- actually, there should already be code to do this for
> non-scalar allocatables; is it possible to merge this somehow?  But I
> guess it's not, because stuff is probably too different there.

Committed as Rev. 153795. Thanks for the review. I think it is not easy
to simplify the code: Large parts are the same both there are enough
differences that one only trades one kind of ifs with another one.

I think the proper way would be to rewrite some of the allocatable
handling stuff. One might consider this for 4.6 if GCC gets a new array
descriptor. Actually, I do not like that the caller and not the callee
deallocates intent(OUT) variables. I wonder how this should work with
BIND(C) and the new TR 29113.

Tobias

[H.J. Lu-30]

On Sun, Nov 1, 2009 at 9:51 AM, Tobias Burnus <burnus@...> wrote:

> Daniel Kraft wrote:
>> Tobias Burnus wrote:
>>> allocatable scalars have several issues. This patch fixes the some of
>>> them. [...]
>> I'm just wondering if that "large" new code block for deallocating
>> allocatable scalars passed to INTENT(OUT) can't be somehow be
>> simplified -- actually, there should already be code to do this for
>> non-scalar allocatables; is it possible to merge this somehow?  But I
>> guess it's not, because stuff is probably too different there.
>
> Committed as Rev. 153795. Thanks for the review. I think it is not easy
> to simplify the code: Large parts are the same both there are enough
> differences that one only trades one kind of ifs with another one.
>
> I think the proper way would be to rewrite some of the allocatable
> handling stuff. One might consider this for 4.6 if GCC gets a new array
> descriptor. Actually, I do not like that the caller and not the callee
> deallocates intent(OUT) variables. I wonder how this should work with
> BIND(C) and the new TR 29113.
>

This may have caused:

http://gcc.gnu.org/bugzilla/show_bug.cgi?id=41907

--
H.J.