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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@182389 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index e2f9525..5093f7d 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -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

diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index d441102..a644312 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -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.

diff --git a/gcc/testsuite/gfortran.dg/class_array_3.f03 b/gcc/testsuite/gfortran.dg/class_array_3.f03
index 0ca0a00..874fecc 100644 (file)
--- 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 (file)
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" } }