From 9caa7e073b3e03a8fd1402fe0087b8078c6973de Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Thu, 10 May 2018 10:48:50 +0000 Subject: [PATCH] re PR fortran/68846 (Pointer function as LValue doesn't work when the assignment regards a dummy argument.) 2018-05-10 Paul Thomas PR fortran/68846 PR fortran/70864 * resolve.c (get_temp_from_expr): The temporary must not have dummy or intent attributes. 2018-05-10 Paul Thomas PR fortran/68846 * gfortran.dg/temporary_3.f90 : New test. PR fortran/70864 * gfortran.dg/temporary_2.f90 : New test. From-SVN: r260113 --- gcc/fortran/ChangeLog | 7 ++ gcc/fortran/resolve.c | 2 + gcc/testsuite/ChangeLog | 10 +- gcc/testsuite/gfortran.dg/temporary_2.f90 | 39 +++++++ gcc/testsuite/gfortran.dg/temporary_3.f90 | 121 ++++++++++++++++++++++ 5 files changed, 178 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/temporary_2.f90 create mode 100644 gcc/testsuite/gfortran.dg/temporary_3.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 91a84feb656..34d776b89dd 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2018-05-10 Paul Thomas + + PR fortran/68846 + PR fortran/70864 + * resolve.c (get_temp_from_expr): The temporary must not have + dummy or intent attributes. + 2018-05-08 Thomas Koenig PR fortran/54613 diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 18da9476a3c..913320cc669 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -10503,6 +10503,8 @@ get_temp_from_expr (gfc_expr *e, gfc_namespace *ns) tmp->n.sym->attr.function = 0; tmp->n.sym->attr.result = 0; tmp->n.sym->attr.flavor = FL_VARIABLE; + tmp->n.sym->attr.dummy = 0; + tmp->n.sym->attr.intent = INTENT_UNKNOWN; if (as) { diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index f222771b43c..694857b218c 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2018-05-10 Paul Thomas + + PR fortran/68846 + * gfortran.dg/temporary_3.f90 : New test. + + PR fortran/70864 + * gfortran.dg/temporary_2.f90 : New test. + 2018-05-10 Segher Boessenkool * gcc.dg/vmx/extract-be-order.c: Delete testcase. @@ -210,7 +218,7 @@ 2018-05-06 Andrew Sadek - * gcc.target/microblaze/others/picdtr.c: Add test for + * gcc.target/microblaze/others/picdtr.c: Add test for -fPIE -mpic-data-is-text-relative. 2018-05-06 Andre Vehreschild diff --git a/gcc/testsuite/gfortran.dg/temporary_2.f90 b/gcc/testsuite/gfortran.dg/temporary_2.f90 new file mode 100644 index 00000000000..0598ea54f28 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/temporary_2.f90 @@ -0,0 +1,39 @@ +! { dg-do compile } +! +! Tests the fix for PR70864 in which compiler generated temporaries received +! the attributes of a dummy argument. This is the original testcase. +! The simplified version by Gerhard Steinmetz is gratefully acknowledged. +! +! Contributed by Weiqun Zhang +! +module boxarray_module + implicit none + type :: BoxArray + integer :: i = 0 + contains + procedure :: boxarray_assign + generic :: assignment(=) => boxarray_assign + end type BoxArray +contains + subroutine boxarray_assign (dst, src) + class(BoxArray), intent(inout) :: dst + type (BoxArray), intent(in ) :: src + dst%i =src%i + end subroutine boxarray_assign +end module boxarray_module + +module multifab_module + use boxarray_module + implicit none + type, public :: MultiFab + type(BoxArray) :: ba + end type MultiFab +contains + subroutine multifab_swap(mf1, mf2) + type(MultiFab), intent(inout) :: mf1, mf2 + type(MultiFab) :: tmp + tmp = mf1 + mf1 = mf2 ! Generated an ICE in trans-decl.c. + mf2 = tmp + end subroutine multifab_swap +end module multifab_module diff --git a/gcc/testsuite/gfortran.dg/temporary_3.f90 b/gcc/testsuite/gfortran.dg/temporary_3.f90 new file mode 100644 index 00000000000..84b300a38d9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/temporary_3.f90 @@ -0,0 +1,121 @@ +! { dg-do run } +! +! 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 + + -- 2.30.2