From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from esa1.mentor.iphmx.com (esa1.mentor.iphmx.com [68.232.129.153]) by sourceware.org (Postfix) with ESMTPS id BC0CF3864858; Sat, 17 Jul 2021 00:50:00 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org BC0CF3864858 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=codesourcery.com Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=mentor.com IronPort-SDR: Oi/i0laT4AO1nSg8YpkTGBZNGpkiAHp2AW22OzBVxlSjJCUKKKdElL94HsVVFIx57nxY7CHXfx kw1mSmi8OnH/nl0Gf6NcHKW8Q/883RgusCpjyqBzLlZsihLnkw7YBdpWetMOJIEUY/D+BP2VO/ PMQISnZxUniIZ15JkpWRz1SFLntOZEQfaadeyeVG5aroaAkvI8PSe9hAUILuzLzuyEzJ7L/ZmT Jcjjz+GDWOfBU51MaWt2tiyqL2xadmmgvSShy/sYkCz26xVZSBZSQAUkMnL1ZvRpdXztG4KcFp rsMiGhGxZxmoFnwjBeyzfLLe X-IronPort-AV: E=Sophos;i="5.84,246,1620720000"; d="scan'208";a="66068084" Received: from orw-gwy-01-in.mentorg.com ([192.94.38.165]) by esa1.mentor.iphmx.com with ESMTP; 16 Jul 2021 16:50:00 -0800 IronPort-SDR: Px9mZ9KQ7F1LC6P9heYiW2oOhl+r5lrU3clGItAZ9602ZcH+TBWdSjC8TIQXzGlogX7G0MnA6B +/A8XvUJ9QcKumYjekxKSADYmTIjCL1y9CGJrGhdHW3hBzK8QOZmX7QuD7kqVd5o9U2+hdvrEY EAeWeaT5J+F4c6Pyj39rzJJqnhEUp2MNZDrLP+Xm/rMUVewyNxD+afEfF7uwwDQ5sIBpo4i+pX 7MjgyHb6w7F4K98/gEcgacjC9pWVvXC7O0tI6Z0B6CeoUAJigowFWOCMUFMiM0wHfXIt6GFKQm FaA= To: "fortran@gcc.gnu.org" , "gcc-patches@gcc.gnu.org" From: Sandra Loosemore Subject: [PATCH, Fortran] [PR libfortran/101317] Bind(c): Improve error checking in CFI_* functions Message-ID: <8fc3b97c-b122-9c2c-4657-4f98cf82973e@codesourcery.com> Date: Fri, 16 Jul 2021 18:49:52 -0600 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:68.0) Gecko/20100101 Thunderbird/68.10.0 MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="------------A97170DB63ABB43325D943C1" Content-Language: en-US X-ClientProxiedBy: svr-orw-mbx-02.mgc.mentorg.com (147.34.90.202) To svr-orw-mbx-03.mgc.mentorg.com (147.34.90.203) X-Spam-Status: No, score=-9.9 required=5.0 tests=BAYES_00, GIT_PATCH_0, HEADER_FROM_DIFFERENT_DOMAINS, KAM_DMARC_STATUS, SPF_HELO_PASS, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.4 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , X-List-Received-Date: Sat, 17 Jul 2021 00:50:03 -0000 --------------A97170DB63ABB43325D943C1 Content-Type: text/plain; charset="utf-8"; format=flowed Content-Transfer-Encoding: 7bit This patch is for PR101317, one of the bugs uncovered by the TS29113 testsuite. Here I'd observed that CFI_establish, etc was not diagnosing some invalid-argument situations documented in the standard, although it was properly catching others. After fixing those I discovered a couple small mistakes in the test cases and fixed those too. The testsuite fixes can either be committed with this patch or rolled into the TS29113 testsuite, depending on the order in which things are approved/committed. OK? -Sandra --------------A97170DB63ABB43325D943C1 Content-Type: text/x-patch; charset="UTF-8"; name="pr101317.patch" Content-Transfer-Encoding: 7bit Content-Disposition: attachment; filename="pr101317.patch" commit 6cecb3e3625072c7846434df9dcd8db5e6f66432 Author: Sandra Loosemore Date: Thu Jul 15 08:48:45 2021 -0700 [PR libfortran/101317] Bind(c): Improve error checking in CFI_* functions This patch adds additional run-time checking for invalid arguments to CFI_allocate, CFI_establish, CFI_select_part, and CFI_setpointer. It also includes some minor fixes for signed/unsigned confusion in the TS29113 testsuite. 2021-07-16 Sandra Loosemore PR libfortran/101317 libgfortran/ * runtime/ISO_Fortran_binding.c (CFI_allocate): Check elem_len for validity when it's used. (CFI_establish): Likewise. Also check type argument and extents. (CFI_select_part): Check elem_len. (CFI_setpointer): Check that source is not an unallocated allocatable array or an assumed-size array. Minor formatting cleanup. gcc/testsuite/ * gfortran.dg/ts29113/library/establish-errors-c.c (ctest): Correct unsigned argument to CFI_establish. * gfortran.dg/ts29113/library/setpointer-errors-c.c (ctest): Bypass CFI_establish to create an assumed-size array. diff --git a/gcc/testsuite/gfortran.dg/ts29113/library/establish-errors-c.c b/gcc/testsuite/gfortran.dg/ts29113/library/establish-errors-c.c index b55362a..ae02b46 100644 --- a/gcc/testsuite/gfortran.dg/ts29113/library/establish-errors-c.c +++ b/gcc/testsuite/gfortran.dg/ts29113/library/establish-errors-c.c @@ -57,7 +57,7 @@ ctest (void) character type, elem_len shall be greater than zero and equal to the storage size in bytes of an element of the object. */ status = CFI_establish (a, (void *)buf, CFI_attribute_other, - CFI_type_struct, -5, 2, extents); + CFI_type_struct, 0, 2, extents); if (status == CFI_SUCCESS) { fprintf (stderr, diff --git a/gcc/testsuite/gfortran.dg/ts29113/library/setpointer-errors-c.c b/gcc/testsuite/gfortran.dg/ts29113/library/setpointer-errors-c.c index eec96e6..670d360 100644 --- a/gcc/testsuite/gfortran.dg/ts29113/library/setpointer-errors-c.c +++ b/gcc/testsuite/gfortran.dg/ts29113/library/setpointer-errors-c.c @@ -8,7 +8,6 @@ static int a[10][5][3]; static CFI_index_t extents[] = {3, 5, 10}; -static CFI_index_t badextents[] = {3, 5, -1}; /* External entry point. */ extern void ctest (void); @@ -69,9 +68,12 @@ ctest (void) bad ++; } + /* CFI_establish rejects negative extents, so we can't use it to make + an assumed-size array, so hack the descriptor by hand. Yuck. */ check_CFI_status ("CFI_establish", CFI_establish (source, (void *)a, CFI_attribute_other, - CFI_type_int, 0, 3, badextents)); + CFI_type_int, 0, 3, extents)); + source->dim[2].extent = -1; status = CFI_setpointer (result, source, NULL); if (status == CFI_SUCCESS) { diff --git a/libgfortran/runtime/ISO_Fortran_binding.c b/libgfortran/runtime/ISO_Fortran_binding.c index 79bb377..38e1b6e 100644 --- a/libgfortran/runtime/ISO_Fortran_binding.c +++ b/libgfortran/runtime/ISO_Fortran_binding.c @@ -232,7 +232,16 @@ CFI_allocate (CFI_cdesc_t *dv, const CFI_index_t lower_bounds[], /* If the type is a Fortran character type, the descriptor's element length is replaced by the elem_len argument. */ if (dv->type == CFI_type_char || dv->type == CFI_type_ucs4_char) - dv->elem_len = elem_len; + { + if (unlikely (compile_options.bounds_check) && elem_len == 0) + { + fprintf ("CFI_allocate: The supplied elem_len must be " + "greater than zero (elem_len = %d).\n", + (int) elem_len); + return CFI_INVALID_ELEM_LEN; + } + dv->elem_len = elem_len; + } /* Dimension information and calculating the array length. */ size_t arr_len = 1; @@ -342,11 +351,28 @@ 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 ("CFI_establish: The supplied elem_len must be " + "greater than zero (elem_len = %d).\n", + (int) elem_len); + 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. */ @@ -383,6 +409,16 @@ int CFI_establish (CFI_cdesc_t *dv, void *base_addr, CFI_attribute_t attribute, 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] = %d).\n", i, (int)extents[i]); + return CFI_INVALID_EXTENT; + } dv->dim[i].lower_bound = 0; dv->dim[i].extent = extents[i]; if (i == 0) @@ -734,7 +770,16 @@ int CFI_select_part (CFI_cdesc_t *result, const CFI_cdesc_t *source, /* Element length is ignored unless result->type specifies a Fortran character type. */ if (result->type == CFI_type_char || result->type == CFI_type_ucs4_char) - result->elem_len = elem_len; + { + if (unlikely (compile_options.bounds_check) && elem_len == 0) + { + fprintf ("CFI_select_part: The supplied elem_len must be " + "greater than zero (elem_len = %d).\n", + (int) elem_len); + return CFI_INVALID_ELEM_LEN; + } + result->elem_len = elem_len; + } if (unlikely (compile_options.bounds_check)) { @@ -808,10 +853,26 @@ 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->attribute == CFI_attribute_other + && source->rank > 0 + && source->dim[source->rank - 1].extent == -1) + { + fprintf (stderr, "CFI_setpointer: The source is a " + "nonallocatable nonpointer object that 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 " @@ -838,10 +899,10 @@ int CFI_setpointer (CFI_cdesc_t *result, CFI_cdesc_t *source, } } - /* 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; --------------A97170DB63ABB43325D943C1--