From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: by sourceware.org (Postfix, from userid 1498) id 8D7383896C05; Fri, 20 Aug 2021 03:05:54 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 8D7383896C05 Content-Type: text/plain; charset="us-ascii" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit From: Sandra Loosemore To: gcc-cvs@gcc.gnu.org Subject: [gcc/devel/omp/gcc-11] Bind(c): Improve error checking in CFI_* functions X-Act-Checkin: gcc X-Git-Author: Sandra Loosemore X-Git-Refname: refs/heads/devel/omp/gcc-11 X-Git-Oldrev: 5fb197bb665363eb556690fb2d3106c2d0caff69 X-Git-Newrev: 5084c7d199d149cb58a3c41aae4ed9e97ef9ad31 Message-Id: <20210820030554.8D7383896C05@sourceware.org> Date: Fri, 20 Aug 2021 03:05:54 +0000 (GMT) X-BeenThere: gcc-cvs@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-cvs mailing list List-Unsubscribe: , List-Archive: List-Help: List-Subscribe: , X-List-Received-Date: Fri, 20 Aug 2021 03:05:54 -0000 https://gcc.gnu.org/g:5084c7d199d149cb58a3c41aae4ed9e97ef9ad31 commit 5084c7d199d149cb58a3c41aae4ed9e97ef9ad31 Author: Sandra Loosemore Date: Wed Aug 11 18:57:34 2021 -0700 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 PR libfortran/101317 libgfortran/ * runtime/ISO_Fortran_binding.c: Include . (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. (cherry picked from commit e78480ad0983cf75813af5e02d68cdad09e441e9) Diff: --- gcc/testsuite/ChangeLog.omp | 10 + .../gfortran.dg/ISO_Fortran_binding_17.f90 | 8 +- libgfortran/ChangeLog.omp | 20 ++ libgfortran/runtime/ISO_Fortran_binding.c | 284 ++++++++++++--------- 4 files changed, 202 insertions(+), 120 deletions(-) diff --git a/gcc/testsuite/ChangeLog.omp b/gcc/testsuite/ChangeLog.omp index 8188a8e86a6..370513bee99 100644 --- a/gcc/testsuite/ChangeLog.omp +++ b/gcc/testsuite/ChangeLog.omp @@ -1,3 +1,13 @@ +2021-08-11 Sandra Loosemore + + Backported from master: + + 2021-07-24 Sandra Loosemore + + PR libfortran/101317 + * gfortran.dg/ISO_Fortran_binding_17.f90: Fix typo in error + message patterns. + 2021-08-11 Sandra Loosemore Backported from master: diff --git a/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_17.f90 b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_17.f90 index bb309315261..5902334a66a 100644 --- a/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_17.f90 +++ b/gcc/testsuite/gfortran.dg/ISO_Fortran_binding_17.f90 @@ -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)" } diff --git a/libgfortran/ChangeLog.omp b/libgfortran/ChangeLog.omp index cf5fae694c9..2f96fd20c07 100644 --- a/libgfortran/ChangeLog.omp +++ b/libgfortran/ChangeLog.omp @@ -1,3 +1,23 @@ +2021-08-11 Sandra Loosemore + + Backported from master: + + 2021-07-24 Sandra Loosemore + + PR libfortran/101317 + * runtime/ISO_Fortran_binding.c: Include . + (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. + 2021-08-11 Sandra Loosemore Backported from master: diff --git a/libgfortran/runtime/ISO_Fortran_binding.c b/libgfortran/runtime/ISO_Fortran_binding.c index 2830c4575fe..f8b3ecd0046 100644 --- a/libgfortran/runtime/ISO_Fortran_binding.c +++ b/libgfortran/runtime/ISO_Fortran_binding.c @@ -29,6 +29,7 @@ see the files COPYING3 and COPYING.RUNTIME respectively. If not, see #include "libgfortran.h" #include "ISO_Fortran_binding.h" #include +#include /* 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) - && 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 (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 (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 (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 (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;