re PR fortran/68846 (Pointer function as LValue doesn't work when the assignment...

2018-05-13  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/68846
	PR fortran/70864
	Backport from trunk
	* resolve.c (get_temp_from_expr): The temporary must not have
	dummy or intent attributes.

2018-05-13  Paul Thomas  <pault@gcc.gnu.org>

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

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

From-SVN: r260208

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 589610208b32e37597f39c5c531fb8e2e0d3a7b3..2f13abb8732ee678b01a13ab21027cf7c852b1ba 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,9 +1,17 @@
+2018-05-13  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/68846
+       PR fortran/70864
+       Backport from trunk
+       * resolve.c (get_temp_from_expr): The temporary must not have
+       dummy or intent attributes.
+
 2018-05-12  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        PR fortran/85542
        Backport from trunk
        * expr.c (check_inquiry): Avoid NULL pointer dereference.
- 
+
 2018-05-11  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        PR fortran/70870

diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 99ee31efeeb2276b2723a8cfddd4f862f5801954..0285089ef0e4beb7afadcb574bcd5891e955137d 100644 (file)
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -9940,6 +9940,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 125301d4e30327d805f9cd48cf064679f166ef38..0a3cdbf0df584ddec915c2326769f1bfa777db84 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,13 @@
+2018-05-13  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/68846
+       Backport from trunk
+       * gfortran.dg/temporary_3.f90 : New test.
+
+       PR fortran/70864
+       Backport from trunk
+       * gfortran.dg/temporary_2.f90 : New test.
+
 2018-05-12  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        PR fortran/85542

diff --git a/gcc/testsuite/gfortran.dg/temporary_2.f90 b/gcc/testsuite/gfortran.dg/temporary_2.f90
new file mode 100644 (file)
index 0000000..0598ea5
--- /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  <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

diff --git a/gcc/testsuite/gfortran.dg/temporary_3.f90 b/gcc/testsuite/gfortran.dg/temporary_3.f90
new file mode 100644 (file)
index 0000000..84b300a
--- /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  <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
+
+