diff options
author | Tobias Burnus <tobias@codesourcery.com> | 2021-07-26 14:20:46 +0200 |
---|---|---|
committer | Tobias Burnus <tobias@codesourcery.com> | 2021-07-26 14:32:53 +0200 |
commit | 0cbf03689e3e7d9d6002b8e5d159ef3716d0404c (patch) | |
tree | 954d333194e1572fb693ffbef91c6d38f558fd67 /libgfortran | |
parent | 32f7506bdc3956762bcc7dc84133fd7c3a00bb7b (diff) | |
download | gcc-0cbf03689e3e7d9d6002b8e5d159ef3716d0404c.zip gcc-0cbf03689e3e7d9d6002b8e5d159ef3716d0404c.tar.gz gcc-0cbf03689e3e7d9d6002b8e5d159ef3716d0404c.tar.bz2 |
PR fortran/93308/93963/94327/94331/97046 problems raised by descriptor handling
Fortran: Fix attributes and bounds in ISO_Fortran_binding.
2021-07-26 José Rui Faustino de Sousa <jrfsousa@gmail.com>
Tobias Burnus <tobias@codesourcery.com>
PR fortran/93308
PR fortran/93963
PR fortran/94327
PR fortran/94331
PR fortran/97046
gcc/fortran/ChangeLog:
* trans-decl.c (convert_CFI_desc): Only copy out the descriptor
if necessary.
* trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): Updated attribute
handling which reflect a previous intermediate version of the
standard. Only copy out the descriptor if necessary.
libgfortran/ChangeLog:
* runtime/ISO_Fortran_binding.c (cfi_desc_to_gfc_desc): Add code
to verify the descriptor. Correct bounds calculation.
(gfc_desc_to_cfi_desc): Add code to verify the descriptor.
gcc/testsuite/ChangeLog:
* gfortran.dg/ISO_Fortran_binding_1.f90: Add pointer attribute,
this test is still erroneous but now it compiles.
* gfortran.dg/bind_c_array_params_2.f90: Update regex to match
code changes.
* gfortran.dg/PR93308.f90: New test.
* gfortran.dg/PR93963.f90: New test.
* gfortran.dg/PR94327.c: New test.
* gfortran.dg/PR94327.f90: New test.
* gfortran.dg/PR94331.c: New test.
* gfortran.dg/PR94331.f90: New test.
* gfortran.dg/PR97046.f90: New test.
Diffstat (limited to 'libgfortran')
-rw-r--r-- | libgfortran/runtime/ISO_Fortran_binding.c | 56 |
1 files changed, 48 insertions, 8 deletions
diff --git a/libgfortran/runtime/ISO_Fortran_binding.c b/libgfortran/runtime/ISO_Fortran_binding.c index 773d24e..95e9b94 100644 --- a/libgfortran/runtime/ISO_Fortran_binding.c +++ b/libgfortran/runtime/ISO_Fortran_binding.c @@ -43,6 +43,24 @@ cfi_desc_to_gfc_desc (gfc_array_void *d, CFI_cdesc_t **s_ptr) if (!s) return; + /* Verify descriptor. */ + switch(s->attribute) + { + case CFI_attribute_pointer: + case CFI_attribute_allocatable: + break; + case CFI_attribute_other: + if (s->base_addr) + break; + runtime_error ("Nonallocatable, nonpointer actual argument to BIND(C) " + "dummy argument where the effective argument is either " + "not allocated or not associated"); + break; + default: + runtime_error ("Invalid attribute type %d in CFI_cdesc_t descriptor", + (int) s->attribute); + break; + } GFC_DESCRIPTOR_DATA (d) = s->base_addr; GFC_DESCRIPTOR_TYPE (d) = (signed char)(s->type & CFI_type_mask); kind = (index_type)((s->type - (s->type & CFI_type_mask)) >> CFI_type_kind_shift); @@ -74,14 +92,19 @@ cfi_desc_to_gfc_desc (gfc_array_void *d, CFI_cdesc_t **s_ptr) } d->offset = 0; - for (n = 0; n < GFC_DESCRIPTOR_RANK (d); n++) - { - GFC_DESCRIPTOR_LBOUND(d, n) = (index_type)s->dim[n].lower_bound; - GFC_DESCRIPTOR_UBOUND(d, n) = (index_type)(s->dim[n].extent - + s->dim[n].lower_bound - 1); - GFC_DESCRIPTOR_STRIDE(d, n) = (index_type)(s->dim[n].sm / s->elem_len); - d->offset -= GFC_DESCRIPTOR_STRIDE(d, n) * GFC_DESCRIPTOR_LBOUND(d, n); - } + if (GFC_DESCRIPTOR_DATA (d)) + for (n = 0; n < GFC_DESCRIPTOR_RANK (d); n++) + { + CFI_index_t lb = 1; + + if (s->attribute != CFI_attribute_other) + lb = s->dim[n].lower_bound; + + GFC_DESCRIPTOR_LBOUND(d, n) = (index_type)lb; + GFC_DESCRIPTOR_UBOUND(d, n) = (index_type)(s->dim[n].extent + lb - 1); + GFC_DESCRIPTOR_STRIDE(d, n) = (index_type)(s->dim[n].sm / s->elem_len); + d->offset -= GFC_DESCRIPTOR_STRIDE(d, n) * GFC_DESCRIPTOR_LBOUND(d, n); + } } extern void gfc_desc_to_cfi_desc (CFI_cdesc_t **, const gfc_array_void *); @@ -102,6 +125,23 @@ gfc_desc_to_cfi_desc (CFI_cdesc_t **d_ptr, const gfc_array_void *s) else d = *d_ptr; + /* Verify descriptor. */ + switch (s->dtype.attribute) + { + case CFI_attribute_pointer: + case CFI_attribute_allocatable: + break; + case CFI_attribute_other: + if (s->base_addr) + break; + runtime_error ("Nonallocatable, nonpointer actual argument to BIND(C) " + "dummy argument where the effective argument is either " + "not allocated or not associated"); + break; + default: + internal_error (NULL, "Invalid attribute in gfc_array descriptor"); + break; + } d->base_addr = GFC_DESCRIPTOR_DATA (s); d->elem_len = GFC_DESCRIPTOR_SIZE (s); d->version = CFI_VERSION; |