! { dg-do run } ! { dg-require-visibility "" } ! ! Tests the fix for PR68846 in which compiler generated temporaries were ! receiving the attributes of dummy arguments. This test is the original. ! The simplified versions by Gerhard Steinmetz are gratefully acknowledged. ! ! Contributed by Mirco Valentini ! MODULE grid IMPLICIT NONE PRIVATE REAL(KIND=8), DIMENSION(100,100), TARGET :: WORKSPACE TYPE, PUBLIC :: grid_t REAL(KIND=8), DIMENSION(:,:), POINTER :: P => NULL () END TYPE PUBLIC :: INIT CONTAINS SUBROUTINE INIT (DAT) IMPLICIT NONE TYPE(grid_t), INTENT(INOUT) :: DAT INTEGER :: I, J DAT%P => WORKSPACE DO I = 1, 100 DO J = 1, 100 DAT%P(I,J) = REAL ((I-1)*100+J-1) END DO ENDDO END SUBROUTINE INIT END MODULE grid MODULE subgrid USE :: grid, ONLY: grid_t IMPLICIT NONE PRIVATE TYPE, PUBLIC :: subgrid_t INTEGER, DIMENSION(4) :: range CLASS(grid_t), POINTER :: grd => NULL () CONTAINS PROCEDURE, PASS :: INIT => LVALUE_INIT PROCEDURE, PASS :: JMP => LVALUE_JMP END TYPE CONTAINS SUBROUTINE LVALUE_INIT (HOBJ, P, D) IMPLICIT NONE CLASS(subgrid_t), INTENT(INOUT) :: HOBJ TYPE(grid_t), POINTER, INTENT(INOUT) :: P INTEGER, DIMENSION(4), INTENT(IN) :: D HOBJ%range = D HOBJ%grd => P END SUBROUTINE LVALUE_INIT FUNCTION LVALUE_JMP(HOBJ, I, J) RESULT(P) IMPLICIT NONE CLASS(subgrid_t), INTENT(INOUT) :: HOBJ INTEGER, INTENT(IN) :: I, J REAL(KIND=8), POINTER :: P P => HOBJ%grd%P(HOBJ%range(1)+I-1, HOBJ%range(3)+J-1) END FUNCTION LVALUE_JMP END MODULE subgrid MODULE geom IMPLICIT NONE CONTAINS SUBROUTINE fillgeom_03( subgrid, value ) USE :: subgrid, ONLY: subgrid_t IMPLICIT NONE TYPE(subgrid_T), intent(inout) :: subgrid REAL(kind=8), intent(in) :: value INTEGER :: I, J DO i = 1, 3 DO J = 1, 4 subgrid%jmp(i,j) = value ! Dummy argument '_F.DA0' with INTENT(IN) ! in pointer association context or ICE ! in trans_decl.c, depending on INTENT of ! 'VALUE' ENDDO ENDDO END SUBROUTINE fillgeom_03 END MODULE geom PROGRAM test_lvalue USE :: grid USE :: subgrid USE :: geom IMPLICIT NONE TYPE(grid_t), POINTER :: GRD => NULL() TYPE(subgrid_t) :: STENCIL REAL(KIND=8), POINTER :: real_tmp_ptr REAL(KIND=8), DIMENSION(10,10), TARGET :: AA REAL(KIND=8), DIMENSION(3,4) :: VAL INTEGER :: I, J, chksum integer, parameter :: r1 = 50 integer, parameter :: r2 = 52 integer, parameter :: r3 = 50 integer, parameter :: r4 = 53 DO I = 1, 3 DO J = 1, 4 VAL(I,J) = dble(I)*dble(J) ENDDO ENDDO ALLOCATE (GRD) CALL INIT (GRD) chksum = sum([([((i-1)*100 + j -1, j=1,100)], i = 1,100)]) if (int(sum(grd%p)) .ne. chksum) stop 1 CALL STENCIL%INIT (GRD, [r1, r2, r3, r4]) if (.not.associated (stencil%grd, grd)) stop 2 if (int(sum(grd%p)) .ne. chksum) stop 3 CALL fillgeom_03(stencil, 42.0_8) if (any (int (grd%p(r1:r2,r3:r4)) .ne. 42)) stop 4 chksum = chksum - sum([([((i - 1) * 100 + j -1, j=r3,r4)], i = r1,r2)]) & + (r4 - r3 + 1) * (r2 - r1 +1) * 42 if (int(sum(grd%p)) .ne. chksum) stop 5 deallocate (grd) END PROGRAM test_lvalue