aboutsummaryrefslogtreecommitdiff
path: root/libgfortran
diff options
context:
space:
mode:
Diffstat (limited to 'libgfortran')
-rw-r--r--libgfortran/ChangeLog30
-rw-r--r--libgfortran/runtime/ISO_Fortran_binding.c85
2 files changed, 60 insertions, 55 deletions
diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index 70ed7487eb7..6dc32e8e173 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,21 @@
+2019-11-13 Tobias Burnus <tobias@codesourcery.com>
+
+ Backport from mainline
+ 2019-11-13 Tobias Burnus <tobias@codesourcery.com>
+
+ PR fortran/92470
+ * runtime/ISO_Fortran_binding.c (CFI_establish): Set lower_bound to 0
+ also for CFI_attribute_other.
+
+ 2019-11-12 Tobias Burnus <tobias@codesourcery.com>
+
+ PR fortran/92470
+ * runtime/ISO_Fortran_binding.c (CFI_address): Handle non-zero
+ lower_bound; update error message.
+ (CFI_allocate): Fix comment typo.
+ (CFI_establish): Fix identation, fix typos, don't check values of 'dv'
+ argument.
+
2019-08-13 Janne Blomqvist <jb@gcc.gnu.org>
Partial backport from trunk
@@ -34,12 +52,12 @@
2019-05-20 Janne Blomqvist <jb@gcc.gnu.org>
Backport from trunk
- PR libfortran/90038
- * intrinsics/execute_command_line (sigchld_handler): New function.
- (execute_command_line): Install handler for SIGCHLD.
- * configure.ac: Check for presence of sigaction and waitpid.
- * config.h.in: Regenerated.
- * configure: Regenerated.
+ PR libfortran/90038
+ * intrinsics/execute_command_line (sigchld_handler): New function.
+ (execute_command_line): Install handler for SIGCHLD.
+ * configure.ac: Check for presence of sigaction and waitpid.
+ * config.h.in: Regenerated.
+ * configure: Regenerated.
2019-05-20 Janne Blomqvist <jb@gcc.gnu.org>
diff --git a/libgfortran/runtime/ISO_Fortran_binding.c b/libgfortran/runtime/ISO_Fortran_binding.c
index 695ef57ac32..0aec06b5eed 100644
--- a/libgfortran/runtime/ISO_Fortran_binding.c
+++ b/libgfortran/runtime/ISO_Fortran_binding.c
@@ -119,24 +119,25 @@ gfc_desc_to_cfi_desc (CFI_cdesc_t **d_ptr, const gfc_array_void *s)
d->type = (CFI_type_t)(d->type
+ ((CFI_type_t)d->elem_len << CFI_type_kind_shift));
- /* Full pointer or allocatable arrays retain their lower_bounds. */
- for (n = 0; n < GFC_DESCRIPTOR_RANK (s); n++)
- {
- if (d->attribute != CFI_attribute_other)
- d->dim[n].lower_bound = (CFI_index_t)GFC_DESCRIPTOR_LBOUND(s, n);
- else
- d->dim[n].lower_bound = 0;
-
- /* Assumed size arrays have gfc ubound == 0 and CFI extent = -1. */
- if ((n == GFC_DESCRIPTOR_RANK (s) - 1)
- && GFC_DESCRIPTOR_LBOUND(s, n) == 1
- && GFC_DESCRIPTOR_UBOUND(s, n) == 0)
- d->dim[n].extent = -1;
- else
- d->dim[n].extent = (CFI_index_t)GFC_DESCRIPTOR_UBOUND(s, n)
- - (CFI_index_t)GFC_DESCRIPTOR_LBOUND(s, n) + 1;
- d->dim[n].sm = (CFI_index_t)(GFC_DESCRIPTOR_STRIDE(s, n) * s->span);
- }
+ if (d->base_addr)
+ /* Full pointer or allocatable arrays retain their lower_bounds. */
+ for (n = 0; n < GFC_DESCRIPTOR_RANK (s); n++)
+ {
+ if (d->attribute != CFI_attribute_other)
+ d->dim[n].lower_bound = (CFI_index_t)GFC_DESCRIPTOR_LBOUND(s, n);
+ else
+ d->dim[n].lower_bound = 0;
+
+ /* Assumed size arrays have gfc ubound == 0 and CFI extent = -1. */
+ if (n == GFC_DESCRIPTOR_RANK (s) - 1
+ && GFC_DESCRIPTOR_LBOUND(s, n) == 1
+ && GFC_DESCRIPTOR_UBOUND(s, n) == 0)
+ d->dim[n].extent = -1;
+ else
+ d->dim[n].extent = (CFI_index_t)GFC_DESCRIPTOR_UBOUND(s, n)
+ - (CFI_index_t)GFC_DESCRIPTOR_LBOUND(s, n) + 1;
+ d->dim[n].sm = (CFI_index_t)(GFC_DESCRIPTOR_STRIDE(s, n) * s->span);
+ }
if (*d_ptr == NULL)
*d_ptr = d;
@@ -176,19 +177,21 @@ void *CFI_address (const CFI_cdesc_t *dv, const CFI_index_t subscripts[])
specified by subscripts. */
for (i = 0; i < dv->rank; i++)
{
+ CFI_index_t idx = subscripts[i] - dv->dim[i].lower_bound;
if (unlikely (compile_options.bounds_check)
- && ((dv->dim[i].extent != -1
- && subscripts[i] >= dv->dim[i].extent)
- || subscripts[i] < 0))
+ && ((dv->dim[i].extent != -1 && idx >= dv->dim[i].extent)
+ || idx < 0))
{
- fprintf (stderr, "CFI_address: subscripts[%d], is out of "
- "bounds. dv->dim[%d].extent = %d subscripts[%d] "
- "= %d.\n", i, i, (int)dv->dim[i].extent, i,
- (int)subscripts[i]);
+ fprintf (stderr, "CFI_address: subscripts[%d] is out of "
+ "bounds. For dimension = %d, subscripts = %d, "
+ "lower_bound = %d, upper bound = %d, extend = %d\n",
+ i, i, (int)subscripts[i], (int)dv->dim[i].lower_bound,
+ (int)(dv->dim[i].extent - dv->dim[i].lower_bound),
+ (int)dv->dim[i].extent);
return NULL;
}
- base_addr = base_addr + (CFI_index_t)(subscripts[i] * dv->dim[i].sm);
+ base_addr = base_addr + (CFI_index_t)(idx * dv->dim[i].sm);
}
}
@@ -227,7 +230,7 @@ CFI_allocate (CFI_cdesc_t *dv, const CFI_index_t lower_bounds[],
}
/* If the type is a character, the descriptor's element length is replaced
- * by the elem_len argument. */
+ by the elem_len argument. */
if (dv->type == CFI_type_char || dv->type == CFI_type_ucs4_char ||
dv->type == CFI_type_signed_char)
dv->elem_len = elem_len;
@@ -236,7 +239,7 @@ CFI_allocate (CFI_cdesc_t *dv, const CFI_index_t lower_bounds[],
size_t arr_len = 1;
/* If rank is greater than 0, lower_bounds and upper_bounds are used. They're
- * ignored otherwhise. */
+ ignored otherwise. */
if (dv->rank > 0)
{
if (unlikely (compile_options.bounds_check)
@@ -324,20 +327,10 @@ int CFI_establish (CFI_cdesc_t *dv, void *base_addr, CFI_attribute_t attribute,
{
fprintf (stderr, "CFI_establish: Rank must be between 0 and %d, "
"0 < rank (0 !< %d).\n", CFI_MAX_RANK, (int)rank);
- return CFI_INVALID_RANK;
- }
-
- /* C Descriptor must not be an allocated allocatable. */
- if (dv->attribute == CFI_attribute_allocatable && dv->base_addr != NULL)
- {
- fprintf (stderr, "CFI_establish: If the C Descriptor represents an "
- "allocatable variable (dv->attribute = %d), its base "
- "address must be NULL (dv->base_addr = NULL).\n",
- CFI_attribute_allocatable);
- return CFI_INVALID_DESCRIPTOR;
+ return CFI_INVALID_RANK;
}
- /* If base address is not NULL, the established C Descriptor is for a
+ /* If base address is not NULL, the established C Descriptor is for a
nonallocatable entity. */
if (attribute == CFI_attribute_allocatable && base_addr != NULL)
{
@@ -381,26 +374,20 @@ int CFI_establish (CFI_cdesc_t *dv, void *base_addr, CFI_attribute_t attribute,
dv->type = type;
/* Extents must not be NULL if rank is greater than zero and base_addr is not
- * NULL */
+ NULL */
if (rank > 0 && base_addr != NULL)
{
if (unlikely (compile_options.bounds_check) && extents == NULL)
{
fprintf (stderr, "CFI_establish: Extents must not be NULL "
- "(extents != NULL) if rank (= %d) > 0 nd base address"
+ "(extents != NULL) if rank (= %d) > 0 and base address "
"is not NULL (base_addr != NULL).\n", (int)rank);
return CFI_INVALID_EXTENT;
}
for (int i = 0; i < rank; i++)
{
- /* If the C Descriptor is for a pointer then the lower bounds of every
- * dimension are set to zero. */
- if (attribute == CFI_attribute_pointer)
- dv->dim[i].lower_bound = 0;
- else
- dv->dim[i].lower_bound = 1;
-
+ dv->dim[i].lower_bound = 0;
dv->dim[i].extent = extents[i];
if (i == 0)
dv->dim[i].sm = dv->elem_len;
generated by cgit v1.2.3 (git 2.25.1) at 2024-05-20 03:03:49 +0000