OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/25217 (Derived type dummy argument having intent(out) attribute) 

fortran/
2006-08-19  Erik Edelmann  <eedelman@gcc.gnu.org>

        PR fortran/25217
        * resolve.c (resolve_fl_variable): Set a default initializer for
        derived types with INTENT(OUT) even if 'flag' is true.
        * trans-expr.c (gfc_conv_function_call): Insert code to
        reinitialize INTENT(OUT) arguments of derived type with default
        initializers.


testsuite/
2006-08-19  Erik Edelmann  <eedelman@gcc.gnu.org>

        PR fortran/25217
        * gfortran.dg/derived_init_2.f90: New.

From-SVN: r116261
This commit is contained in:
Erik Edelmann 2006-08-19 21:05:59 +00:00
parent d58b0443ec
commit 6df364d720
5 changed files with 64 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
gcc/fortran/ChangeLog
View File

@ -1,3 +1,12 @@
2006-08-19 Erik Edelmann <eedelman@gcc.gnu.org>
PR fortran/25217
* resolve.c (resolve_fl_variable): Set a default initializer for
derived types with INTENT(OUT) even if 'flag' is true.
* trans-expr.c (gfc_conv_function_call): Insert code to
reinitialize INTENT(OUT) arguments of derived type with default
initializers.
2006-08-15 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR fortran/25828

4
gcc/fortran/resolve.c
View File

@ -5232,8 +5232,8 @@ resolve_fl_variable (gfc_symbol *sym, int mp_flag)
}
/* 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;

10
gcc/fortran/trans-expr.c
View File

@ -2014,6 +2014,16 @@ gfc_conv_function_call (gfc_se * se, gfc_symbol * sym,
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)

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2006-08-19 Erik Edelmann <eedelman@gcc.gnu.org>
PR fortran/25217
* gfortran.dg/derived_init_2.f90: New.
2006-08-17 J"orn Rennecke <joern.rennecke@st.com>
* gcc.c-torture/execute/pr28289.c: New test.

38
gcc/testsuite/gfortran.dg/derived_init_2.f90 Normal file
View File

@ -0,0 +1,38 @@
! { 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)
call sub2(ab)
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
subroutine sub2(fa)
type(drv), allocatable, intent(out) :: fa(:)
end subroutine sub2
end program main