[patch, fortran] Fix contiguous dummy arguments

[Thomas Koenig <tkoenig@netcologne.de>]

[-- Attachment #1: Type: text/plain, Size: 1109 bytes --]

Hello world,

the attached patch fixes handling of contiguous dummy arguments when
the actual arguments are not contiguous.

The patch to trans-expr.c itself was written by Paul and attached to
the PR. I just added the test case.  Regression-testing revealed some
failing scan-tree tests due to different code being generated. I put
corresponding run time tests into the new test case to make sure that no
wrong code is being generated.

I have also tested the new test case and the compiler with valgrind.

OK for trunk?

Regards

	Thomas

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.

[-- Attachment #2: p2.diff --]
[-- Type: text/x-patch, Size: 1502 bytes --]

Index: fortran/trans-expr.c
===================================================================
--- fortran/trans-expr.c	(Revision 267903)
+++ fortran/trans-expr.c	(Arbeitskopie)
@@ -5819,6 +5819,13 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol *
 					     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);
Index: testsuite/gfortran.dg/contiguous_3.f90
===================================================================
--- testsuite/gfortran.dg/contiguous_3.f90	(Revision 267903)
+++ testsuite/gfortran.dg/contiguous_3.f90	(Arbeitskopie)
@@ -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" } }
-
-

[-- Attachment #3: contiguous_8.f90 --]
[-- Type: text/x-fortran, Size: 1751 bytes --]

! { 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