[patch, fortran] Fix PR 89384

[Thomas Koenig <tkoenig@netcologne.de>]

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

Hello world,

this patch fixes the 9 regression in C interop with contiguous
arguments recently reported by Reinhold Bader.

ChangeLog and patch say it all.  I hope I didn't overlook any
obvious things here (Paul, maybe you can take a look).

Regression-tested. OK for trunk?

Regards

	Thomas

2019-02-18  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/89384
	* trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): If the dummy
	argument is contiguous and the actual argument may not be,
	use gfc_conv_subref_array_arg.

2019-02-18  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/89384
	* gfortran.dg/ISO_Fortran_binding_4.f90

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

Index: trans-expr.c
===================================================================
--- trans-expr.c	(Revision 268992)
+++ trans-expr.c	(Arbeitskopie)
@@ -4944,7 +4944,12 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc
 
   if (e->rank != 0)
     {
-      gfc_conv_expr_descriptor (parmse, e);
+      if (fsym->attr.contiguous
+	  && !gfc_is_simply_contiguous (e, false, true))
+	gfc_conv_subref_array_arg (parmse, e, false, fsym->attr.intent,
+				   fsym->attr.pointer);
+      else
+	gfc_conv_expr_descriptor (parmse, e);
 
       if (POINTER_TYPE_P (TREE_TYPE (parmse->expr)))
 	parmse->expr = build_fold_indirect_ref_loc (input_location,

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

! { dg-do  run }
! PR fortran/89384 - this used to give a wrong results
! with contiguous.
! Test case by Reinhold Bader.
module mod_ctg
  implicit none
contains
  subroutine ctg(x) BIND(C)
    real, contiguous :: x(:)

    if (any(abs(x - [2.,4.,6.]) > 1.e-6)) then
       write(*,*) 'FAIL'
    else
       write(*,*) 'OK'
    end if
  end subroutine
end module
program p
  use mod_ctg
  implicit none
  real :: x(6)
  integer :: i

  x = [ (real(i), i=1, size(x)) ]
  call ctg(x(2::2))

end program