procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/68846 (Pointer function as LValue doesn't work when the assignment regards a dummy argument.)

Browse source 
2018-05-10  Paul Thomas  <pault@gcc.gnu.org>

	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  <pault@gcc.gnu.org>

	PR fortran/68846
	* gfortran.dg/temporary_3.f90 : New test.

	PR fortran/70864
	* gfortran.dg/temporary_2.f90 : New test.

From-SVN: r260113
This commit is contained in:
Paul Thomas 2018-05-10 10:48:50 +00:00
parent 84ec5aea48
commit 9caa7e073b
5 changed files with 178 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
gcc/fortran/ChangeLog
View file

@ -1,3 +1,10 @@
2018-05-10 Paul Thomas <pault@gcc.gnu.org>
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 <tkoenig@gcc.gnu.org>
PR fortran/54613

2
gcc/fortran/resolve.c
View file

@ -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)
{

10
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,11 @@
2018-05-10 Paul Thomas <pault@gcc.gnu.org>
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 <segher@kernel.crashing.org>
* gcc.dg/vmx/extract-be-order.c: Delete testcase.
@ -210,7 +218,7 @@
2018-05-06 Andrew Sadek <andrew.sadek.se@gmail.com>
* 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 <vehre@gcc.gnu.org>

39
gcc/testsuite/gfortran.dg/temporary_2.f90 Normal file
View file

@ -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 <weiqun.zhang@gmail.com>
!
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

121
gcc/testsuite/gfortran.dg/temporary_3.f90 Normal file
View file

@ -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 <mirco.valentini@polimi.it>
!
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