mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-04-05 19:51:34 +08:00
Code Issues Packages Projects Releases Wiki Activity

PR fortran/92142 - CFI_setpointer corrupts descriptor

Browse Source 
2019-11-11  José Rui Faustino de Sousa  <jrfsousa@gmail.com>

        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
This commit is contained in:
José Rui Faustino de Sousa 2019-11-11 10:18:14 +00:00 committed by Tobias Burnus
parent a5aeee56d8
commit 3f246567a4
6 changed files with 97 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
gcc/testsuite/ChangeLog
View File

@ -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

4
gcc/testsuite/gfortran.dg/ISO_Fortran_binding_10.c
View File

@ -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;
}

40
gcc/testsuite/gfortran.dg/ISO_Fortran_binding_16.c Normal file
View File

@ -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;
}

25
gcc/testsuite/gfortran.dg/ISO_Fortran_binding_16.f90 Normal file
View File

@ -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." }

7
libgfortran/ChangeLog
View File

@ -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

22
libgfortran/runtime/ISO_Fortran_binding.c
View File

@ -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++)