Hi José,
On 10/29/19 11:35 AM, José Rui Faustino de Sousa wrote:
Added the suggested check and a few touches to comments and the error
message.
Thanks.
that might be a bug in the C code of the test itself
I took a look and although there are problems with the code of the
test I do not think they are relevant.
Index: gcc/testsuite/gfortran.dg/ISO_Fortran_binding_10.c
I have included that patch.
Other remark: ChangeLog missing in the updated version of the patch. (I
just saw that you did include it when posting initially.)
I have now committed the patch as Rev. 278048 to the trunk.
Thanks for the patch!
Cheers,
Tobias
gcc/testsuite/ChangeLog | 8 +++
gcc/testsuite/gfortran.dg/ISO_Fortran_binding_10.c | 4 -
gcc/testsuite/gfortran.dg/ISO_Fortran_binding_16.c | 40 +++++++++++++++++++
gcc/testsuite/gfortran.dg/ISO_Fortran_binding_16.f90 | 25 +++++++++++
libgfortran/ChangeLog | 7 +++
libgfortran/runtime/ISO_Fortran_binding.c | 22 +++++++---
6 files changed, 97 insertions(+), 9 deletions(-)
Index: gcc/testsuite/gfortran.dg/ISO_Fortran_binding_16.c
===================================================================
--- gcc/testsuite/gfortran.dg/ISO_Fortran_binding_16.c (nonexistent)
+++ gcc/testsuite/gfortran.dg/ISO_Fortran_binding_16.c (revision 278048)
@@ -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;
+}
Index: gcc/testsuite/gfortran.dg/ISO_Fortran_binding_16.f90
===================================================================
--- gcc/testsuite/gfortran.dg/ISO_Fortran_binding_16.f90 (nonexistent)
+++ gcc/testsuite/gfortran.dg/ISO_Fortran_binding_16.f90 (revision 278048)
@@ -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." }
Index: gcc/testsuite/gfortran.dg/ISO_Fortran_binding_10.c
===================================================================
--- gcc/testsuite/gfortran.dg/ISO_Fortran_binding_10.c (revision 278047)
+++ gcc/testsuite/gfortran.dg/ISO_Fortran_binding_10.c (revision 278048)
@@ -15,7 +15,7 @@
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 @@
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;
}
Index: gcc/testsuite/ChangeLog
===================================================================
--- gcc/testsuite/ChangeLog (revision 278047)
+++ gcc/testsuite/ChangeLog (revision 278048)
@@ -1,3 +1,11 @@
+2019-11-11 José Rui Faustino de Sousa <jrfso...@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 <tho...@codesourcery.com>
* gfortran.dg/goacc/common-block-1.f90: Fix OpenACC directives
Index: libgfortran/runtime/ISO_Fortran_binding.c
===================================================================
--- libgfortran/runtime/ISO_Fortran_binding.c (revision 278047)
+++ libgfortran/runtime/ISO_Fortran_binding.c (revision 278048)
@@ -795,13 +795,23 @@
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)
@@ -808,7 +818,6 @@
{
result->base_addr = NULL;
result->version = CFI_VERSION;
- result->attribute = CFI_attribute_pointer;
}
else
{
@@ -852,7 +861,6 @@
/* Assign components to result. */
result->version = source->version;
- result->attribute = source->attribute;
/* Dimension information. */
for (int i = 0; i < source->rank; i++)
Index: libgfortran/ChangeLog
===================================================================
--- libgfortran/ChangeLog (revision 278047)
+++ libgfortran/ChangeLog (revision 278048)
@@ -1,3 +1,10 @@
+2019-11-11 José Rui Faustino de Sousa <jrfso...@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 <jvdeli...@gcc.ngu.org>
PR fortran/90374
