re PR fortran/50981 ([OOP] Wrong-code for scalarizing ELEMENTAL call with absent OPTIONAL argument)
gcc/fortran/ PR fortran/50981 * trans-stmt.c (gfc_get_proc_ifc_for_call): New function. (gfc_trans_call): Use gfc_get_proc_ifc_for_call. gcc/testsuite/ PR fortran/50981 * gfortran.dg/elemental_optional_args_5.f03: New test. From-SVN: r184142
This commit is contained in:
parent
dec131b6ad
commit
9436b221f2
|
@ -1,3 +1,9 @@
|
|||
2012-02-12 Mikael Morin <mikael@gcc.gnu.org>
|
||||
|
||||
PR fortran/50981
|
||||
* trans-stmt.c (gfc_get_proc_ifc_for_call): New function.
|
||||
(gfc_trans_call): Use gfc_get_proc_ifc_for_call.
|
||||
|
||||
2012-02-12 Mikael Morin <mikael@gcc.gnu.org>
|
||||
|
||||
* trans-array.c (gfc_walk_elemental_function_args,
|
||||
|
|
|
@ -348,6 +348,27 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse,
|
|||
}
|
||||
|
||||
|
||||
/* Get the interface symbol for the procedure corresponding to the given call.
|
||||
We can't get the procedure symbol directly as we have to handle the case
|
||||
of (deferred) type-bound procedures. */
|
||||
|
||||
static gfc_symbol *
|
||||
get_proc_ifc_for_call (gfc_code *c)
|
||||
{
|
||||
gfc_symbol *sym;
|
||||
|
||||
gcc_assert (c->op == EXEC_ASSIGN_CALL || c->op == EXEC_CALL);
|
||||
|
||||
sym = gfc_get_proc_ifc_for_expr (c->expr1);
|
||||
|
||||
/* Fall back/last resort try. */
|
||||
if (sym == NULL)
|
||||
sym = c->resolved_sym;
|
||||
|
||||
return sym;
|
||||
}
|
||||
|
||||
|
||||
/* Translate the CALL statement. Builds a call to an F95 subroutine. */
|
||||
|
||||
tree
|
||||
|
@ -372,7 +393,7 @@ gfc_trans_call (gfc_code * code, bool dependency_check,
|
|||
ss = gfc_ss_terminator;
|
||||
if (code->resolved_sym->attr.elemental)
|
||||
ss = gfc_walk_elemental_function_args (ss, code->ext.actual,
|
||||
gfc_get_proc_ifc_for_expr (code->expr1),
|
||||
get_proc_ifc_for_call (code),
|
||||
GFC_SS_REFERENCE);
|
||||
|
||||
/* Is not an elemental subroutine call with array valued arguments. */
|
||||
|
|
|
@ -1,4 +1,9 @@
|
|||
2012-02012 Iain Sandoe <iains@gcc.gnu.org>
|
||||
2012-02-12 Mikael Morin <mikael@gcc.gnu.org>
|
||||
|
||||
PR fortran/50981
|
||||
* gfortran.dg/elemental_optional_args_5.f03: New test.
|
||||
|
||||
2012-02-12 Iain Sandoe <iains@gcc.gnu.org>
|
||||
|
||||
PR testsuite/50076
|
||||
* c-c++-common/cxxbitfields-3.c: Adjust scan assembler for nonpic
|
||||
|
|
|
@ -0,0 +1,86 @@
|
|||
! { dg-do run }
|
||||
!
|
||||
! PR fortran/50981
|
||||
! Test the handling of optional, polymorphic and non-polymorphic arguments
|
||||
! to elemental procedures.
|
||||
!
|
||||
! Original testcase by Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
implicit none
|
||||
type t
|
||||
integer :: a
|
||||
end type t
|
||||
|
||||
type t2
|
||||
integer, allocatable :: a
|
||||
integer, allocatable :: a2(:)
|
||||
integer, pointer :: p => null()
|
||||
integer, pointer :: p2(:) => null()
|
||||
end type t2
|
||||
|
||||
type(t), allocatable :: ta, taa(:)
|
||||
type(t), pointer :: tp, tpa(:)
|
||||
class(t), allocatable :: ca, caa(:)
|
||||
class(t), pointer :: cp, cpa(:)
|
||||
|
||||
type(t2) :: x
|
||||
|
||||
integer :: s, v(2)
|
||||
|
||||
tp => null()
|
||||
tpa => null()
|
||||
cp => null()
|
||||
cpa => null()
|
||||
|
||||
! =============== sub1 ==================
|
||||
! SCALAR COMPONENTS: Non alloc/assoc
|
||||
|
||||
s = 3
|
||||
v = [9, 33]
|
||||
|
||||
call sub1 (s, x%a, .false.)
|
||||
call sub1 (v, x%a, .false.)
|
||||
!print *, s, v
|
||||
if (s /= 3) call abort()
|
||||
if (any (v /= [9, 33])) call abort()
|
||||
|
||||
call sub1 (s, x%p, .false.)
|
||||
call sub1 (v, x%p, .false.)
|
||||
!print *, s, v
|
||||
if (s /= 3) call abort()
|
||||
if (any (v /= [9, 33])) call abort()
|
||||
|
||||
|
||||
! SCALAR COMPONENTS: alloc/assoc
|
||||
|
||||
allocate (x%a, x%p)
|
||||
x%a = 4
|
||||
x%p = 5
|
||||
call sub1 (s, x%a, .true.)
|
||||
call sub1 (v, x%a, .true.)
|
||||
!print *, s, v
|
||||
if (s /= 4*2) call abort()
|
||||
if (any (v /= [4*2, 4*2])) call abort()
|
||||
|
||||
call sub1 (s, x%p, .true.)
|
||||
call sub1 (v, x%p, .true.)
|
||||
!print *, s, v
|
||||
if (s /= 5*2) call abort()
|
||||
if (any (v /= [5*2, 5*2])) call abort()
|
||||
|
||||
|
||||
|
||||
contains
|
||||
|
||||
elemental subroutine sub1 (x, y, alloc)
|
||||
integer, intent(inout) :: x
|
||||
integer, intent(in), optional :: y
|
||||
logical, intent(in) :: alloc
|
||||
if (alloc .neqv. present (y)) &
|
||||
x = -99
|
||||
if (present(y)) &
|
||||
x = y*2
|
||||
end subroutine sub1
|
||||
|
||||
end
|
||||
|
Loading…
Reference in New Issue