trans-expr.c (gfc_walk_function_expr): Detect elemental procedure components as well as elemental procedures.
2011-12-15 Paul Thomas <pault@gcc.gnu.org> * trans-expr.c (gfc_walk_function_expr): Detect elemental procedure components as well as elemental procedures. * trans-array.c (gfc_conv_procedure_call): Ditto. * trans-decl.c (gfc_trans_deferred_vars): Correct erroneous break for class pointers to continue. 2011-12-15 Paul Thomas <pault@gcc.gnu.org> * gfortran.dg/class_array_3.f03: Remove explicit indexing of A%disp() to use scalarizer. * gfortran.dg/class_array_9.f03: New. From-SVN: r182389
This commit is contained in:
parent
363477c0bd
commit
1b26c26bb0
|
@ -1,3 +1,11 @@
|
|||
2011-12-15 Paul Thomas <pault@gcc.gnu.org>
|
||||
|
||||
* trans-expr.c (gfc_walk_function_expr): Detect elemental
|
||||
procedure components as well as elemental procedures.
|
||||
* trans-array.c (gfc_conv_procedure_call): Ditto.
|
||||
* trans-decl.c (gfc_trans_deferred_vars): Correct erroneous
|
||||
break for class pointers to continue.
|
||||
|
||||
2011-12-15 Toon Moene <toon@moene.org>
|
||||
|
||||
PR fortran/51310
|
||||
|
|
|
@ -8358,7 +8358,7 @@ gfc_walk_function_expr (gfc_ss * ss, gfc_expr * expr)
|
|||
|
||||
sym = expr->value.function.esym;
|
||||
if (!sym)
|
||||
sym = expr->symtree->n.sym;
|
||||
sym = expr->symtree->n.sym;
|
||||
|
||||
/* A function that returns arrays. */
|
||||
gfc_is_proc_ptr_comp (expr, &comp);
|
||||
|
@ -8368,7 +8368,7 @@ gfc_walk_function_expr (gfc_ss * ss, gfc_expr * expr)
|
|||
|
||||
/* Walk the parameters of an elemental function. For now we always pass
|
||||
by reference. */
|
||||
if (sym->attr.elemental)
|
||||
if (sym->attr.elemental || (comp && comp->attr.elemental))
|
||||
return gfc_walk_elemental_function_args (ss, expr->value.function.actual,
|
||||
GFC_SS_REFERENCE);
|
||||
|
||||
|
|
|
@ -3680,7 +3680,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block)
|
|||
else if ((!sym->attr.dummy || sym->ts.deferred)
|
||||
&& (sym->ts.type == BT_CLASS
|
||||
&& CLASS_DATA (sym)->attr.pointer))
|
||||
break;
|
||||
continue;
|
||||
else if ((!sym->attr.dummy || sym->ts.deferred)
|
||||
&& (sym->attr.allocatable
|
||||
|| (sym->ts.type == BT_CLASS
|
||||
|
|
|
@ -3115,7 +3115,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
|
|||
|
||||
if (se->ss != NULL)
|
||||
{
|
||||
if (!sym->attr.elemental)
|
||||
if (!sym->attr.elemental && !(comp && comp->attr.elemental))
|
||||
{
|
||||
gcc_assert (se->ss->info->type == GFC_SS_FUNCTION);
|
||||
if (se->ss->info->useflags)
|
||||
|
|
|
@ -1,3 +1,9 @@
|
|||
2011-12-15 Paul Thomas <pault@gcc.gnu.org>
|
||||
|
||||
* gfortran.dg/class_array_3.f03: Remove explicit indexing of
|
||||
A%disp() to use scalarizer.
|
||||
* gfortran.dg/class_array_9.f03: New.
|
||||
|
||||
2011-12-15 Jakub Jelinek <jakub@redhat.com>
|
||||
|
||||
* gcc.dg/vect/vect-sdivmod-1.c: New test.
|
||||
|
|
|
@ -124,7 +124,7 @@ contains
|
|||
cmp = .false.
|
||||
end if
|
||||
class default
|
||||
ERROR STOP "Don't compare apples with oranges"
|
||||
ERROR STOP "Don't compare apples with oranges"
|
||||
end select
|
||||
end function lt_cmp_int
|
||||
end module test
|
||||
|
@ -134,10 +134,10 @@ program main
|
|||
class(sort_t), allocatable :: A(:)
|
||||
integer :: i, m(5)= [7 , 4, 5, 2, 3]
|
||||
allocate (A(5), source = [(sort_int_t(m(i)), i=1,5)])
|
||||
! print *, "Before qsort: ", (A(i)%disp(), i = 1, size(a,1))
|
||||
! print *, "Before qsort: ", A%disp()
|
||||
call qsort(A)
|
||||
! print *, "After qsort: ", (A(i)%disp(), i = 1, size(a,1))
|
||||
if (any ([(A(i)%disp(), i = 1, size(a,1))] .ne. [2,3,4,5,7])) call abort
|
||||
! print *, "After qsort: ", A%disp()
|
||||
if (any (A%disp() .ne. [2,3,4,5,7])) call abort
|
||||
end program main
|
||||
|
||||
! { dg-final { cleanup-modules "m_qsort test" } }
|
||||
|
|
|
@ -0,0 +1,46 @@
|
|||
! { dg-do run }
|
||||
! Test typebound elemental functions on class arrays
|
||||
!
|
||||
module m
|
||||
type :: t1
|
||||
integer :: i
|
||||
contains
|
||||
procedure, pass :: disp => disp_t1
|
||||
end type t1
|
||||
|
||||
type, extends(t1) :: t2
|
||||
real :: r
|
||||
contains
|
||||
procedure, pass :: disp => disp_t2
|
||||
end type t2
|
||||
|
||||
contains
|
||||
integer elemental function disp_t1 (q)
|
||||
class(t1), intent(in) :: q
|
||||
disp_t1 = q%i
|
||||
end function
|
||||
|
||||
integer elemental function disp_t2 (q)
|
||||
class(t2), intent(in) :: q
|
||||
disp_t2 = int (q%r)
|
||||
end function
|
||||
end module
|
||||
|
||||
use m
|
||||
class(t1), allocatable :: x(:)
|
||||
allocate (x(4), source = [(t1 (i), i=1,4)])
|
||||
if (any (x%disp () .ne. [1,2,3,4])) call abort
|
||||
if (any (x(2:3)%disp () .ne. [2,3])) call abort
|
||||
if (any (x(4:3:-1)%disp () .ne. [4,3])) call abort
|
||||
if (x(4)%disp () .ne. 4) call abort
|
||||
|
||||
deallocate (x)
|
||||
allocate (x(4), source = [(t2 (2 * i, real (i) + 0.333), i=1,4)])
|
||||
if (any (x%disp () .ne. [1,2,3,4])) call abort
|
||||
if (any (x(2:3)%disp () .ne. [2,3])) call abort
|
||||
if (any (x(4:3:-1)%disp () .ne. [4,3])) call abort
|
||||
if (x(4)%disp () .ne. 4) call abort
|
||||
|
||||
end
|
||||
|
||||
! { dg-final { cleanup-modules "m" } }
|
Loading…
Reference in New Issue