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