re PR fortran/56789 (Handling of contiguous dummy arguments)

2018-01-19  Thomas Koenig  <tkoenig@gcc.gnu.org>
	Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/56789
	* trans-expr.c (gfc_conv_procedure_call): Call
	gfc_conv_subref_array_arg if the formal arg is contiguous
	and the actual arg may not be.

2018-01-19  Thomas Koenig  <tkoenig@gcc.gnu.org>
	Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/56789
	* gfortran.dg/contiguous_3.f90: Make code compilant.  Remove
	scan-tree tests that fail with patch.
	* gfortran.dg/contiguous_8.f90: New test.

Co-Authored-By: Paul Thomas <pault@gcc.gnu.org>
From-SVN: r268096

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 21e4c884f7ca43764f63a91d55436cc0a82bbb37..c55cd7515f3015dcd4f170f3a6f7b917d326cdbb 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2018-01-19  Thomas Koenig  <tkoenig@gcc.gnu.org>
+       Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/56789
+       * trans-expr.c (gfc_conv_procedure_call): Call
+       gfc_conv_subref_array_arg if the formal arg is contiguous
+       and the actual arg may not be.
+
 2019-01-17  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
        PR fortran/88871

diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index b38d784bc0c5e939dd302561ff87b170957edc9f..3238e7cb582fa55d5749b887c3bd1a13fb6e78ab 100644 (file)
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -5828,6 +5828,13 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
                                             INTENT_IN,
                                             fsym && fsym->attr.pointer);
                }
+             else if (fsym && fsym->attr.contiguous
+                      && !gfc_is_simply_contiguous (e, false, true))
+               {
+                 gfc_conv_subref_array_arg (&parmse, e, nodesc_arg,
+                               fsym ? fsym->attr.intent : INTENT_INOUT,
+                               fsym && fsym->attr.pointer);
+               }
              else
                gfc_conv_array_parameter (&parmse, e, nodesc_arg, fsym,
                                          sym->name, NULL);

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 2a59d1b0a4bb471e4586c2e4a53f05fa600b60c6..286614dff12b913b6d061b32339203ea3673791b 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2018-01-19  Thomas Koenig  <tkoenig@gcc.gnu.org>
+       Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/56789
+       * gfortran.dg/contiguous_3.f90: Make code compilant.  Remove
+       scan-tree tests that fail with patch.
+       * gfortran.dg/contiguous_8.f90: New test.
+
 2019-01-19  Richard Sandiford  <richard.sandiford@arm.com>
 
        * gfortran.dg/loop_versioning_1.f90: Bump the number of identified

diff --git a/gcc/testsuite/gfortran.dg/contiguous_3.f90 b/gcc/testsuite/gfortran.dg/contiguous_3.f90
index 0999f7b5b91da978dc075734bdc00ad051685edd..724ec83ed1089f909480347af9252e5e28b407a6 100644 (file)
--- a/gcc/testsuite/gfortran.dg/contiguous_3.f90
+++ b/gcc/testsuite/gfortran.dg/contiguous_3.f90
@@ -8,6 +8,8 @@
 
 subroutine test1(a,b)
   integer, pointer, contiguous :: test1_a(:)
+  integer, target, dimension(3) :: aa
+  test1_a => aa
   call foo(test1_a)
   call foo(test1_a(::1))
   call foo(test1_a(::2))
@@ -56,9 +58,3 @@ contains
   end subroutine bar
 end subroutine test3
 
-! Once for test1 (third call), once for test3 (second call)
-! { dg-final { scan-tree-dump-times "data = origptr" 1 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_internal_pack .&parm" 2 "original" } }
-! { dg-final { scan-tree-dump-times "_gfortran_internal_unpack .&parm" 2 "original" } }
-
-

diff --git a/gcc/testsuite/gfortran.dg/contiguous_8.f90 b/gcc/testsuite/gfortran.dg/contiguous_8.f90
new file mode 100644 (file)
index 0000000..d362f1e
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/contiguous_8.f90
@@ -0,0 +1,65 @@
+! { dg-do  run }
+! PR 56789 - packing / unpacking of contiguous arguments
+! did not happen.
+
+module my_module
+  implicit none
+contains
+  subroutine cont_arg(a)
+    real, contiguous :: a(:,:)
+    integer :: i,j
+    do j=1,size(a,2)
+       do i=1,size(a,1)
+          a(i,j) = i+10*j
+       end do
+    end do
+  end subroutine cont_arg
+  subroutine cont_pointer_arg (a)
+    integer, pointer, contiguous :: a(:)
+    call assumed_size(a)
+    call assumed_size(a(::1))
+    call assumed_size_2(a(::2))
+  end subroutine cont_pointer_arg
+
+  subroutine assumed_size(y)
+    integer, dimension(*) :: y
+    if (y(2) /= 2 .or. y(3) /= 3 .or. y(4) /= 4 .or. y(5) /= 5 .or. y(6) /= 6) &
+            stop 2
+  end subroutine assumed_size
+
+  subroutine assumed_size_2(y)
+    integer, dimension(*) :: y
+    if (y(1) /= 1 .or. y(2) /= 3 .or. y(3) /= 5) stop 3
+  end subroutine assumed_size_2
+
+  subroutine cont_assumed_shape(x)
+    integer, dimension(:), contiguous :: x
+    if (size(x,1) == 8) then
+       if (any(x /= [1,2,3,4,5,6,7,8])) stop 4
+    else
+       if (any(x /= [1,3,5,7])) stop 5
+    end if
+  end subroutine cont_assumed_shape
+end module my_module
+
+program main
+  use my_module
+  implicit none
+  real, dimension(5,5) :: a
+  real, dimension(5,5) :: res
+  integer, dimension(8), target :: t
+  integer, dimension(:), pointer, contiguous :: p
+  res = reshape([11., 1.,12., 1.,13.,&
+                  1., 1., 1., 1., 1.,&
+                 21., 1.,22., 1.,23.,&
+                  1., 1., 1., 1., 1.,&
+                 31., 1.,32., 1., 33.], shape(res))
+  a = 1.
+  call cont_arg(a(1:5:2,1:5:2))
+  if (any(a /= res)) stop 1
+  t = [1,2,3,4,5,6,7,8]
+  p => t
+  call cont_pointer_arg(p)
+  call cont_assumed_shape (t)
+  call cont_assumed_shape (t(::2))
+end program main