diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index c27a1d0d0d4..995ede78f83 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2014-02-21 Janus Weil + + PR fortran/60302 + * check.c (gfc_check_c_f_pointer): Only clear 'size' if 'gfc_array_size' + is successful. + 2014-02-21 Janus Weil PR fortran/60234 diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 42820306e1c..119750aab8f 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -3944,16 +3944,17 @@ gfc_check_c_f_pointer (gfc_expr *cptr, gfc_expr *fptr, gfc_expr *shape) if (shape) { mpz_t size; - - if (gfc_array_size (shape, &size) - && mpz_cmp_ui (size, fptr->rank) != 0) + if (gfc_array_size (shape, &size)) { + if (mpz_cmp_ui (size, fptr->rank) != 0) + { + mpz_clear (size); + gfc_error ("SHAPE argument at %L to C_F_POINTER must have the same " + "size as the RANK of FPTR", &shape->where); + return false; + } mpz_clear (size); - gfc_error ("SHAPE argument at %L to C_F_POINTER must have the same " - "size as the RANK of FPTR", &shape->where); - return false; } - mpz_clear (size); } if (fptr->ts.type == BT_CLASS) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 8f8f35b9184..030107932f1 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2014-02-21 Janus Weil + + PR fortran/60302 + * gfortran.dg/c_f_pointer_shape_tests_6.f90: New. + 2014-02-21 Bill Schmidt * gcc.dg/vmx/vsums.c: Check entire result vector. diff --git a/gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_6.f90 b/gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_6.f90 new file mode 100644 index 00000000000..dd9b1636642 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/c_f_pointer_shape_tests_6.f90 @@ -0,0 +1,14 @@ +! { dg-do compile } +! +! PR 60302: [4.9 Regression] ICE with c_f_pointer and android cross compiler +! +! Contributed by Valery Weber + +subroutine reshape_inplace_c2_c2 (new_shape) + use, intrinsic :: iso_c_binding + implicit none + integer :: new_shape(:) + complex, pointer :: ptr_x(:) + type(c_ptr) :: loc_x + call c_f_pointer (loc_x, ptr_x, new_shape) +end subroutine