[patch, gfortran] PR 25217: INTENT(OUT) args. with default initializers

Erik Edelmann erik.edelmann@iki.fi
Wed Aug 16 19:15:00 GMT 2006


On Wed, Aug 16, 2006 at 12:26:11AM +0300, Erik Edelmann wrote:
> On Tue, Jul 25, 2006 at 12:38:51AM +0300, Erik Edelmann wrote:
> > New patch, tested on trunk, Linux/x86. Ok?
> 
> Ping.  Now also tested on 4.1, with slightly different testcase (since
> 4.1 doesn't support allocatable dummies, there is no reason to check
> that they work :-)

Well, I guess I should post that testcase as well, and perhaops re-post
the patch as well.


        Erik
-------------- next part --------------
Index: gcc/fortran/trans-expr.c
===================================================================
--- gcc/fortran/trans-expr.c	(revision 116166)
+++ gcc/fortran/trans-expr.c	(working copy)
@@ -1978,6 +1978,16 @@ gfc_conv_function_call (gfc_se * se, gfc
       gfc_add_block_to_block (&se->pre, &parmse.pre);
       gfc_add_block_to_block (&post, &parmse.post);
 
+      /* If an INTENT(OUT) dummy of derived type has a default
+	 initializer, it must be (re)initialized here.  */
+      if (fsym && fsym->attr.intent == INTENT_OUT && fsym->ts.type == BT_DERIVED
+          && fsym->value)
+	{
+	  gcc_assert (!fsym->attr.allocatable);
+	  tmp = gfc_trans_assignment (e, fsym->value);
+	  gfc_add_expr_to_block (&se->pre, tmp);
+	}
+
       /* Character strings are passed as two parameters, a length and a
          pointer.  */
       if (parmse.string_length != NULL_TREE)
Index: gcc/fortran/resolve.c
===================================================================
--- gcc/fortran/resolve.c	(revision 116166)
+++ gcc/fortran/resolve.c	(working copy)
@@ -5106,8 +5106,8 @@ resolve_fl_variable (gfc_symbol *sym, in
     }
 
   /* Assign default initializer.  */
-  if (sym->ts.type == BT_DERIVED && !(sym->value || flag)
-	&& !sym->attr.pointer)
+  if (sym->ts.type == BT_DERIVED && !sym->value && !sym->attr.pointer
+      && !sym->attr.allocatable && (!flag || sym->attr.intent == INTENT_OUT))
     sym->value = gfc_default_initializer (&sym->ts);
 
   return SUCCESS;
-------------- next part --------------
! { dg-do run }
! PR 25217: INTENT(OUT) dummies of derived type with default initializers shall
! be (re)initialized upon procedure entry, unless they are ALLOCATABLE.
program main

    implicit none

    type :: drv
        integer :: a(3) = [ 1, 2, 3 ]
        character(3) :: s = "abc"
        real, pointer :: p => null()
    end type drv
    type(drv) :: aa
    type(drv), allocatable :: ab(:)
    real, target :: x

    aa%a = [ 4, 5, 6]
    aa%s = "def"
    aa%p => x
    call sub(aa)

contains

    subroutine sub(fa)
        type(drv), intent(out) :: fa

        if (any(fa%a /= [ 1, 2, 3 ])) call abort()
        if (fa%s /= "abc") call abort()
        if (associated(fa%p)) call abort()
    end subroutine sub

end program main


More information about the Gcc-patches mailing list