From 6ba3079dce89d9b63bf5dbd5e320ea2bf96f196b Mon Sep 17 00:00:00 2001 From: Martin Liska Date: Wed, 17 Mar 2021 16:36:44 +0100 Subject: Come up with startswith function. gcc/ada/ChangeLog: * gcc-interface/utils.c (def_builtin_1): Use startswith function instead of strncmp. gcc/analyzer/ChangeLog: * sm-file.cc (is_file_using_fn_p): Use startswith function instead of strncmp. gcc/ChangeLog: * builtins.c (is_builtin_name): Use startswith function instead of strncmp. * collect2.c (main): Likewise. (has_lto_section): Likewise. (scan_libraries): Likewise. * coverage.c (coverage_checksum_string): Likewise. (coverage_init): Likewise. * dwarf2out.c (is_cxx): Likewise. (gen_compile_unit_die): Likewise. * gcc-ar.c (main): Likewise. * gcc.c (init_spec): Likewise. (read_specs): Likewise. (execute): Likewise. (check_live_switch): Likewise. * genattrtab.c (write_attr_case): Likewise. (IS_ATTR_GROUP): Likewise. * gencfn-macros.c (main): Likewise. * gengtype.c (type_for_name): Likewise. (gen_rtx_next): Likewise. (get_file_langdir): Likewise. (write_local): Likewise. * genmatch.c (get_operator): Likewise. (get_operand_type): Likewise. (expr::gen_transform): Likewise. * genoutput.c (validate_optab_operands): Likewise. * incpath.c (add_sysroot_to_chain): Likewise. * langhooks.c (lang_GNU_C): Likewise. (lang_GNU_CXX): Likewise. (lang_GNU_Fortran): Likewise. (lang_GNU_OBJC): Likewise. * lto-wrapper.c (run_gcc): Likewise. * omp-general.c (omp_max_simt_vf): Likewise. * omp-low.c (omp_runtime_api_call): Likewise. * opts-common.c (parse_options_from_collect_gcc_options): Likewise. * read-rtl-function.c (function_reader::read_rtx_operand_r): Likewise. * real.c (real_from_string): Likewise. * selftest.c (assert_str_startswith): Likewise. * timevar.c (timer::validate_phases): Likewise. * tree.c (get_file_function_name): Likewise. * ubsan.c (ubsan_use_new_style_p): Likewise. * varasm.c (default_function_rodata_section): Likewise. (incorporeal_function_p): Likewise. (default_section_type_flags): Likewise. * system.h (startswith): Define startswith. gcc/c-family/ChangeLog: * c-ada-spec.c (print_destructor): Use startswith function instead of strncmp. (dump_ada_declaration): Likewise. * c-common.c (disable_builtin_function): Likewise. (def_builtin_1): Likewise. * c-format.c (check_tokens): Likewise. (check_plain): Likewise. (convert_format_name_to_system_name): Likewise. gcc/c/ChangeLog: * c-aux-info.c (affix_data_type): Use startswith function instead of strncmp. * c-typeck.c (build_function_call_vec): Likewise. * gimple-parser.c (c_parser_gimple_parse_bb_spec): Likewise. gcc/cp/ChangeLog: * decl.c (duplicate_decls): Use startswith function instead of strncmp. (cxx_builtin_function): Likewise. (omp_declare_variant_finalize_one): Likewise. (grokfndecl): Likewise. * error.c (dump_decl_name): Likewise. * mangle.c (find_decomp_unqualified_name): Likewise. (write_guarded_var_name): Likewise. (decl_tls_wrapper_p): Likewise. * parser.c (cp_parser_simple_type_specifier): Likewise. (cp_parser_tx_qualifier_opt): Likewise. * pt.c (template_parm_object_p): Likewise. (dguide_name_p): Likewise. gcc/d/ChangeLog: * d-builtins.cc (do_build_builtin_fn): Use startswith function instead of strncmp. * dmd/dinterpret.c (evaluateIfBuiltin): Likewise. * dmd/dmangle.c: Likewise. * dmd/hdrgen.c: Likewise. * dmd/identifier.c (Identifier::toHChars2): Likewise. gcc/fortran/ChangeLog: * decl.c (variable_decl): Use startswith function instead of strncmp. (gfc_match_end): Likewise. * gfortran.h (gfc_str_startswith): Likewise. * module.c (load_omp_udrs): Likewise. (read_module): Likewise. * options.c (gfc_handle_runtime_check_option): Likewise. * primary.c (match_arg_list_function): Likewise. * trans-decl.c (gfc_get_symbol_decl): Likewise. * trans-expr.c (gfc_conv_procedure_call): Likewise. * trans-intrinsic.c (gfc_conv_ieee_arithmetic_function): Likewise. gcc/go/ChangeLog: * gofrontend/runtime.cc (Runtime::name_to_code): Use startswith function instead of strncmp. gcc/objc/ChangeLog: * objc-act.c (objc_string_ref_type_p): Use startswith function instead of strncmp. * objc-encoding.c (encode_type): Likewise. * objc-next-runtime-abi-02.c (has_load_impl): Likewise. --- gcc/fortran/decl.c | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'gcc/fortran/decl.c') diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 947e4f8..413c7a7 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -2721,7 +2721,7 @@ variable_decl (int elem) } /* %FILL components may not have initializers. */ - if (gfc_str_startswith (name, "%FILL") && gfc_match_eos () != MATCH_YES) + if (startswith (name, "%FILL") && gfc_match_eos () != MATCH_YES) { gfc_error ("%qs entity cannot have an initializer at %C", "%FILL"); m = MATCH_ERROR; @@ -8221,7 +8221,7 @@ gfc_match_end (gfc_statement *st) { case COMP_ASSOCIATE: case COMP_BLOCK: - if (gfc_str_startswith (block_name, "block@")) + if (startswith (block_name, "block@")) block_name = NULL; break; -- cgit v1.1 From b3d4011ba10275fbd5d6ec5a16d5aaebbdfb5d3c Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Wed, 21 Jul 2021 09:36:48 +0200 Subject: 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. --- gcc/fortran/decl.c | 113 ++++++++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 104 insertions(+), 9 deletions(-) (limited to 'gcc/fortran/decl.c') diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 413c7a7..05081c4 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -1552,20 +1552,115 @@ gfc_verify_c_interop_param (gfc_symbol *sym) } /* Character strings are only C interoperable if they have a - length of 1. */ - if (sym->ts.type == BT_CHARACTER && !sym->attr.dimension) + length of 1. However, as argument they are either iteroperable + when passed as descriptor (which requires len=: or len=*) or + when having a constant length or are always passed by + descriptor. */ + if (sym->ts.type == BT_CHARACTER) { gfc_charlen *cl = sym->ts.u.cl; - if (!cl || !cl->length || cl->length->expr_type != EXPR_CONSTANT - || mpz_cmp_si (cl->length->value.integer, 1) != 0) + + if (sym->attr.allocatable || sym->attr.pointer) { - gfc_error ("Character argument %qs at %L " - "must be length 1 because " - "procedure %qs is BIND(C)", - sym->name, &sym->declared_at, - sym->ns->proc_name->name); + /* F2018, 18.3.6 (6). */ + if (!sym->ts.deferred) + { + if (sym->attr.allocatable) + gfc_error ("Allocatable character dummy argument %qs " + "at %L must have deferred length as " + "procedure %qs is BIND(C)", sym->name, + &sym->declared_at, sym->ns->proc_name->name); + else + gfc_error ("Pointer character dummy argument %qs at %L " + "must have deferred length as procedure %qs " + "is BIND(C)", sym->name, &sym->declared_at, + sym->ns->proc_name->name); + retval = false; + } + else if (!gfc_notify_std (GFC_STD_F2018, + "Deferred-length character dummy " + "argument %qs at %L of procedure " + "%qs with BIND(C) attribute", + sym->name, &sym->declared_at, + sym->ns->proc_name->name)) + retval = false; + else if (!sym->attr.dimension) + { + /* FIXME: Use CFI array descriptor for scalars. */ + gfc_error ("Sorry, deferred-length scalar character dummy " + "argument %qs at %L of procedure %qs with " + "BIND(C) not yet supported", sym->name, + &sym->declared_at, sym->ns->proc_name->name); + retval = false; + } + } + else if (sym->attr.value + && (!cl || !cl->length + || cl->length->expr_type != EXPR_CONSTANT + || mpz_cmp_si (cl->length->value.integer, 1) != 0)) + { + gfc_error ("Character dummy argument %qs at %L must be " + "of length 1 as it has the VALUE attribute", + sym->name, &sym->declared_at); retval = false; } + else if (!cl || !cl->length) + { + /* Assumed length; F2018, 18.3.6 (5)(2). + Uses the CFI array descriptor. */ + if (!gfc_notify_std (GFC_STD_F2018, + "Assumed-length character dummy argument " + "%qs at %L of procedure %qs with BIND(C) " + "attribute", sym->name, &sym->declared_at, + sym->ns->proc_name->name)) + retval = false; + else if (!sym->attr.dimension + || sym->as->type == AS_ASSUMED_SIZE + || sym->as->type == AS_EXPLICIT) + { + /* FIXME: Valid - should use the CFI array descriptor, but + not yet handled for scalars and assumed-/explicit-size + arrays. */ + gfc_error ("Sorry, character dummy argument %qs at %L " + "with assumed length is not yet supported for " + "procedure %qs with BIND(C) attribute", + sym->name, &sym->declared_at, + sym->ns->proc_name->name); + retval = false; + } + } + else if (cl->length->expr_type != EXPR_CONSTANT) + { + /* F2018, 18.3.6, (5), item 4. */ + if (!sym->attr.dimension + || sym->as->type == AS_ASSUMED_SIZE + || sym->as->type == AS_EXPLICIT) + { + gfc_error ("Character dummy argument %qs at %L must be " + "of constant length or assumed length, " + "unless it has assumed shape or assumed rank, " + "as procedure %qs has the BIND(C) attribute", + sym->name, &sym->declared_at, + sym->ns->proc_name->name); + retval = false; + } + else if (!gfc_notify_std (GFC_STD_F2018, + "Character dummy argument %qs at " + "%L with nonconstant length as " + "procedure %qs is BIND(C)", + sym->name, &sym->declared_at, + sym->ns->proc_name->name)) + retval = false; + } + else if (mpz_cmp_si (cl->length->value.integer, 1) != 0 + && !gfc_notify_std (GFC_STD_F2008, + "Character dummy argument %qs at %L " + "with length greater than 1 for " + "procedure %qs with BIND(C) " + "attribute", + sym->name, &sym->declared_at, + sym->ns->proc_name->name)) + retval = false; } /* We have to make sure that any param to a bind(c) routine does -- cgit v1.1 From 943c65c4494145e993af43c821c82000013c6375 Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Fri, 3 Sep 2021 16:28:04 +0200 Subject: Fortran: Fix Bind(C) char-len check, add ptr-contiguous check Add F2018, 18.3.6 (5), pointer + contiguous is not permitted check for dummies in BIND(C) procs. Fix misreading of F2018, 18.3.4/18.3.5 + 18.3.6 (5) regarding character dummies passed as byte stream to a bind(C) dummy arg: Per F2018, 18.3.1 only len=1 is interoperable (since F2003). F2008 added 'constant expression' for vars (F2018, 18.3.4/18.3.5), applicable to dummy args per F2018, C1554. I misread this such that len > 1 is permitted if len is a constant expr. While the latter would work as character len=1 a(10) and len=2 a(5) have the same storage sequence and len is fixed, it is still invalid. Hence, it is now rejected again. gcc/fortran/ChangeLog: * decl.c (gfc_verify_c_interop_param): Reject pointer with CONTIGUOUS attributes as dummy arg. Reject character len > 1 when passed as byte stream. gcc/testsuite/ChangeLog: * gfortran.dg/bind_c_char_6.f90: Update dg-error. * gfortran.dg/bind_c_char_7.f90: Likewise. * gfortran.dg/bind_c_char_8.f90: Likewise. * gfortran.dg/iso_c_binding_char_1.f90: Likewise. * gfortran.dg/pr32599.f03: Likewise. * gfortran.dg/bind_c_char_9.f90: Comment testcase bits which are implementable but not valid F2018. * gfortran.dg/bind_c_contiguous.f90: New test. --- gcc/fortran/decl.c | 39 ++++++++++++++++----------------------- 1 file changed, 16 insertions(+), 23 deletions(-) (limited to 'gcc/fortran/decl.c') diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 05081c4..2e49a67 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -1551,11 +1551,15 @@ gfc_verify_c_interop_param (gfc_symbol *sym) sym->ns->proc_name->name); } + /* Per F2018, 18.3.6 (5), pointer + contiguous is not permitted. */ + if (sym->attr.pointer && sym->attr.contiguous) + gfc_error ("Dummy argument %qs at %L may not be a pointer with " + "CONTIGUOUS attribute as procedure %qs is BIND(C)", + sym->name, &sym->declared_at, sym->ns->proc_name->name); + /* Character strings are only C interoperable if they have a - length of 1. However, as argument they are either iteroperable - when passed as descriptor (which requires len=: or len=*) or - when having a constant length or are always passed by - descriptor. */ + length of 1. However, as an argument they are also iteroperable + when passed as descriptor (which requires len=: or len=*). */ if (sym->ts.type == BT_CHARACTER) { gfc_charlen *cl = sym->ts.u.cl; @@ -1607,7 +1611,8 @@ gfc_verify_c_interop_param (gfc_symbol *sym) else if (!cl || !cl->length) { /* Assumed length; F2018, 18.3.6 (5)(2). - Uses the CFI array descriptor. */ + Uses the CFI array descriptor - also for scalars and + explicit-size/assumed-size arrays. */ if (!gfc_notify_std (GFC_STD_F2018, "Assumed-length character dummy argument " "%qs at %L of procedure %qs with BIND(C) " @@ -1629,7 +1634,8 @@ gfc_verify_c_interop_param (gfc_symbol *sym) retval = false; } } - else if (cl->length->expr_type != EXPR_CONSTANT) + else if (cl->length->expr_type != EXPR_CONSTANT + || mpz_cmp_si (cl->length->value.integer, 1) != 0) { /* F2018, 18.3.6, (5), item 4. */ if (!sym->attr.dimension @@ -1637,30 +1643,17 @@ gfc_verify_c_interop_param (gfc_symbol *sym) || sym->as->type == AS_EXPLICIT) { gfc_error ("Character dummy argument %qs at %L must be " - "of constant length or assumed length, " + "of constant length of one or assumed length, " "unless it has assumed shape or assumed rank, " "as procedure %qs has the BIND(C) attribute", sym->name, &sym->declared_at, sym->ns->proc_name->name); retval = false; } - else if (!gfc_notify_std (GFC_STD_F2018, - "Character dummy argument %qs at " - "%L with nonconstant length as " - "procedure %qs is BIND(C)", - sym->name, &sym->declared_at, - sym->ns->proc_name->name)) - retval = false; + /* else: valid only since F2018 - and an assumed-shape/rank + array; however, gfc_notify_std is already called when + those array types are used. Thus, silently accept F200x. */ } - else if (mpz_cmp_si (cl->length->value.integer, 1) != 0 - && !gfc_notify_std (GFC_STD_F2008, - "Character dummy argument %qs at %L " - "with length greater than 1 for " - "procedure %qs with BIND(C) " - "attribute", - sym->name, &sym->declared_at, - sym->ns->proc_name->name)) - retval = false; } /* We have to make sure that any param to a bind(c) routine does -- cgit v1.1 From 104c05c5284b7822d770ee51a7d91946c7e56d50 Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Mon, 13 Sep 2021 19:28:10 +0200 Subject: Fortran - ensure simplification of bounds of array-valued named constants gcc/fortran/ChangeLog: PR fortran/82314 * decl.c (add_init_expr_to_sym): For proper initialization of array-valued named constants the array bounds need to be simplified before adding the initializer. gcc/testsuite/ChangeLog: PR fortran/82314 * gfortran.dg/pr82314.f90: New test. --- gcc/fortran/decl.c | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) (limited to 'gcc/fortran/decl.c') diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c index 2e49a67..f2e8896 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.c @@ -2169,6 +2169,24 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus) sym->as->type = AS_EXPLICIT; } + /* Ensure that explicit bounds are simplified. */ + if (sym->attr.flavor == FL_PARAMETER && sym->attr.dimension + && sym->as->type == AS_EXPLICIT) + { + for (int dim = 0; dim < sym->as->rank; ++dim) + { + gfc_expr *e; + + e = sym->as->lower[dim]; + if (e->expr_type != EXPR_CONSTANT) + gfc_reduce_init_expr (e); + + e = sym->as->upper[dim]; + if (e->expr_type != EXPR_CONSTANT) + gfc_reduce_init_expr (e); + } + } + /* Need to check if the expression we initialized this to was one of the iso_c_binding named constants. If so, and we're a parameter (constant), let it be iso_c. -- cgit v1.1