1! { dg-do compile }
2! Test the fix for PR25099, in which conformance checking was not being
3! done for elemental subroutines and therefore for interface assignments.
4!
5! Contributed by Joost VandeVondele  <jv244@cam.ac.uk>
6!
7module elem_assign
8   implicit none
9   type mytype
10      integer x
11   end type mytype
12   interface assignment(=)
13      module procedure myassign
14   end interface assignment(=)
15   contains
16      elemental subroutine myassign(x,y)
17         type(mytype), intent(out) :: x
18         type(mytype), intent(in) :: y
19         x%x = y%x
20      end subroutine myassign
21end module elem_assign
22
23   use elem_assign
24   integer :: I(2,2),J(2)
25   type (mytype) :: w(2,2), x(4), y(5), z(4)
26! The original PR
27   CALL S(I,J) ! { dg-error "Incompatible ranks in elemental procedure" }
28! Check interface assignments
29   x = w       ! { dg-error "Incompatible ranks in elemental procedure" }
30   x = y       ! { dg-error "Different shape for elemental procedure" }
31   x = z
32CONTAINS
33   ELEMENTAL SUBROUTINE S(I,J)
34     INTEGER, INTENT(IN) :: I,J
35   END SUBROUTINE S
36END
37