1 files changed, 66 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.dg/elemental_subroutine_2.f90 b/gcc/testsuite/gfortran.dg/elemental_subroutine_2.f90
new file mode 100644
index 000000000..e95831186
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/elemental_subroutine_2.f90
@@ -0,0 +1,66 @@
+! { dg-do run }
+! Test the fix for pr22146, where and elemental subroutine with
+! array actual arguments would cause an ICE in gfc_conv_function_call.
+! This test checks that the main uses for elemental subroutines work
+! correctly; namely, as module procedures and as procedures called
+! from elemental functions. The compiler would ICE on the former with
+! the first version of the patch.
+!
+! Contributed by Paul Thomas   <pault@gcc.gnu.org>
+
+module type
+  type itype
+    integer :: i
+    character(1) :: ch
+  end type itype
+end module type
+
+module assign
+  interface assignment (=)
+    module procedure itype_to_int
+  end interface
+contains
+  elemental subroutine itype_to_int (i, it)
+    use type
+    type(itype), intent(in) :: it
+    integer, intent(out) :: i
+    i = it%i
+  end subroutine itype_to_int
+
+  elemental function i_from_itype (it) result (i)
+    use type
+    type(itype), intent(in) :: it
+    integer :: i
+    i = it
+  end function i_from_itype
+
+end module assign
+
+program test_assign
+  use type
+  use assign
+  type(itype) :: x(2, 2)
+  integer :: i(2, 2)
+
+! Test an elemental subroutine call from an elementary function.
+  x = reshape ((/(itype (j, "a"), j = 1,4)/), (/2,2/))
+  forall (j = 1:2, k = 1:2)
+    i(j, k) = i_from_itype (x (j, k))
+  end forall
+  if (any(reshape (i, (/4/)).ne.(/1,2,3,4/))) call abort ()
+
+! Check the interface assignment (not part of the patch).
+  x = reshape ((/(itype (j**2, "b"), j = 1,4)/), (/2,2/))
+  i = x
+  if (any(reshape (i, (/4/)).ne.(/1,4,9,16/))) call abort ()
+
+! Use the interface assignment within a forall block.
+  x = reshape ((/(itype (j**3, "c"), j = 1,4)/), (/2,2/))
+  forall (j = 1:2, k = 1:2)
+    i(j, k) = x (j, k)
+  end forall
+  if (any(reshape (i, (/4/)).ne.(/1,8,27,64/))) call abort ()
+
+end program test_assign
+
+! { dg-final { cleanup-modules "type assign" } }