From 2930c0077d7870b6c3dff56b76c471678e2fb535 Mon Sep 17 00:00:00 2001 From: pault Date: Thu, 15 Dec 2011 20:51:19 +0000 Subject: [PATCH] 2011-12-15 Paul Thomas * 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 * gfortran.dg/class_array_3.f03: Remove explicit indexing of A%disp() to use scalarizer. * gfortran.dg/class_array_9.f03: New. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@182389 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 8 +++++ gcc/fortran/trans-array.c | 4 +-- gcc/fortran/trans-decl.c | 2 +- gcc/fortran/trans-expr.c | 2 +- gcc/testsuite/ChangeLog | 6 ++++ gcc/testsuite/gfortran.dg/class_array_3.f03 | 8 ++--- gcc/testsuite/gfortran.dg/class_array_9.f03 | 46 +++++++++++++++++++++++++++++ 7 files changed, 68 insertions(+), 8 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/class_array_9.f03 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e2f9525..5093f7d 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2011-12-15 Paul Thomas + + * 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 PR fortran/51310 diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index d441102..a644312 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -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); diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c index 78b7011..14332f6 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.c @@ -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 diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index b1c85e1..83d8087 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -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) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index c44a067..8786f42 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2011-12-15 Paul Thomas + + * 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 * gcc.dg/vect/vect-sdivmod-1.c: New test. diff --git a/gcc/testsuite/gfortran.dg/class_array_3.f03 b/gcc/testsuite/gfortran.dg/class_array_3.f03 index 0ca0a00..874fecc 100644 --- a/gcc/testsuite/gfortran.dg/class_array_3.f03 +++ b/gcc/testsuite/gfortran.dg/class_array_3.f03 @@ -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" } } diff --git a/gcc/testsuite/gfortran.dg/class_array_9.f03 b/gcc/testsuite/gfortran.dg/class_array_9.f03 new file mode 100644 index 0000000..6b07aea --- /dev/null +++ b/gcc/testsuite/gfortran.dg/class_array_9.f03 @@ -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" } } -- 2.7.4