From: José Rui Faustino de Sousa Date: Mon, 11 Nov 2019 10:18:14 +0000 (+0000) Subject: PR fortran/92142 - CFI_setpointer corrupts descriptor X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=3f246567a44ba034c0b48f929c4d4586a4b914ed;p=gcc.git PR fortran/92142 - CFI_setpointer corrupts descriptor 2019-11-11 José Rui Faustino de Sousa libgfortran/ PR fortran/92142 * runtime/ISO_Fortran_binding.c (CFI_setpointer): Don't override descriptor attribute; with -fcheck, check that it is a pointer. gcc/testsuite/ 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. From-SVN: r278048 --- diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index f8e626b2fd4..d03a6fd70b1 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,11 @@ +2019-11-11 José Rui Faustino de Sousa + + 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 * 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 adda3b3c18a..9f06e2dd779 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 00000000000..cdee0b89efe --- /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 + +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 00000000000..799f34b1287 --- /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 0684c35b9b3..075c9860c80 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,10 @@ +2019-11-11 José Rui Faustino de Sousa + + 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 PR fortran/90374 diff --git a/libgfortran/runtime/ISO_Fortran_binding.c b/libgfortran/runtime/ISO_Fortran_binding.c index c71d8e89453..ae500571098 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++)