diff options
| author | Tobias Burnus <tobias@codesourcery.com> | 2021-07-21 09:36:48 +0200 |
|---|---|---|
| committer | Tobias Burnus <tobias@codesourcery.com> | 2021-07-21 09:36:48 +0200 |
| commit | b3d4011ba10275fbd5d6ec5a16d5aaebbdfb5d3c (patch) | |
| tree | 2375d0a9b7f7eae0d79a2f95934f1a0edfb83b75 /gcc/fortran/trans-expr.c | |
| parent | 957952ce64e067c56e58df5ee36bbb004eecffa1 (diff) | |
| download | gcc-b3d4011ba10275fbd5d6ec5a16d5aaebbdfb5d3c.zip gcc-b3d4011ba10275fbd5d6ec5a16d5aaebbdfb5d3c.tar.gz gcc-b3d4011ba10275fbd5d6ec5a16d5aaebbdfb5d3c.tar.bz2 | |
Fortran: Fix bind(C) character length checks
gcc/fortran/ChangeLog:
* decl.c (gfc_verify_c_interop_param): Update for F2008 + F2018
changes; reject unsupported bits with 'Error: Sorry,'.
* trans-expr.c (gfc_conv_procedure_call): Fix condition to
For using CFI descriptor with characters.
gcc/testsuite/ChangeLog:
* gfortran.dg/iso_c_binding_char_1.f90: Update dg-error.
* gfortran.dg/pr32599.f03: Use -std=-f2003 + update comment.
* gfortran.dg/bind_c_char_10.f90: New test.
* gfortran.dg/bind_c_char_6.f90: New test.
* gfortran.dg/bind_c_char_7.f90: New test.
* gfortran.dg/bind_c_char_8.f90: New test.
* gfortran.dg/bind_c_char_9.f90: New test.
Diffstat (limited to 'gcc/fortran/trans-expr.c')
| -rw-r--r-- | gcc/fortran/trans-expr.c | 18 |
1 files changed, 8 insertions, 10 deletions
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c index 9e0dcde..b18a9ec 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.c @@ -5757,18 +5757,16 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, arg = arg->next, formal = formal ? formal->next : NULL, ++argc) { bool finalized = false; - bool non_unity_length_string = false; + bool assumed_length_string = false; tree derived_array = NULL_TREE; e = arg->expr; fsym = formal ? formal->sym : NULL; parm_kind = MISSING; - if (fsym && fsym->ts.type == BT_CHARACTER && fsym->ts.u.cl - && (!fsym->ts.u.cl->length - || fsym->ts.u.cl->length->expr_type != EXPR_CONSTANT - || mpz_cmp_si (fsym->ts.u.cl->length->value.integer, 1) != 0)) - non_unity_length_string = true; + if (fsym && fsym->ts.type == BT_CHARACTER + && (!fsym->ts.u.cl || !fsym->ts.u.cl->length)) + assumed_length_string = true; /* If the procedure requires an explicit interface, the actual argument is passed according to the corresponding formal @@ -6002,8 +6000,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, else if (sym->attr.is_bind_c && e && (is_CFI_desc (fsym, NULL) - || non_unity_length_string)) - /* Implement F2018, C.12.6.1: paragraph (2). */ + || assumed_length_string)) + /* Implement F2018, 18.3.6, list item (5), bullet point 2. */ gfc_conv_gfc_desc_to_cfi_desc (&parmse, e, fsym); else if (fsym && fsym->attr.value) @@ -6447,8 +6445,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, } if (sym->attr.is_bind_c && e - && (is_CFI_desc (fsym, NULL) || non_unity_length_string)) - /* Implement F2018, C.12.6.1: paragraph (2). */ + && (is_CFI_desc (fsym, NULL) || assumed_length_string)) + /* Implement F2018, 18.3.6, list item (5), bullet point 2. */ gfc_conv_gfc_desc_to_cfi_desc (&parmse, e, fsym); else if (e->expr_type == EXPR_VARIABLE |