diff options
| -rw-r--r-- | gcc/testsuite/ChangeLog | 8 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/ISO_Fortran_binding_10.c | 4 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/ISO_Fortran_binding_16.c | 40 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/ISO_Fortran_binding_16.f90 | 25 | ||||
| -rw-r--r-- | libgfortran/ChangeLog | 7 | ||||
| -rw-r--r-- | libgfortran/runtime/ISO_Fortran_binding.c | 22 |
6 files changed, 97 insertions, 9 deletions
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index f8e626b..d03a6fd 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2019-11-11 José Rui Faustino de Sousa <jrfsousa@gmail.com> + + PR fortran/92142 + * gcc/testsuite/gfortran.dg/ISO_Fortran_binding_16.c: New. + * gcc/testsuite/gfortran.dg/ISO_Fortran_binding_16.f90: New. + * gcc/testsuite/gfortran.dg/ISO_Fortran_binding_10.c: Correct + upper bounds for case 0. + 2019-11-11 Thomas Schwinge <thomas@codesourcery.com> * gfortran.dg/goacc/common-block-1.f90: Fix OpenACC directives diff --git a/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_10.c b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_10.c index adda3b3..9f06e2d 100644 --- a/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_10.c +++ b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_10.c @@ -15,7 +15,7 @@ void si(CFI_cdesc_t *this, int flag, int *status) bool err; CFI_CDESC_T(1) that; CFI_index_t lb[] = { 0, 0 }; - CFI_index_t ub[] = { 4, 1 }; + CFI_index_t ub[] = { 4, 0 }; CFI_index_t st[] = { 2, 0 }; int chksum[] = { 9, 36, 38 }; @@ -50,7 +50,7 @@ void si(CFI_cdesc_t *this, int flag, int *status) if (err) { - printf("FAIL C: contiguity for flag value %i - is %i\n",flag, value); + printf("FAIL C: contiguity for flag value %i - is %i\n", flag, value); *status = 10; return; } diff --git a/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_16.c b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_16.c new file mode 100644 index 0000000..cdee0b8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_16.c @@ -0,0 +1,40 @@ +/* Test the fix for PR92142. */ + +#include "../../../libgfortran/ISO_Fortran_binding.h" + +#include <stdlib.h> + +int c_setpointer(CFI_cdesc_t *); + +int c_setpointer(CFI_cdesc_t *ip) +{ + CFI_cdesc_t *yp = NULL; + void *auxp = ip->base_addr; + int ierr; + int status; + + /* Setting up the pointer */ + ierr = 1; + yp = malloc(sizeof(*ip)); + if (yp == NULL) return ierr; + status = CFI_establish(yp, NULL, CFI_attribute_pointer, ip->type, ip->elem_len, ip->rank, NULL); + if (status != CFI_SUCCESS) return ierr; + if (yp->attribute != CFI_attribute_pointer) return ierr; + /* Set the pointer to ip */ + ierr = 2; + status = CFI_setpointer(yp, ip, NULL); + if (status != CFI_SUCCESS) return ierr; + if (yp->attribute != CFI_attribute_pointer) return ierr; + /* Set the pointer to NULL */ + ierr = 3; + status = CFI_setpointer(yp, NULL, NULL); + if (status != CFI_SUCCESS) return ierr; + if (yp->attribute != CFI_attribute_pointer) return ierr; + /* "Set" the ip variable to yp (should not be possible) */ + ierr = 4; + status = CFI_setpointer(ip, yp, NULL); + if (status != CFI_INVALID_ATTRIBUTE) return ierr; + if (ip->attribute != CFI_attribute_other) return ierr; + if (ip->base_addr != auxp) return ierr; + return 0; +} diff --git a/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_16.f90 b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_16.f90 new file mode 100644 index 0000000..799f34b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_16.f90 @@ -0,0 +1,25 @@ +! { dg-do run } +! { dg-additional-options "-fbounds-check" } +! { dg-additional-sources ISO_Fortran_binding_15.c } +! +! Test the fix for PR92142. +! + use, intrinsic :: iso_c_binding, only: c_int + + implicit none + + interface + function c_setpointer(ip) result(ierr) bind(c) + use, intrinsic :: iso_c_binding, only: c_int + type(*), dimension(..), target :: ip + integer(c_int) :: ierr + end function c_setpointer + end interface + + integer(c_int) :: it = 1 + + if (c_setpointer(it) /= 0) stop 1 + +end + +! { dg-output "CFI_setpointer: Result shall be the address of a C descriptor for a Fortran pointer." } diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 0684c35..075c986 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,10 @@ +2019-11-11 José Rui Faustino de Sousa <jrfsousa@gmail.com> + + PR fortran/92142 + * runtime/ISO_Fortran_binding.c (CFI_setpointer): Don't + override descriptor attribute; with -fcheck, check that + it is a pointer. + 2019-11-06 Jerry DeLisle <jvdelisle@gcc.ngu.org> PR fortran/90374 diff --git a/libgfortran/runtime/ISO_Fortran_binding.c b/libgfortran/runtime/ISO_Fortran_binding.c index c71d8e8..ae50057 100644 --- a/libgfortran/runtime/ISO_Fortran_binding.c +++ b/libgfortran/runtime/ISO_Fortran_binding.c @@ -795,20 +795,29 @@ int CFI_select_part (CFI_cdesc_t *result, const CFI_cdesc_t *source, int CFI_setpointer (CFI_cdesc_t *result, CFI_cdesc_t *source, const CFI_index_t lower_bounds[]) { - /* Result must not be NULL. */ - if (unlikely (compile_options.bounds_check) && result == NULL) + /* Result must not be NULL and must be a Fortran pointer. */ + if (unlikely (compile_options.bounds_check)) { - fprintf (stderr, "CFI_setpointer: Result is NULL.\n"); - return CFI_INVALID_DESCRIPTOR; + if (result == NULL) + { + fprintf (stderr, "CFI_setpointer: Result is NULL.\n"); + return CFI_INVALID_DESCRIPTOR; + } + + if (result->attribute != CFI_attribute_pointer) + { + fprintf (stderr, "CFI_setpointer: Result shall be the address of a " + "C descriptor for a Fortran pointer.\n"); + return CFI_INVALID_ATTRIBUTE; + } } - + /* If source is NULL, the result is a C Descriptor that describes a * disassociated pointer. */ if (source == NULL) { result->base_addr = NULL; result->version = CFI_VERSION; - result->attribute = CFI_attribute_pointer; } else { @@ -852,7 +861,6 @@ int CFI_setpointer (CFI_cdesc_t *result, CFI_cdesc_t *source, /* Assign components to result. */ result->version = source->version; - result->attribute = source->attribute; /* Dimension information. */ for (int i = 0; i < source->rank; i++) |