Bind(c): Improve error checking in CFI_* functions
This patch adds additional run-time checking for invalid arguments to CFI_establish and CFI_setpointer. It also changes existing messages throughout the CFI_* functions to use PRIiPTR to format CFI_index_t values instead of casting them to int and using %d (which may not work on targets where int is a smaller type), simplifies wording of some messages, and fixes issues with capitalization, typos, and the like. Additionally some coding standards problems such as >80 character lines are addressed. 2021-07-24 Sandra Loosemore <sandra@codesourcery.com> PR libfortran/101317 libgfortran/ * runtime/ISO_Fortran_binding.c: Include <inttypes.h>. (CFI_address): Tidy error messages and comments. (CFI_allocate): Likewise. (CFI_deallocate): Likewise. (CFI_establish): Likewise. Add new checks for validity of elem_len when it's used, plus type argument and extents. (CFI_is_contiguous): Tidy error messages and comments. (CFI_section): Likewise. Refactor some repetitive code to make it more understandable. (CFI_select_part): Likewise. (CFI_setpointer): Likewise. Check that source is not an unallocated allocatable array or an assumed-size array. gcc/testsuite/ * gfortran.dg/ISO_Fortran_binding_17.f90: Fix typo in error message patterns.
This commit is contained in:
parent
b4a9bc7856
commit
e78480ad09
2 changed files with 170 additions and 118 deletions
|
@ -71,7 +71,7 @@
|
|||
end block blk2
|
||||
end
|
||||
|
||||
! { dg-output "CFI_address: subscripts\\\[0\\\] is out of bounds. For dimension = 0, subscripts = -1, lower_bound = 0, upper bound = 4, extend = 4(\n|\r\n|\r)" }
|
||||
! { dg-output "CFI_address: subscripts\\\[0\\\] is out of bounds. For dimension = 0, subscripts = 5, lower_bound = 0, upper bound = 4, extend = 4(\n|\r\n|\r).*" }
|
||||
! { dg-output "CFI_address: subscripts\\\[0\\\] is out of bounds. For dimension = 0, subscripts = -3, lower_bound = -2, upper bound = 6, extend = 4(\n|\r\n|\r)" }
|
||||
! { dg-output "CFI_address: subscripts\\\[0\\\] is out of bounds. For dimension = 0, subscripts = 2, lower_bound = -2, upper bound = 6, extend = 4(\n|\r\n|\r)" }
|
||||
! { dg-output "CFI_address: subscripts\\\[0\\\] is out of bounds. For dimension = 0, subscripts = -1, lower_bound = 0, upper bound = 4, extent = 4(\n|\r\n|\r)" }
|
||||
! { dg-output "CFI_address: subscripts\\\[0\\\] is out of bounds. For dimension = 0, subscripts = 5, lower_bound = 0, upper bound = 4, extent = 4(\n|\r\n|\r).*" }
|
||||
! { dg-output "CFI_address: subscripts\\\[0\\\] is out of bounds. For dimension = 0, subscripts = -3, lower_bound = -2, upper bound = 6, extent = 4(\n|\r\n|\r)" }
|
||||
! { dg-output "CFI_address: subscripts\\\[0\\\] is out of bounds. For dimension = 0, subscripts = 2, lower_bound = -2, upper bound = 6, extent = 4(\n|\r\n|\r)" }
|
||||
|
|
|
@ -29,6 +29,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
|
|||
#include "libgfortran.h"
|
||||
#include "ISO_Fortran_binding.h"
|
||||
#include <string.h>
|
||||
#include <inttypes.h> /* for PRIiPTR */
|
||||
|
||||
extern void cfi_desc_to_gfc_desc (gfc_array_void *, CFI_cdesc_t **);
|
||||
export_proto(cfi_desc_to_gfc_desc);
|
||||
|
@ -190,17 +191,17 @@ void *CFI_address (const CFI_cdesc_t *dv, const CFI_index_t subscripts[])
|
|||
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
{
|
||||
/* C Descriptor must not be NULL. */
|
||||
/* C descriptor must not be NULL. */
|
||||
if (dv == NULL)
|
||||
{
|
||||
fprintf (stderr, "CFI_address: C Descriptor is NULL.\n");
|
||||
fprintf (stderr, "CFI_address: C descriptor is NULL.\n");
|
||||
return NULL;
|
||||
}
|
||||
|
||||
/* Base address of C Descriptor must not be NULL. */
|
||||
/* Base address of C descriptor must not be NULL. */
|
||||
if (dv->base_addr == NULL)
|
||||
{
|
||||
fprintf (stderr, "CFI_address: base address of C Descriptor "
|
||||
fprintf (stderr, "CFI_address: base address of C descriptor "
|
||||
"must not be NULL.\n");
|
||||
return NULL;
|
||||
}
|
||||
|
@ -224,10 +225,12 @@ void *CFI_address (const CFI_cdesc_t *dv, const CFI_index_t subscripts[])
|
|||
{
|
||||
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);
|
||||
"lower_bound = %" PRIiPTR ", upper bound = %" PRIiPTR
|
||||
", extent = %" PRIiPTR "\n",
|
||||
i, i, (int)subscripts[i],
|
||||
(ptrdiff_t)dv->dim[i].lower_bound,
|
||||
(ptrdiff_t)(dv->dim[i].extent - dv->dim[i].lower_bound),
|
||||
(ptrdiff_t)dv->dim[i].extent);
|
||||
return NULL;
|
||||
}
|
||||
|
||||
|
@ -245,14 +248,14 @@ CFI_allocate (CFI_cdesc_t *dv, const CFI_index_t lower_bounds[],
|
|||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
{
|
||||
/* C Descriptor must not be NULL. */
|
||||
/* C descriptor must not be NULL. */
|
||||
if (dv == NULL)
|
||||
{
|
||||
fprintf (stderr, "CFI_allocate: C Descriptor is NULL.\n");
|
||||
fprintf (stderr, "CFI_allocate: C descriptor is NULL.\n");
|
||||
return CFI_INVALID_DESCRIPTOR;
|
||||
}
|
||||
|
||||
/* The C Descriptor must be for an allocatable or pointer object. */
|
||||
/* The C descriptor must be for an allocatable or pointer object. */
|
||||
if (dv->attribute == CFI_attribute_other)
|
||||
{
|
||||
fprintf (stderr, "CFI_allocate: The object of the C descriptor "
|
||||
|
@ -260,7 +263,7 @@ CFI_allocate (CFI_cdesc_t *dv, const CFI_index_t lower_bounds[],
|
|||
return CFI_INVALID_ATTRIBUTE;
|
||||
}
|
||||
|
||||
/* Base address of C Descriptor must be NULL. */
|
||||
/* Base address of C descriptor must be NULL. */
|
||||
if (dv->base_addr != NULL)
|
||||
{
|
||||
fprintf (stderr, "CFI_allocate: Base address of C descriptor "
|
||||
|
@ -284,8 +287,9 @@ CFI_allocate (CFI_cdesc_t *dv, const CFI_index_t lower_bounds[],
|
|||
if (unlikely (compile_options.bounds_check)
|
||||
&& (lower_bounds == NULL || upper_bounds == NULL))
|
||||
{
|
||||
fprintf (stderr, "CFI_allocate: If 0 < rank (= %d) upper_bounds[] "
|
||||
"and lower_bounds[], must not be NULL.\n", dv->rank);
|
||||
fprintf (stderr, "CFI_allocate: The lower_bounds and "
|
||||
"upper_bounds arguments must be non-NULL when "
|
||||
"rank is greater than zero.\n");
|
||||
return CFI_INVALID_EXTENT;
|
||||
}
|
||||
|
||||
|
@ -314,10 +318,10 @@ CFI_deallocate (CFI_cdesc_t *dv)
|
|||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
{
|
||||
/* C Descriptor must not be NULL */
|
||||
/* C descriptor must not be NULL */
|
||||
if (dv == NULL)
|
||||
{
|
||||
fprintf (stderr, "CFI_deallocate: C Descriptor is NULL.\n");
|
||||
fprintf (stderr, "CFI_deallocate: C descriptor is NULL.\n");
|
||||
return CFI_INVALID_DESCRIPTOR;
|
||||
}
|
||||
|
||||
|
@ -328,10 +332,10 @@ CFI_deallocate (CFI_cdesc_t *dv)
|
|||
return CFI_ERROR_BASE_ADDR_NULL;
|
||||
}
|
||||
|
||||
/* C Descriptor must be for an allocatable or pointer variable. */
|
||||
/* C descriptor must be for an allocatable or pointer variable. */
|
||||
if (dv->attribute == CFI_attribute_other)
|
||||
{
|
||||
fprintf (stderr, "CFI_deallocate: C Descriptor must describe a "
|
||||
fprintf (stderr, "CFI_deallocate: C descriptor must describe a "
|
||||
"pointer or allocatable object.\n");
|
||||
return CFI_INVALID_ATTRIBUTE;
|
||||
}
|
||||
|
@ -366,14 +370,13 @@ int CFI_establish (CFI_cdesc_t *dv, void *base_addr, CFI_attribute_t attribute,
|
|||
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)
|
||||
{
|
||||
fprintf (stderr, "CFI_establish: If base address is not NULL "
|
||||
"(base_addr != NULL), the established C descriptor is "
|
||||
"for a nonallocatable entity (attribute != %d).\n",
|
||||
CFI_attribute_allocatable);
|
||||
fprintf (stderr, "CFI_establish: If base address is not NULL, "
|
||||
"the established C descriptor must be "
|
||||
"for a nonallocatable entity.\n");
|
||||
return CFI_INVALID_ATTRIBUTE;
|
||||
}
|
||||
}
|
||||
|
@ -382,11 +385,26 @@ int CFI_establish (CFI_cdesc_t *dv, void *base_addr, CFI_attribute_t attribute,
|
|||
|
||||
if (type == CFI_type_char || type == CFI_type_ucs4_char
|
||||
|| type == CFI_type_struct || type == CFI_type_other)
|
||||
dv->elem_len = elem_len;
|
||||
{
|
||||
/* Note that elem_len has type size_t, which is unsigned. */
|
||||
if (unlikely (compile_options.bounds_check) && elem_len == 0)
|
||||
{
|
||||
fprintf (stderr, "CFI_establish: The supplied elem_len must "
|
||||
"be greater than zero.\n");
|
||||
return CFI_INVALID_ELEM_LEN;
|
||||
}
|
||||
dv->elem_len = elem_len;
|
||||
}
|
||||
else if (type == CFI_type_cptr)
|
||||
dv->elem_len = sizeof (void *);
|
||||
else if (type == CFI_type_cfunptr)
|
||||
dv->elem_len = sizeof (void (*)(void));
|
||||
else if (unlikely (compile_options.bounds_check) && type < 0)
|
||||
{
|
||||
fprintf (stderr, "CFI_establish: Invalid type (type = %d).\n",
|
||||
(int)type);
|
||||
return CFI_INVALID_TYPE;
|
||||
}
|
||||
else
|
||||
{
|
||||
/* base_type describes the intrinsic type with kind parameter. */
|
||||
|
@ -416,13 +434,24 @@ int CFI_establish (CFI_cdesc_t *dv, void *base_addr, CFI_attribute_t attribute,
|
|||
if (unlikely (compile_options.bounds_check) && extents == NULL)
|
||||
{
|
||||
fprintf (stderr, "CFI_establish: Extents must not be NULL "
|
||||
"(extents != NULL) if rank (= %d) > 0 and base address "
|
||||
"is not NULL (base_addr != NULL).\n", (int)rank);
|
||||
"if rank is greater than zero and base address is "
|
||||
"not NULL.\n");
|
||||
return CFI_INVALID_EXTENT;
|
||||
}
|
||||
|
||||
for (int i = 0; i < rank; i++)
|
||||
{
|
||||
/* The standard requires all dimensions to be nonnegative.
|
||||
Apparently you can have an extent-zero dimension but can't
|
||||
construct an assumed-size array with -1 as the extent
|
||||
of the last dimension. */
|
||||
if (unlikely (compile_options.bounds_check) && extents[i] < 0)
|
||||
{
|
||||
fprintf (stderr, "CFI_establish: Extents must be nonnegative "
|
||||
"(extents[%d] = %" PRIiPTR ").\n",
|
||||
i, (ptrdiff_t)extents[i]);
|
||||
return CFI_INVALID_EXTENT;
|
||||
}
|
||||
dv->dim[i].lower_bound = 0;
|
||||
dv->dim[i].extent = extents[i];
|
||||
if (i == 0)
|
||||
|
@ -455,16 +484,16 @@ int CFI_is_contiguous (const CFI_cdesc_t *dv)
|
|||
/* Base address must not be NULL. */
|
||||
if (dv->base_addr == NULL)
|
||||
{
|
||||
fprintf (stderr, "CFI_is_contiguous: Base address of C Descriptor "
|
||||
fprintf (stderr, "CFI_is_contiguous: Base address of C descriptor "
|
||||
"is already NULL.\n");
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Must be an array. */
|
||||
if (dv->rank == 0)
|
||||
if (dv->rank <= 0)
|
||||
{
|
||||
fprintf (stderr, "CFI_is_contiguous: C Descriptor must describe an "
|
||||
"array (0 < dv->rank = %d).\n", dv->rank);
|
||||
fprintf (stderr, "CFI_is_contiguous: C descriptor must describe "
|
||||
"an array.\n");
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
@ -473,8 +502,8 @@ int CFI_is_contiguous (const CFI_cdesc_t *dv)
|
|||
if (dv->rank > 0 && dv->dim[dv->rank - 1].extent == -1)
|
||||
return 1;
|
||||
|
||||
/* If an array is not contiguous the memory stride is different to the element
|
||||
* length. */
|
||||
/* If an array is not contiguous the memory stride is different to
|
||||
the element length. */
|
||||
for (int i = 0; i < dv->rank; i++)
|
||||
{
|
||||
if (i == 0 && dv->dim[i].sm == (CFI_index_t)dv->elem_len)
|
||||
|
@ -501,14 +530,13 @@ int CFI_section (CFI_cdesc_t *result, const CFI_cdesc_t *source,
|
|||
CFI_index_t upper[CFI_MAX_RANK];
|
||||
CFI_index_t stride[CFI_MAX_RANK];
|
||||
int zero_count = 0;
|
||||
bool assumed_size;
|
||||
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
{
|
||||
/* C Descriptors must not be NULL. */
|
||||
/* C descriptors must not be NULL. */
|
||||
if (source == NULL)
|
||||
{
|
||||
fprintf (stderr, "CFI_section: Source must not be NULL.\n");
|
||||
fprintf (stderr, "CFI_section: Source must not be NULL.\n");
|
||||
return CFI_INVALID_DESCRIPTOR;
|
||||
}
|
||||
|
||||
|
@ -538,8 +566,7 @@ int CFI_section (CFI_cdesc_t *result, const CFI_cdesc_t *source,
|
|||
allocated allocatable array or an associated pointer array). */
|
||||
if (source->rank <= 0)
|
||||
{
|
||||
fprintf (stderr, "CFI_section: Source must describe an array "
|
||||
"(0 < source->rank, 0 !< %d).\n", source->rank);
|
||||
fprintf (stderr, "CFI_section: Source must describe an array.\n");
|
||||
return CFI_INVALID_RANK;
|
||||
}
|
||||
|
||||
|
@ -547,9 +574,9 @@ int CFI_section (CFI_cdesc_t *result, const CFI_cdesc_t *source,
|
|||
if (result->elem_len != source->elem_len)
|
||||
{
|
||||
fprintf (stderr, "CFI_section: The element lengths of "
|
||||
"source (source->elem_len = %d) and result "
|
||||
"(result->elem_len = %d) must be equal.\n",
|
||||
(int)source->elem_len, (int)result->elem_len);
|
||||
"source (source->elem_len = %" PRIiPTR ") and result "
|
||||
"(result->elem_len = %" PRIiPTR ") must be equal.\n",
|
||||
(ptrdiff_t)source->elem_len, (ptrdiff_t)result->elem_len);
|
||||
return CFI_INVALID_ELEM_LEN;
|
||||
}
|
||||
|
||||
|
@ -601,7 +628,7 @@ int CFI_section (CFI_cdesc_t *result, const CFI_cdesc_t *source,
|
|||
if (unlikely (compile_options.bounds_check)
|
||||
&& source->dim[source->rank - 1].extent == -1)
|
||||
{
|
||||
fprintf (stderr, "CFI_section: Source must not be an assumed size "
|
||||
fprintf (stderr, "CFI_section: Source must not be an assumed-size "
|
||||
"array if upper_bounds is NULL.\n");
|
||||
return CFI_INVALID_EXTENT;
|
||||
}
|
||||
|
@ -630,64 +657,70 @@ int CFI_section (CFI_cdesc_t *result, const CFI_cdesc_t *source,
|
|||
if (unlikely (compile_options.bounds_check)
|
||||
&& stride[i] == 0 && lower[i] != upper[i])
|
||||
{
|
||||
fprintf (stderr, "CFI_section: If strides[%d] = 0, then the "
|
||||
"lower bounds, lower_bounds[%d] = %d, and "
|
||||
"upper_bounds[%d] = %d, must be equal.\n",
|
||||
i, i, (int)lower_bounds[i], i, (int)upper_bounds[i]);
|
||||
fprintf (stderr, "CFI_section: If strides[%d] = 0, then "
|
||||
"lower_bounds[%d] = %" PRIiPTR " and "
|
||||
"upper_bounds[%d] = %" PRIiPTR " must be equal.\n",
|
||||
i, i, (ptrdiff_t)lower_bounds[i], i,
|
||||
(ptrdiff_t)upper_bounds[i]);
|
||||
return CFI_ERROR_OUT_OF_BOUNDS;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* Check that section upper and lower bounds are within the array bounds. */
|
||||
for (int i = 0; i < source->rank; i++)
|
||||
{
|
||||
assumed_size = (i == source->rank - 1)
|
||||
&& (source->dim[i].extent == -1);
|
||||
if (unlikely (compile_options.bounds_check)
|
||||
&& lower_bounds != NULL
|
||||
&& (lower[i] < source->dim[i].lower_bound ||
|
||||
(!assumed_size && lower[i] > source->dim[i].lower_bound
|
||||
+ source->dim[i].extent - 1)))
|
||||
{
|
||||
fprintf (stderr, "CFI_section: Lower bounds must be within the "
|
||||
"bounds of the fortran array (source->dim[%d].lower_bound "
|
||||
"<= lower_bounds[%d] <= source->dim[%d].lower_bound "
|
||||
"+ source->dim[%d].extent - 1, %d <= %d <= %d).\n",
|
||||
i, i, i, i, (int)source->dim[i].lower_bound, (int)lower[i],
|
||||
(int)(source->dim[i].lower_bound
|
||||
+ source->dim[i].extent - 1));
|
||||
return CFI_ERROR_OUT_OF_BOUNDS;
|
||||
}
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
for (int i = 0; i < source->rank; i++)
|
||||
{
|
||||
bool assumed_size
|
||||
= (i == source->rank - 1 && source->dim[i].extent == -1);
|
||||
CFI_index_t ub
|
||||
= source->dim[i].lower_bound + source->dim[i].extent - 1;
|
||||
if (lower_bounds != NULL
|
||||
&& (lower[i] < source->dim[i].lower_bound
|
||||
|| (!assumed_size && lower[i] > ub)))
|
||||
{
|
||||
fprintf (stderr, "CFI_section: Lower bounds must be within "
|
||||
"the bounds of the Fortran array "
|
||||
"(source->dim[%d].lower_bound "
|
||||
"<= lower_bounds[%d] <= source->dim[%d].lower_bound "
|
||||
"+ source->dim[%d].extent - 1, "
|
||||
"%" PRIiPTR " <= %" PRIiPTR " <= %" PRIiPTR ").\n",
|
||||
i, i, i, i,
|
||||
(ptrdiff_t)source->dim[i].lower_bound,
|
||||
(ptrdiff_t)lower[i],
|
||||
(ptrdiff_t)ub);
|
||||
return CFI_ERROR_OUT_OF_BOUNDS;
|
||||
}
|
||||
|
||||
if (unlikely (compile_options.bounds_check)
|
||||
&& upper_bounds != NULL
|
||||
&& (upper[i] < source->dim[i].lower_bound
|
||||
|| (!assumed_size
|
||||
&& upper[i] > source->dim[i].lower_bound
|
||||
+ source->dim[i].extent - 1)))
|
||||
{
|
||||
fprintf (stderr, "CFI_section: Upper bounds must be within the "
|
||||
"bounds of the fortran array (source->dim[%d].lower_bound "
|
||||
"<= upper_bounds[%d] <= source->dim[%d].lower_bound + "
|
||||
"source->dim[%d].extent - 1, %d !<= %d !<= %d).\n",
|
||||
i, i, i, i, (int)source->dim[i].lower_bound, (int)upper[i],
|
||||
(int)(source->dim[i].lower_bound
|
||||
+ source->dim[i].extent - 1));
|
||||
return CFI_ERROR_OUT_OF_BOUNDS;
|
||||
}
|
||||
if (upper_bounds != NULL
|
||||
&& (upper[i] < source->dim[i].lower_bound
|
||||
|| (!assumed_size && upper[i] > ub)))
|
||||
{
|
||||
fprintf (stderr, "CFI_section: Upper bounds must be within "
|
||||
"the bounds of the Fortran array "
|
||||
"(source->dim[%d].lower_bound "
|
||||
"<= upper_bounds[%d] <= source->dim[%d].lower_bound "
|
||||
"+ source->dim[%d].extent - 1, "
|
||||
"%" PRIiPTR " !<= %" PRIiPTR " !<= %" PRIiPTR ").\n",
|
||||
i, i, i, i,
|
||||
(ptrdiff_t)source->dim[i].lower_bound,
|
||||
(ptrdiff_t)upper[i],
|
||||
(ptrdiff_t)ub);
|
||||
return CFI_ERROR_OUT_OF_BOUNDS;
|
||||
}
|
||||
|
||||
if (unlikely (compile_options.bounds_check)
|
||||
&& upper[i] < lower[i] && stride[i] >= 0)
|
||||
{
|
||||
fprintf (stderr, "CFI_section: If the upper bound is smaller than "
|
||||
"the lower bound for a given dimension (upper[%d] < "
|
||||
"lower[%d], %d < %d), then he stride for said dimension"
|
||||
"t must be negative (stride[%d] < 0, %d < 0).\n",
|
||||
i, i, (int)upper[i], (int)lower[i], i, (int)stride[i]);
|
||||
return CFI_INVALID_STRIDE;
|
||||
}
|
||||
}
|
||||
if (upper[i] < lower[i] && stride[i] >= 0)
|
||||
{
|
||||
fprintf (stderr, "CFI_section: If the upper bound is smaller than "
|
||||
"the lower bound for a given dimension (upper[%d] < "
|
||||
"lower[%d], %" PRIiPTR " < %" PRIiPTR "), then the "
|
||||
"stride for said dimension must be negative "
|
||||
"(stride[%d] < 0, %" PRIiPTR " < 0).\n",
|
||||
i, i, (ptrdiff_t)upper[i], (ptrdiff_t)lower[i],
|
||||
i, (ptrdiff_t)stride[i]);
|
||||
return CFI_INVALID_STRIDE;
|
||||
}
|
||||
}
|
||||
|
||||
/* Set the base address. We have to compute this first in the case
|
||||
where source == result, before we overwrite the dimension data. */
|
||||
|
@ -714,7 +747,7 @@ int CFI_select_part (CFI_cdesc_t *result, const CFI_cdesc_t *source,
|
|||
{
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
{
|
||||
/* C Descriptors must not be NULL. */
|
||||
/* C descriptors must not be NULL. */
|
||||
if (source == NULL)
|
||||
{
|
||||
fprintf (stderr, "CFI_select_part: Source must not be NULL.\n");
|
||||
|
@ -777,8 +810,9 @@ int CFI_select_part (CFI_cdesc_t *result, const CFI_cdesc_t *source,
|
|||
{
|
||||
fprintf (stderr, "CFI_select_part: Displacement must be within the "
|
||||
"bounds of source (0 <= displacement <= source->elem_len "
|
||||
"- 1, 0 <= %d <= %d).\n", (int)displacement,
|
||||
(int)(source->elem_len - 1));
|
||||
"- 1, 0 <= %" PRIiPTR " <= %" PRIiPTR ").\n",
|
||||
(ptrdiff_t)displacement,
|
||||
(ptrdiff_t)(source->elem_len - 1));
|
||||
return CFI_ERROR_OUT_OF_BOUNDS;
|
||||
}
|
||||
|
||||
|
@ -789,10 +823,12 @@ int CFI_select_part (CFI_cdesc_t *result, const CFI_cdesc_t *source,
|
|||
fprintf (stderr, "CFI_select_part: Displacement plus the element "
|
||||
"length of result must be less than or equal to the "
|
||||
"element length of source (displacement + result->elem_len "
|
||||
"<= source->elem_len, %d + %d = %d <= %d).\n",
|
||||
(int)displacement, (int)result->elem_len,
|
||||
(int)(displacement + result->elem_len),
|
||||
(int)source->elem_len);
|
||||
"<= source->elem_len, "
|
||||
"%" PRIiPTR " + %" PRIiPTR " = %" PRIiPTR " <= %" PRIiPTR
|
||||
").\n",
|
||||
(ptrdiff_t)displacement, (ptrdiff_t)result->elem_len,
|
||||
(ptrdiff_t)(displacement + result->elem_len),
|
||||
(ptrdiff_t)source->elem_len);
|
||||
return CFI_ERROR_OUT_OF_BOUNDS;
|
||||
}
|
||||
}
|
||||
|
@ -832,7 +868,7 @@ int CFI_setpointer (CFI_cdesc_t *result, CFI_cdesc_t *source,
|
|||
}
|
||||
}
|
||||
|
||||
/* If source is NULL, the result is a C Descriptor that describes a
|
||||
/* If source is NULL, the result is a C descriptor that describes a
|
||||
* disassociated pointer. */
|
||||
if (source == NULL)
|
||||
{
|
||||
|
@ -841,40 +877,56 @@ int CFI_setpointer (CFI_cdesc_t *result, CFI_cdesc_t *source,
|
|||
}
|
||||
else
|
||||
{
|
||||
/* Check that element lengths, ranks and types of source and result are
|
||||
* the same. */
|
||||
/* Check that the source is valid and that element lengths, ranks
|
||||
and types of source and result are the same. */
|
||||
if (unlikely (compile_options.bounds_check))
|
||||
{
|
||||
if (source->base_addr == NULL
|
||||
&& source->attribute == CFI_attribute_allocatable)
|
||||
{
|
||||
fprintf (stderr, "CFI_setpointer: The source is an "
|
||||
"allocatable object but is not allocated.\n");
|
||||
return CFI_ERROR_BASE_ADDR_NULL;
|
||||
}
|
||||
if (source->rank > 0
|
||||
&& source->dim[source->rank - 1].extent == -1)
|
||||
{
|
||||
fprintf (stderr, "CFI_setpointer: The source is an "
|
||||
"assumed-size array.\n");
|
||||
return CFI_INVALID_EXTENT;
|
||||
}
|
||||
if (result->elem_len != source->elem_len)
|
||||
{
|
||||
fprintf (stderr, "CFI_setpointer: Element lengths of result "
|
||||
"(result->elem_len = %d) and source (source->elem_len "
|
||||
"= %d) must be the same.\n", (int)result->elem_len,
|
||||
(int)source->elem_len);
|
||||
"(result->elem_len = %" PRIiPTR ") and source "
|
||||
"(source->elem_len = %" PRIiPTR ") "
|
||||
" must be the same.\n",
|
||||
(ptrdiff_t)result->elem_len,
|
||||
(ptrdiff_t)source->elem_len);
|
||||
return CFI_INVALID_ELEM_LEN;
|
||||
}
|
||||
|
||||
if (result->rank != source->rank)
|
||||
{
|
||||
fprintf (stderr, "CFI_setpointer: Ranks of result (result->rank "
|
||||
"= %d) and source (source->rank = %d) must be the same."
|
||||
"\n", result->rank, source->rank);
|
||||
fprintf (stderr, "CFI_setpointer: Ranks of result "
|
||||
"(result->rank = %d) and source (source->rank = %d) "
|
||||
"must be the same.\n", result->rank, source->rank);
|
||||
return CFI_INVALID_RANK;
|
||||
}
|
||||
|
||||
if (result->type != source->type)
|
||||
{
|
||||
fprintf (stderr, "CFI_setpointer: Types of result (result->type"
|
||||
"= %d) and source (source->type = %d) must be the same."
|
||||
"\n", result->type, source->type);
|
||||
fprintf (stderr, "CFI_setpointer: Types of result "
|
||||
"(result->type = %d) and source (source->type = %d) "
|
||||
"must be the same.\n", result->type, source->type);
|
||||
return CFI_INVALID_TYPE;
|
||||
}
|
||||
}
|
||||
|
||||
/* If the source is a disassociated pointer, the result must also describe
|
||||
* a disassociated pointer. */
|
||||
if (source->base_addr == NULL &&
|
||||
source->attribute == CFI_attribute_pointer)
|
||||
/* If the source is a disassociated pointer, the result must also
|
||||
describe a disassociated pointer. */
|
||||
if (source->base_addr == NULL
|
||||
&& source->attribute == CFI_attribute_pointer)
|
||||
result->base_addr = NULL;
|
||||
else
|
||||
result->base_addr = source->base_addr;
|
||||
|
|
Loading…
Add table
Reference in a new issue