From 3f246567a44ba034c0b48f929c4d4586a4b914ed Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jos=C3=A9=20Rui=20Faustino=20de=20Sousa?= Date: Mon, 11 Nov 2019 10:18:14 +0000 Subject: PR fortran/92142 - CFI_setpointer corrupts descriptor MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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 --- libgfortran/runtime/ISO_Fortran_binding.c | 22 +++++++++++++++------- 1 file changed, 15 insertions(+), 7 deletions(-) (limited to 'libgfortran/runtime') 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++) -- cgit v1.1