trans-expr.c (gfc_walk_function_expr): Detect elemental procedure components as…

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

gcc/fortran/ChangeLog

+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

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);
 

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

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)

gcc/testsuite/ChangeLog

+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.

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" } }

gcc/testsuite/gfortran.dg/class_array_9.f03

+! { 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" } }