This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[patch, libfortran,committed] Fix PR 40962
- From: Thomas Koenig <tkoenig at netcologne dot de>
- To: fortran at gcc dot gnu dot org
- Cc: gcc-patches at gcc dot gnu dot org
- Date: Thu, 20 Aug 2009 22:16:48 +0200
- Subject: [patch, libfortran,committed] Fix PR 40962
Hello world,
I committed the patch as obvious and simple for trunk (rev. 150974) and
will commit the 4.4 patch (which is functionally equivalent, just looks
different because of the array access macros in trunk) shortly. 4.4 is
included because this is a real-life wrong-code bug.
Thomas
2009-08-20 Thomas Koenig <tkoenig@gcc.gnu.org>
PR libfortran/40962
* iso_c_binding.c (c_f_pointer_u0): Multiply stride by
previous stride.
2009-08-20 Thomas Koenig <tkoenig@gcc.gnu.org>
PR libfortran/40962
* c_f_pointer_tests_4.f90: New test.
Index: iso_c_binding.c
===================================================================
--- iso_c_binding.c (revision 150791)
+++ iso_c_binding.c (working copy)
@@ -152,7 +152,7 @@ ISO_C_BINDING_PREFIX (c_f_pointer_u0) (v
}
else
{
- str = GFC_DESCRIPTOR_EXTENT(f_ptr_out,i-1);
+ str = str * GFC_DESCRIPTOR_EXTENT(f_ptr_out,i-1);
f_ptr_out->offset += str;
}
Index: iso_c_binding.c
===================================================================
--- iso_c_binding.c (revision 150967)
+++ iso_c_binding.c (working copy)
@@ -137,8 +137,8 @@ ISO_C_BINDING_PREFIX (c_f_pointer_u0) (v
f_ptr_out->offset = f_ptr_out->dim[0].lbound * f_ptr_out->dim[0].stride;
for (i = 1; i < shapeSize; i++)
{
- f_ptr_out->dim[i].stride = (f_ptr_out->dim[i-1].ubound + 1)
- - f_ptr_out->dim[i-1].lbound;
+ f_ptr_out->dim[i].stride = ((f_ptr_out->dim[i-1].ubound + 1)
+ - f_ptr_out->dim[i-1].lbound) * f_ptr_out->dim[i-1].stride;
f_ptr_out->offset += f_ptr_out->dim[i].lbound
* f_ptr_out->dim[i].stride;
}
! { dg-do run }
program main
use iso_c_binding, only: c_ptr, c_loc, c_f_pointer
implicit none
integer, dimension(2,1,2), target :: table
table = reshape ( (/ 1,2,-1,-2/), (/2,1,2/))
call set_table (c_loc (table))
contains
subroutine set_table (cptr)
type(c_ptr), intent(in) :: cptr
integer, dimension(:,:,:), pointer :: table_tmp
call c_f_pointer (cptr, table_tmp, (/2,1,2/))
if (any(table_tmp /= table)) call abort
end subroutine set_table
end program main