1! { dg-do run } 2! 3! Tests the fix for PR68846 in which compiler generated temporaries were 4! receiving the attributes of dummy arguments. This test is the original. 5! The simplified versions by Gerhard Steinmetz are gratefully acknowledged. 6! 7! Contributed by Mirco Valentini <mirco.valentini@polimi.it> 8! 9MODULE grid 10 IMPLICIT NONE 11 PRIVATE 12 REAL(KIND=8), DIMENSION(100,100), TARGET :: WORKSPACE 13 TYPE, PUBLIC :: grid_t 14 REAL(KIND=8), DIMENSION(:,:), POINTER :: P => NULL () 15 END TYPE 16 PUBLIC :: INIT 17CONTAINS 18 SUBROUTINE INIT (DAT) 19 IMPLICIT NONE 20 TYPE(grid_t), INTENT(INOUT) :: DAT 21 INTEGER :: I, J 22 DAT%P => WORKSPACE 23 DO I = 1, 100 24 DO J = 1, 100 25 DAT%P(I,J) = REAL ((I-1)*100+J-1) 26 END DO 27 ENDDO 28 END SUBROUTINE INIT 29END MODULE grid 30 31MODULE subgrid 32 USE :: grid, ONLY: grid_t 33 IMPLICIT NONE 34 PRIVATE 35 TYPE, PUBLIC :: subgrid_t 36 INTEGER, DIMENSION(4) :: range 37 CLASS(grid_t), POINTER :: grd => NULL () 38 CONTAINS 39 PROCEDURE, PASS :: INIT => LVALUE_INIT 40 PROCEDURE, PASS :: JMP => LVALUE_JMP 41 END TYPE 42CONTAINS 43 SUBROUTINE LVALUE_INIT (HOBJ, P, D) 44 IMPLICIT NONE 45 CLASS(subgrid_t), INTENT(INOUT) :: HOBJ 46 TYPE(grid_t), POINTER, INTENT(INOUT) :: P 47 INTEGER, DIMENSION(4), INTENT(IN) :: D 48 HOBJ%range = D 49 HOBJ%grd => P 50 END SUBROUTINE LVALUE_INIT 51 52 FUNCTION LVALUE_JMP(HOBJ, I, J) RESULT(P) 53 IMPLICIT NONE 54 CLASS(subgrid_t), INTENT(INOUT) :: HOBJ 55 INTEGER, INTENT(IN) :: I, J 56 REAL(KIND=8), POINTER :: P 57 P => HOBJ%grd%P(HOBJ%range(1)+I-1, HOBJ%range(3)+J-1) 58 END FUNCTION LVALUE_JMP 59END MODULE subgrid 60 61MODULE geom 62 IMPLICIT NONE 63CONTAINS 64 SUBROUTINE fillgeom_03( subgrid, value ) 65 USE :: subgrid, ONLY: subgrid_t 66 IMPLICIT NONE 67 TYPE(subgrid_T), intent(inout) :: subgrid 68 REAL(kind=8), intent(in) :: value 69 INTEGER :: I, J 70 DO i = 1, 3 71 DO J = 1, 4 72 subgrid%jmp(i,j) = value ! Dummy argument '_F.DA0' with INTENT(IN) 73 ! in pointer association context or ICE 74 ! in trans_decl.c, depending on INTENT of 75 ! 'VALUE' 76 ENDDO 77 ENDDO 78 END SUBROUTINE fillgeom_03 79END MODULE geom 80 81PROGRAM test_lvalue 82 USE :: grid 83 USE :: subgrid 84 USE :: geom 85 IMPLICIT NONE 86 TYPE(grid_t), POINTER :: GRD => NULL() 87 TYPE(subgrid_t) :: STENCIL 88 REAL(KIND=8), POINTER :: real_tmp_ptr 89 REAL(KIND=8), DIMENSION(10,10), TARGET :: AA 90 REAL(KIND=8), DIMENSION(3,4) :: VAL 91 INTEGER :: I, J, chksum 92 integer, parameter :: r1 = 50 93 integer, parameter :: r2 = 52 94 integer, parameter :: r3 = 50 95 integer, parameter :: r4 = 53 96 DO I = 1, 3 97 DO J = 1, 4 98 VAL(I,J) = dble(I)*dble(J) 99 ENDDO 100 ENDDO 101 102 ALLOCATE (GRD) 103 CALL INIT (GRD) 104 chksum = sum([([((i-1)*100 + j -1, j=1,100)], i = 1,100)]) 105 if (int(sum(grd%p)) .ne. chksum) stop 1 106 107 CALL STENCIL%INIT (GRD, [r1, r2, r3, r4]) 108 if (.not.associated (stencil%grd, grd)) stop 2 109 if (int(sum(grd%p)) .ne. chksum) stop 3 110 111 CALL fillgeom_03(stencil, 42.0_8) 112 if (any (int (grd%p(r1:r2,r3:r4)) .ne. 42)) stop 4 113 114 chksum = chksum - sum([([((i - 1) * 100 + j -1, j=r3,r4)], i = r1,r2)]) & 115 + (r4 - r3 + 1) * (r2 - r1 +1) * 42 116 if (int(sum(grd%p)) .ne. chksum) stop 5 117 118 deallocate (grd) 119END PROGRAM test_lvalue 120 121 122