OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/89384 (CONTIGUOUS dummy argument in BIND(C) interface incorrect when actual is non-contiguous) 

2019-02-19  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-19  Thomas Koenig  <tkoenig@gcc.gnu.org>

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

From-SVN: r269024
This commit is contained in:
Thomas Koenig 2019-02-19 17:55:33 +00:00
parent fe95aee9ce
commit 9d52e1bbd8
4 changed files with 45 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 @@
2019-02-19 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-19 Chung-Lin Tang <cltang@codesourcery.com>
PR c/87924

7
gcc/fortran/trans-expr.c
View File

@ -4944,7 +4944,12 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym)
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,

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2019-02-19 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/89384
* gfortran.dg/ISO_Fortran_binding_4.f90
2019-02-19 Thomas Schwinge <thomas@codesourcery.com>
PR c/87924

27
gcc/testsuite/gfortran.dg/ISO_Fortran_binding_4.f90 Normal file
View File

@ -0,0 +1,27 @@
! { 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