1! { dg-do compile }
2! Tests the fix for PR30407, in which operator assignments did not work
3! in WHERE blocks or simple WHERE statements.  This is the test provided
4! by the reporter.
5!
6! Contributed by Dominique d'Humieres <dominiq@lps.ens.fr>
7!==============================================================================
8
9MODULE kind_mod
10
11   IMPLICIT NONE
12
13   PRIVATE
14
15   INTEGER, PUBLIC, PARAMETER :: I4=SELECTED_INT_KIND(9)
16   INTEGER, PUBLIC, PARAMETER :: TF=KIND(.TRUE._I4)
17
18END MODULE kind_mod
19
20!==============================================================================
21
22MODULE pointer_mod
23
24   USE kind_mod, ONLY : I4
25
26   IMPLICIT NONE
27
28   PRIVATE
29
30   TYPE, PUBLIC :: pvt
31      INTEGER(I4), POINTER, DIMENSION(:) :: vect
32   END TYPE pvt
33
34   INTERFACE ASSIGNMENT(=)
35      MODULE PROCEDURE p_to_p
36   END INTERFACE
37
38   PUBLIC :: ASSIGNMENT(=)
39
40CONTAINS
41
42   !---------------------------------------------------------------------------
43
44   PURE ELEMENTAL SUBROUTINE p_to_p(a1, a2)
45      IMPLICIT NONE
46      TYPE(pvt), INTENT(OUT) :: a1
47      TYPE(pvt), INTENT(IN) :: a2
48      a1%vect = a2%vect
49   END SUBROUTINE p_to_p
50
51   !---------------------------------------------------------------------------
52
53END MODULE pointer_mod
54
55!==============================================================================
56
57PROGRAM test_prog
58
59   USE pointer_mod, ONLY : pvt, ASSIGNMENT(=)
60
61   USE kind_mod, ONLY : I4, TF
62
63   IMPLICIT NONE
64
65   INTEGER(I4), DIMENSION(12_I4), TARGET :: ia
66   LOGICAL(TF), DIMENSION(2_I4,3_I4) :: la
67   TYPE(pvt), DIMENSION(6_I4) :: pv
68   INTEGER(I4) :: i
69
70   ! Initialisation...
71   la(:,1_I4:3_I4:2_I4)=.TRUE._TF
72   la(:,2_I4)=.FALSE._TF
73
74   DO i=1_I4,6_I4
75      pv(i)%vect => ia((2_I4*i-1_I4):(2_I4*i))
76   END DO
77
78   ia=0_I4
79
80   DO i=1_I4,3_I4
81      WHERE(la((/1_I4,2_I4/),i))
82         pv((2_I4*i-1_I4):(2_I4*i))= iaef((/(2_I4*i-1_I4),(2_I4*i)/))
83      ELSEWHERE
84         pv((2_I4*i-1_I4):(2_I4*i))= iaef((/0_I4,0_I4/))
85      END WHERE
86   END DO
87
88   if (any (ia .ne. (/1,-1,2,-2,0,0,0,0,5,-5,6,-6/))) call abort ()
89
90CONTAINS
91
92   TYPE(pvt) ELEMENTAL FUNCTION iaef(index) RESULT(ans)
93
94      USE kind_mod, ONLY :  I4
95      USE pointer_mod, ONLY : pvt, ASSIGNMENT(=)
96
97      IMPLICIT NONE
98
99      INTEGER(I4), INTENT(IN) :: index
100
101      ALLOCATE(ans%vect(2_I4))
102      ans%vect=(/index,-index/)
103
104   END FUNCTION iaef
105
106END PROGRAM test_prog
107