diff options
| author | Ian Lance Taylor <iant@golang.org> | 2022-02-11 15:02:44 -0800 |
|---|---|---|
| committer | Ian Lance Taylor <iant@golang.org> | 2022-02-11 15:02:44 -0800 |
| commit | 9a510fb0970d3d9a4201bce8965cabe67850386b (patch) | |
| tree | 43d7fd2bbfd7ad8c9625a718a5e8718889351994 /gcc/fortran | |
| parent | a6d3012b274f38b20e2a57162106f625746af6c6 (diff) | |
| parent | 8dc2499aa62f768c6395c9754b8cabc1ce25c494 (diff) | |
| download | gcc-9a510fb0970d3d9a4201bce8965cabe67850386b.zip gcc-9a510fb0970d3d9a4201bce8965cabe67850386b.tar.gz gcc-9a510fb0970d3d9a4201bce8965cabe67850386b.tar.bz2 | |
Merge from trunk revision 8dc2499aa62f768c6395c9754b8cabc1ce25c494
Diffstat (limited to 'gcc/fortran')
| -rw-r--r-- | gcc/fortran/ChangeLog | 2356 | ||||
| -rw-r--r-- | gcc/fortran/ChangeLog-2021 | 2563 | ||||
| -rw-r--r-- | gcc/fortran/Make-lang.in | 6 | ||||
| -rw-r--r-- | gcc/fortran/arith.cc (renamed from gcc/fortran/arith.c) | 38 | ||||
| -rw-r--r-- | gcc/fortran/arith.h | 2 | ||||
| -rw-r--r-- | gcc/fortran/array.cc (renamed from gcc/fortran/array.c) | 30 | ||||
| -rw-r--r-- | gcc/fortran/bbt.cc (renamed from gcc/fortran/bbt.c) | 2 | ||||
| -rw-r--r-- | gcc/fortran/check.cc (renamed from gcc/fortran/check.c) | 140 | ||||
| -rw-r--r-- | gcc/fortran/class.cc (renamed from gcc/fortran/class.c) | 29 | ||||
| -rw-r--r-- | gcc/fortran/config-lang.in | 4 | ||||
| -rw-r--r-- | gcc/fortran/constructor.cc (renamed from gcc/fortran/constructor.c) | 22 | ||||
| -rw-r--r-- | gcc/fortran/constructor.h | 12 | ||||
| -rw-r--r-- | gcc/fortran/convert.cc (renamed from gcc/fortran/convert.c) | 2 | ||||
| -rw-r--r-- | gcc/fortran/cpp.cc (renamed from gcc/fortran/cpp.c) | 6 | ||||
| -rw-r--r-- | gcc/fortran/cpp.h | 2 | ||||
| -rw-r--r-- | gcc/fortran/data.cc (renamed from gcc/fortran/data.c) | 10 | ||||
| -rw-r--r-- | gcc/fortran/data.h | 2 | ||||
| -rw-r--r-- | gcc/fortran/decl.cc (renamed from gcc/fortran/decl.c) | 55 | ||||
| -rw-r--r-- | gcc/fortran/dependency.cc (renamed from gcc/fortran/dependency.c) | 4 | ||||
| -rw-r--r-- | gcc/fortran/dependency.h | 2 | ||||
| -rw-r--r-- | gcc/fortran/dump-parse-tree.cc (renamed from gcc/fortran/dump-parse-tree.c) | 35 | ||||
| -rw-r--r-- | gcc/fortran/error.cc (renamed from gcc/fortran/error.c) | 13 | ||||
| -rw-r--r-- | gcc/fortran/expr.cc (renamed from gcc/fortran/expr.c) | 127 | ||||
| -rw-r--r-- | gcc/fortran/f95-lang.cc (renamed from gcc/fortran/f95-lang.c) | 4 | ||||
| -rw-r--r-- | gcc/fortran/frontend-passes.cc (renamed from gcc/fortran/frontend-passes.c) | 30 | ||||
| -rw-r--r-- | gcc/fortran/gfc-diagnostic.def | 2 | ||||
| -rw-r--r-- | gcc/fortran/gfc-internals.texi | 14 | ||||
| -rw-r--r-- | gcc/fortran/gfortran.h | 168 | ||||
| -rw-r--r-- | gcc/fortran/gfortran.texi | 1018 | ||||
| -rw-r--r-- | gcc/fortran/gfortranspec.cc (renamed from gcc/fortran/gfortranspec.c) | 8 | ||||
| -rw-r--r-- | gcc/fortran/interface.cc (renamed from gcc/fortran/interface.c) | 173 | ||||
| -rw-r--r-- | gcc/fortran/intrinsic.cc (renamed from gcc/fortran/intrinsic.c) | 151 | ||||
| -rw-r--r-- | gcc/fortran/intrinsic.h | 9 | ||||
| -rw-r--r-- | gcc/fortran/intrinsic.texi | 245 | ||||
| -rw-r--r-- | gcc/fortran/invoke.texi | 52 | ||||
| -rw-r--r-- | gcc/fortran/io.cc (renamed from gcc/fortran/io.c) | 2 | ||||
| -rw-r--r-- | gcc/fortran/ioparm.def | 2 | ||||
| -rw-r--r-- | gcc/fortran/iresolve.cc (renamed from gcc/fortran/iresolve.c) | 212 | ||||
| -rw-r--r-- | gcc/fortran/iso-c-binding.def | 4 | ||||
| -rw-r--r-- | gcc/fortran/iso-fortran-env.def | 2 | ||||
| -rw-r--r-- | gcc/fortran/lang-specs.h | 6 | ||||
| -rw-r--r-- | gcc/fortran/lang.opt | 23 | ||||
| -rw-r--r-- | gcc/fortran/libgfortran.h | 16 | ||||
| -rw-r--r-- | gcc/fortran/match.cc (renamed from gcc/fortran/match.c) | 78 | ||||
| -rw-r--r-- | gcc/fortran/match.h | 40 | ||||
| -rw-r--r-- | gcc/fortran/matchexp.cc (renamed from gcc/fortran/matchexp.c) | 4 | ||||
| -rw-r--r-- | gcc/fortran/mathbuiltins.def | 4 | ||||
| -rw-r--r-- | gcc/fortran/misc.cc (renamed from gcc/fortran/misc.c) | 4 | ||||
| -rw-r--r-- | gcc/fortran/module.cc (renamed from gcc/fortran/module.c) | 4 | ||||
| -rw-r--r-- | gcc/fortran/openmp.cc (renamed from gcc/fortran/openmp.c) | 817 | ||||
| -rw-r--r-- | gcc/fortran/options.cc (renamed from gcc/fortran/options.c) | 2 | ||||
| -rw-r--r-- | gcc/fortran/parse.cc (renamed from gcc/fortran/parse.c) | 76 | ||||
| -rw-r--r-- | gcc/fortran/parse.h | 2 | ||||
| -rw-r--r-- | gcc/fortran/primary.cc (renamed from gcc/fortran/primary.c) | 18 | ||||
| -rw-r--r-- | gcc/fortran/resolve.cc (renamed from gcc/fortran/resolve.c) | 72 | ||||
| -rw-r--r-- | gcc/fortran/scanner.cc (renamed from gcc/fortran/scanner.c) | 7 | ||||
| -rw-r--r-- | gcc/fortran/scanner.h | 2 | ||||
| -rw-r--r-- | gcc/fortran/simplify.cc (renamed from gcc/fortran/simplify.c) | 51 | ||||
| -rw-r--r-- | gcc/fortran/st.cc (renamed from gcc/fortran/st.c) | 2 | ||||
| -rw-r--r-- | gcc/fortran/symbol.cc (renamed from gcc/fortran/symbol.c) | 46 | ||||
| -rw-r--r-- | gcc/fortran/target-memory.cc (renamed from gcc/fortran/target-memory.c) | 14 | ||||
| -rw-r--r-- | gcc/fortran/target-memory.h | 4 | ||||
| -rw-r--r-- | gcc/fortran/trans-array.cc (renamed from gcc/fortran/trans-array.c) | 175 | ||||
| -rw-r--r-- | gcc/fortran/trans-array.h | 13 | ||||
| -rw-r--r-- | gcc/fortran/trans-common.cc (renamed from gcc/fortran/trans-common.c) | 11 | ||||
| -rw-r--r-- | gcc/fortran/trans-const.cc (renamed from gcc/fortran/trans-const.c) | 4 | ||||
| -rw-r--r-- | gcc/fortran/trans-const.h | 2 | ||||
| -rw-r--r-- | gcc/fortran/trans-decl.cc (renamed from gcc/fortran/trans-decl.c) | 68 | ||||
| -rw-r--r-- | gcc/fortran/trans-expr.cc (renamed from gcc/fortran/trans-expr.c) | 162 | ||||
| -rw-r--r-- | gcc/fortran/trans-intrinsic.cc (renamed from gcc/fortran/trans-intrinsic.c) | 161 | ||||
| -rw-r--r-- | gcc/fortran/trans-io.cc (renamed from gcc/fortran/trans-io.c) | 35 | ||||
| -rw-r--r-- | gcc/fortran/trans-openmp.cc (renamed from gcc/fortran/trans-openmp.c) | 397 | ||||
| -rw-r--r-- | gcc/fortran/trans-stmt.cc (renamed from gcc/fortran/trans-stmt.c) | 53 | ||||
| -rw-r--r-- | gcc/fortran/trans-stmt.h | 11 | ||||
| -rw-r--r-- | gcc/fortran/trans-types.cc (renamed from gcc/fortran/trans-types.c) | 80 | ||||
| -rw-r--r-- | gcc/fortran/trans-types.h | 8 | ||||
| -rw-r--r-- | gcc/fortran/trans.cc (renamed from gcc/fortran/trans.c) | 7 | ||||
| -rw-r--r-- | gcc/fortran/trans.h | 32 | ||||
| -rw-r--r-- | gcc/fortran/trigd_fe.inc | 2 | ||||
| -rw-r--r-- | gcc/fortran/types.def | 5 |
80 files changed, 5928 insertions, 4148 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 6d0a022..4a1e6c6 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,1879 +1,551 @@ -2021-10-26 Harald Anlauf <anlauf@gmx.de> - - PR fortran/102956 - * symbol.c (gfc_check_conflict): Add conflict check for PDT KIND - and LEN type parameters. - -2021-10-26 Harald Anlauf <anlauf@gmx.de> - - PR fortran/102917 - * decl.c (match_attr_spec): Remove invalid integer kind checks on - KIND and LEN attributes of PDTs. - -2021-10-26 Harald Anlauf <anlauf@gmx.de> - - PR fortran/102816 - * resolve.c (resolve_structure_cons): Reject invalid array spec of - a DT component referenced in a structure constructor. - -2021-10-26 Tobias Burnus <tobias@codesourcery.com> - - PR fortran/102885 - * trans-decl.c (gfc_conv_cfi_to_gfc): Properly handle nonconstant - character lenghts. - -2021-10-25 Andrew MacLeod <amacleod@redhat.com> - - * trans-decl.c (gfc_conv_cfi_to_gfc): Initialize rank to NULL_TREE. - -2021-10-22 Eric Gallager <egallager@gcc.gnu.org> - - PR other/102663 - * Make-lang.in: Allow dvi-formatted documentation - to be installed. - -2021-10-22 Tobias Burnus <tobias@codesourcery.com> - - PR fortran/92621 - * trans-expr.c (gfc_trans_assignment_1): Add STRIP_NOPS. - -2021-10-21 Chung-Lin Tang <cltang@codesourcery.com> - - * decl.c (gfc_match_end): Add COMP_OMP_STRICTLY_STRUCTURED_BLOCK case - together with COMP_BLOCK. - * parse.c (parse_omp_structured_block): Change return type to - 'gfc_statement', add handling for strictly-structured block case, adjust - recursive calls to parse_omp_structured_block. - (parse_executable): Adjust calls to parse_omp_structured_block. - * parse.h (enum gfc_compile_state): Add - COMP_OMP_STRICTLY_STRUCTURED_BLOCK. - * trans-openmp.c (gfc_trans_omp_workshare): Add EXEC_BLOCK case - handling. - -2021-10-21 Sandra Loosemore <sandra@codesourcery.com> - - PR fortran/94070 - * expr.c (gfc_simplify_expr): Handle GFC_ISYM_SHAPE along with - GFC_ISYM_LBOUND and GFC_ISYM_UBOUND. - * trans-array.c (gfc_conv_ss_startstride): Likewise. - (set_loop_bounds): Likewise. - * trans-intrinsic.c (gfc_trans_intrinsic_bound): Extend to - handle SHAPE. Correct logic for zero-size special cases and - detecting assumed-rank arrays associated with an assumed-size - argument. - (gfc_conv_intrinsic_shape): Deleted. - (gfc_conv_intrinsic_function): Handle GFC_ISYM_SHAPE like - GFC_ISYM_LBOUND and GFC_ISYM_UBOUND. - (gfc_add_intrinsic_ss_code): Likewise. - (gfc_walk_intrinsic_bound): Likewise. - -2021-10-20 Chung-Lin Tang <cltang@codesourcery.com> - - * openmp.c (gfc_match_omp_clause_reduction): Add 'openmp_target' default - false parameter. Add 'always,tofrom' map for OMP_LIST_IN_REDUCTION case. - (gfc_match_omp_clauses): Add 'openmp_target' default false parameter, - adjust call to gfc_match_omp_clause_reduction. - (match_omp): Adjust call to gfc_match_omp_clauses - * trans-openmp.c (gfc_trans_omp_taskgroup): Add call to - gfc_match_omp_clause, create and return block. - -2021-10-19 Tobias Burnus <tobias@codesourcery.com> - - * trans-types.c (create_fn_spec): For allocatable/pointer - character(len=:), use 'w' not 'R' as fn spec for the length dummy - argument. - -2021-10-19 Tobias Burnus <tobias@codesourcery.com> - - PR fortran/92482 - * trans-expr.c (gfc_conv_procedure_call): Use TREE_OPERAND not - build_fold_indirect_ref_loc to undo an ADDR_EXPR. - -2021-10-18 Tobias Burnus <tobias@codesourcery.com> - - PR fortran/102086 - PR fortran/92189 - PR fortran/92621 - PR fortran/101308 - PR fortran/101309 - PR fortran/101635 - PR fortran/92482 - * decl.c (gfc_verify_c_interop_param): Remove 'sorry' for - scalar allocatable/pointer and len=*. - * expr.c (is_CFI_desc): Return true for for those. - * gfortran.h (CFI_type_kind_shift, CFI_type_mask, - CFI_type_from_type_kind, CFI_VERSION, CFI_MAX_RANK, - CFI_attribute_pointer, CFI_attribute_allocatable, - CFI_attribute_other, CFI_type_Integer, CFI_type_Logical, - CFI_type_Real, CFI_type_Complex, CFI_type_Character, - CFI_type_ucs4_char, CFI_type_struct, CFI_type_cptr, - CFI_type_cfunptr, CFI_type_other): New #define. - * trans-array.c (CFI_FIELD_BASE_ADDR, CFI_FIELD_ELEM_LEN, - CFI_FIELD_VERSION, CFI_FIELD_RANK, CFI_FIELD_ATTRIBUTE, - CFI_FIELD_TYPE, CFI_FIELD_DIM, CFI_DIM_FIELD_LOWER_BOUND, - CFI_DIM_FIELD_EXTENT, CFI_DIM_FIELD_SM, - gfc_get_cfi_descriptor_field, gfc_get_cfi_desc_base_addr, - gfc_get_cfi_desc_elem_len, gfc_get_cfi_desc_version, - gfc_get_cfi_desc_rank, gfc_get_cfi_desc_type, - gfc_get_cfi_desc_attribute, gfc_get_cfi_dim_item, - gfc_get_cfi_dim_lbound, gfc_get_cfi_dim_extent, gfc_get_cfi_dim_sm): - New define/functions to access the CFI array descriptor. - (gfc_conv_descriptor_type): New function for the GFC descriptor. - (gfc_get_array_span): Handle expr of CFI descriptors and - assumed-type descriptors. - (gfc_trans_array_bounds): Remove 'static'. - (gfc_conv_expr_descriptor): For assumed type, use the dtype of - the actual argument. - (structure_alloc_comps): Remove ' ' inside tabs. - * trans-array.h (gfc_trans_array_bounds, gfc_conv_descriptor_type, - gfc_get_cfi_desc_base_addr, gfc_get_cfi_desc_elem_len, - gfc_get_cfi_desc_version, gfc_get_cfi_desc_rank, - gfc_get_cfi_desc_type, gfc_get_cfi_desc_attribute, - gfc_get_cfi_dim_lbound, gfc_get_cfi_dim_extent, gfc_get_cfi_dim_sm): - New prototypes. - * trans-decl.c (gfor_fndecl_cfi_to_gfc, gfor_fndecl_gfc_to_cfi): - Remove global vars. - (gfc_build_builtin_function_decls): Remove their initialization. - (gfc_get_symbol_decl, create_function_arglist, - gfc_trans_deferred_vars): Update for CFI. - (convert_CFI_desc): Remove and replace by ... - (gfc_conv_cfi_to_gfc): ... this function - (gfc_generate_function_code): Call it; create local GFC var for CFI. - * trans-expr.c (gfc_maybe_dereference_var): Handle CFI. - (gfc_conv_subref_array_arg): Handle the if-noncontigous-only copy in - when the result should be a descriptor. - (gfc_conv_gfc_desc_to_cfi_desc): Completely rewritten. - (gfc_conv_procedure_call): CFI fixes. - * trans-openmp.c (gfc_omp_is_optional_argument, - gfc_omp_check_optional_argument): Handle optional - CFI. - * trans-stmt.c (gfc_trans_select_rank_cases): Cleanup, avoid invalid - code for allocatable/pointer dummies, which cannot be assumed size. - * trans-types.c (gfc_cfi_descriptor_base): New global var. - (gfc_get_dtype_rank_type): Skip rank init for rank < 0. - (gfc_sym_type): Handle CFI dummies. - (gfc_get_function_type): Update call. - (gfc_get_cfi_dim_type, gfc_get_cfi_type): New. - * trans-types.h (gfc_sym_type): Update prototype. - (gfc_get_cfi_type): New prototype. - * trans.c (gfc_trans_runtime_check): Make conditions more consistent - to avoid '<logical> AND_THEN <long int>' in conditions. - * trans.h (gfor_fndecl_cfi_to_gfc, gfor_fndecl_gfc_to_cfi): Remove - global-var declaration. - -2021-10-18 Tobias Burnus <tobias@codesourcery.com> - - PR fortran/102745 - * intrinsic.c (gfc_convert_type_warn): Fix checks by checking CLASS - and do typcheck in correct order for type extension. - * misc.c (gfc_typename): Print proper not internal CLASS type name. - -2021-10-15 Harald Anlauf <anlauf@gmx.de> +2022-02-10 Roger Sayle <roger@nextmovesoftware.com> Tobias Burnus <tobias@codesourcery.com> - PR fortran/102685 - * decl.c (match_clist_expr): Set rank/shape of clist initializer - to match LHS. - * resolve.c (resolve_structure_cons): In a structure constructor, - compare shapes of array components against declared shape. - -2021-10-14 Harald Anlauf <anlauf@gmx.de> - - PR fortran/102717 - * simplify.c (gfc_simplify_reshape): Replace assert by error - message for negative elements in SHAPE array. - -2021-10-14 Harald Anlauf <anlauf@gmx.de> - - PR fortran/102716 - * check.c (gfc_check_shape): Reorder checks so that invalid KIND - arguments can be detected. - -2021-10-14 Kwok Cheung Yeung <kcy@codesourcery.com> - - * gfortran.h (enum gfc_statement): Add ST_OMP_DECLARE_VARIANT. - (enum gfc_omp_trait_property_kind): New. - (struct gfc_omp_trait_property): New. - (gfc_get_omp_trait_property): New macro. - (struct gfc_omp_selector): New. - (gfc_get_omp_selector): New macro. - (struct gfc_omp_set_selector): New. - (gfc_get_omp_set_selector): New macro. - (struct gfc_omp_declare_variant): New. - (gfc_get_omp_declare_variant): New macro. - (struct gfc_namespace): Add omp_declare_variant field. - (gfc_free_omp_declare_variant_list): New prototype. - * match.h (gfc_match_omp_declare_variant): New prototype. - * openmp.c (gfc_free_omp_trait_property_list): New. - (gfc_free_omp_selector_list): New. - (gfc_free_omp_set_selector_list): New. - (gfc_free_omp_declare_variant_list): New. - (gfc_match_omp_clauses): Add extra optional argument. Handle end of - clauses for context selectors. - (omp_construct_selectors, omp_device_selectors, - omp_implementation_selectors, omp_user_selectors): New. - (gfc_match_omp_context_selector): New. - (gfc_match_omp_context_selector_specification): New. - (gfc_match_omp_declare_variant): New. - * parse.c: Include tree-core.h and omp-general.h. - (decode_omp_directive): Handle 'declare variant'. - (case_omp_decl): Include ST_OMP_DECLARE_VARIANT. - (gfc_ascii_statement): Handle ST_OMP_DECLARE_VARIANT. - (gfc_parse_file): Initialize omp_requires_mask. - * symbol.c (gfc_free_namespace): Call - gfc_free_omp_declare_variant_list. - * trans-decl.c (gfc_get_extern_function_decl): Call - gfc_trans_omp_declare_variant. - (gfc_create_function_decl): Call gfc_trans_omp_declare_variant. - * trans-openmp.c (gfc_trans_omp_declare_variant): New. - * trans-stmt.h (gfc_trans_omp_declare_variant): New prototype. - -2021-10-13 Tobias Burnus <tobias@codesourcery.com> - - * dump-parse-tree.c (show_omp_clauses): Handle ancestor modifier, - avoid ICE for GFC_OMP_ATOMIC_SWAP. - * gfortran.h (gfc_omp_clauses): Change 'anecestor' into a bitfield. - -2021-10-12 Tobias Burnus <tobias@codesourcery.com> - - PR fortran/102541 - * check.c (gfc_check_present): Handle optional CLASS. - * interface.c (gfc_compare_actual_formal): Likewise. - * trans-array.c (gfc_trans_g77_array): Likewise. - * trans-decl.c (gfc_build_dummy_array_decl): Likewise. - * trans-types.c (gfc_sym_type): Likewise. - * primary.c (gfc_variable_attr): Fixes for dummy and - pointer when 'class%_data' is passed. - * trans-expr.c (set_dtype_for_unallocated, gfc_conv_procedure_call): - For assumed-rank dummy, fix setting rank for dealloc/notassoc actual - and setting ubound to -1 for assumed-size actuals. - -2021-10-10 Harald Anlauf <anlauf@gmx.de> - - PR fortran/99348 - PR fortran/102521 - * decl.c (add_init_expr_to_sym): Extend initialization of - parameter arrays from scalars to handle derived types. - -2021-10-09 Harald Anlauf <anlauf@gmx.de> - - PR fortran/65454 - * module.c (read_module): Handle old and new-style relational - operators when used in USE module, ONLY: OPERATOR(op). - -2021-10-08 Sandra Loosemore <sandra@codesourcery.com> - - PR fortran/54753 - * interface.c (gfc_compare_actual_formal): Add diagnostic - for F2018:C839. Refactor shared code and fix bugs with class - array info lookup, and extend similar diagnostic from PR94110 - to also cover class types. - -2021-10-08 Martin Liska <mliska@suse.cz> - - * options.c (gfc_post_options): Use new macro - OPTION_SET_P. - -2021-10-06 Tobias Burnus <tobias@codesourcery.com> - - * resolve.c (resolve_values): Only show - deprecated warning if attr.referenced. - -2021-10-04 Tobias Burnus <tobias@codesourcery.com> - - PR fortran/54753 - * resolve.c (can_generate_init, resolve_fl_variable_derived, - resolve_symbol): Only do initialization with intent(out) if not - inside of an interface block. - -2021-10-01 Martin Sebor <msebor@redhat.com> - - PR c/102103 - * array.c: Remove an unnecessary test. - * trans-array.c: Same. - -2021-10-01 Jakub Jelinek <jakub@redhat.com> - - * gfortran.h (gfc_omp_clauses): Add order_reproducible bitfield. - * dump-parse-tree.c (show_omp_clauses): Print REPRODUCIBLE: for it. - * openmp.c (gfc_match_omp_clauses): Set order_reproducible for - explicit reproducible: modifier. - * trans-openmp.c (gfc_trans_omp_clauses): Set - OMP_CLAUSE_ORDER_REPRODUCIBLE for order_reproducible. - (gfc_split_omp_clauses): Also copy order_reproducible. - -2021-09-30 Harald Anlauf <anlauf@gmx.de> - - PR fortran/102458 - * simplify.c (simplify_size): Resolve expressions used in array - specifications so that SIZE can be simplified. - -2021-09-30 Harald Anlauf <anlauf@gmx.de> - - * expr.c: The correct reference to Fortran standard is: F2018:10.1.12. - -2021-09-30 Tobias Burnus <tobias@codesourcery.com> - - PR fortran/71703 - PR fortran/84007 - * trans-intrinsic.c (gfc_conv_same_type_as): Fix handling - of UNLIMITED_POLY. - * trans.h (gfc_vtpr_hash_get): Renamed prototype to ... - (gfc_vptr_hash_get): ... this to match function name. - -2021-09-29 Harald Anlauf <anlauf@gmx.de> - - PR fortran/102520 - * array.c (expand_constructor): Do not dereference NULL pointer. - -2021-09-27 Tobias Burnus <tobias@codesourcery.com> - - PR fortran/94070 - * trans-array.c (gfc_tree_array_size): New function to - find size inline (whole array or one dimension). - (array_parameter_size): Use it, take stmt_block as arg. - (gfc_conv_array_parameter): Update call. - * trans-array.h (gfc_tree_array_size): Add prototype. - * trans-decl.c (gfor_fndecl_size0, gfor_fndecl_size1): Remove - these global vars. - (gfc_build_intrinsic_function_decls): Remove their initialization. - * trans-expr.c (gfc_conv_procedure_call): Update - bounds of pointer/allocatable actual args to nonallocatable/nonpointer - dummies to be one based. - * trans-intrinsic.c (gfc_conv_intrinsic_shape): Fix case for - assumed rank with allocatable/pointer dummy. - (gfc_conv_intrinsic_size): Update to use inline function. - * trans.h (gfor_fndecl_size0, gfor_fndecl_size1): Remove var decl. - -2021-09-26 Tobias Burnus <tobias@codesourcery.com> - - PR fortran/101334 - * trans-intrinsic.c (gfc_conv_associated): Support assumed-rank - 'pointer' with scalar/array 'target' argument. - -2021-09-24 Harald Anlauf <anlauf@gmx.de> - - PR fortran/102458 - * expr.c (is_non_constant_intrinsic): Check for intrinsics - excluded in constant expressions (F2018:10.1.2). - (gfc_is_constant_expr): Use that check. - -2021-09-24 Sandra Loosemore <sandra@codesourcery.com> - - PR fortran/101333 - * interface.c (compare_parameter): Enforce F2018 C711. - -2021-09-24 Tobias Burnus <tobias@codesourcery.com> - - PR fortran/55534 - * scanner.c (load_file): Return void, call (gfc_)fatal_error for - all errors. - (include_line, include_stmt, gfc_new_file): Remove exit call - for failed load_file run. - -2021-09-23 Sandra Loosemore <sandra@codesourcery.com> - - PR fortran/101320 - * decl.c (gfc_verify_c_interop_param): Handle F2018 C1557, - aka TS29113 C516. - -2021-09-23 Harald Anlauf <anlauf@gmx.de> - Tobias Burnus <tobias@codesourcery.com> - - PR fortran/93834 - * trans-intrinsic.c (gfc_conv_allocated): Cleanup. Handle - coindexed scalar coarrays. - -2021-09-23 Sandra Loosemore <sandra@codesourcery.com> - - PR fortran/101319 - * interface.c (gfc_compare_actual_formal): Extend existing - assumed-type diagnostic to also check for argument with type - parameters. - -2021-09-23 Sandra Loosemore <sandra@codesourcery.com> - - PR fortran/101334 - * check.c (gfc_check_associated): Allow an assumed-rank - array for the pointer argument. - * interface.c (compare_parameter): Also give rank mismatch - error on assumed-rank array. - -2021-09-23 Sandra Loosemore <sandra@codesourcery.com> - - * trans-stmt.c (trans_associate_var): Check that result of - GFC_DECL_SAVED_DESCRIPTOR is not null before using it. - -2021-09-22 Tobias Burnus <tobias@codesourcery.com> - - PR fortran/55534 - * cpp.c (gfc_cpp_register_include_paths, gfc_cpp_post_options): - Add new bool verbose_missing_dir_warn argument. - * cpp.h (gfc_cpp_post_options): Update prototype. - * f95-lang.c (gfc_init): Remove duplicated file-not found diag. - * gfortran.h (gfc_check_include_dirs): Takes bool - verbose_missing_dir_warn arg. - (gfc_new_file): Returns now void. - * options.c (gfc_post_options): Update to warn for -I and -J, - only, by default but for all when user requested. - * scanner.c (gfc_do_check_include_dir): - (gfc_do_check_include_dirs, gfc_check_include_dirs): Take bool - verbose warn arg and update to avoid printing the same message - twice or never. - (load_file): Fix indent. - (gfc_new_file): Return void and exit when load_file failed - as all other load_file users do. - -2021-09-22 Tobias Burnus <tobias@codesourcery.com> - - * trans-expr.c (gfc_simple_for_loop): New. - * trans.h (gfc_simple_for_loop): New prototype. - -2021-09-21 Tobias Burnus <tobias@codesourcery.com> - - PR fortran/55534 - * cpp.c: Define GCC_C_COMMON_C for #include "options.h" to make - cpp_reason_option_codes available. - (gfc_cpp_register_include_paths): Make static, set pfile's - warn_missing_include_dirs and move before caller. - (gfc_cpp_init_cb): New, cb code moved from ... - (gfc_cpp_init_0): ... here. - (gfc_cpp_post_options): Call gfc_cpp_init_cb. - (cb_cpp_diagnostic_cpp_option): New. As implemented in c-family - to match CppReason flags to -W... names. - (cb_cpp_diagnostic): Use it to replace single special case. - * cpp.h (gfc_cpp_register_include_paths): Remove as now static. - * gfortran.h (gfc_check_include_dirs): New prototype. - (gfc_add_include_path): Add new bool arg. - * options.c (gfc_init_options): Don't set -Wmissing-include-dirs. - (gfc_post_options): Set it here after commandline processing. Call - gfc_add_include_path with defer_warn=false. - (gfc_handle_option): Call it with defer_warn=true. - * scanner.c (gfc_do_check_include_dir, gfc_do_check_include_dirs, - gfc_check_include_dirs): New. Diagnostic moved from ... - (add_path_to_list): ... here, which came before cmdline processing. - Take additional bool defer_warn argument. - (gfc_add_include_path): Take additional defer_warn arg. - * scanner.h (struct gfc_directorylist): Reorder for alignment issues, - add new 'bool warn'. - -2021-09-20 Tobias Burnus <tobias@codesourcery.com> - - * gfortran.h (gfc_omp_clauses): Add order_unconstrained. - * dump-parse-tree.c (show_omp_clauses): Dump it. - * openmp.c (gfc_match_omp_clauses): Match unconstrained/reproducible - modifiers to ordered(concurrent). - (OMP_DISTRIBUTE_CLAUSES): Accept ordered clause. - (resolve_omp_clauses): Reject ordered + order on same directive. - * trans-openmp.c (gfc_trans_omp_clauses, gfc_split_omp_clauses): Pass - on unconstrained modifier of ordered(concurrent). - -2021-09-17 Harald Anlauf <anlauf@gmx.de> - - PR fortran/102366 - * trans-decl.c (gfc_finish_var_decl): Disable the warning message - for variables moved from stack to static storange if they are - declared in the main, but allow the move to happen. - -2021-09-17 Sandra Loosemore <sandra@codesourcery.com> - - * intrinsic.texi (ISO_C_BINDING): Change C_FLOAT128 to correspond - to _Float128 rather than __float128. - * iso-c-binding.def (c_float128): Update comments. - * trans-intrinsic.c (gfc_builtin_decl_for_float_kind): Likewise. - (build_round_expr): Likewise. - (gfc_build_intrinsic_lib_fndcecls): Likewise. - * trans-types.h (gfc_real16_is_float128): Likewise. - -2021-09-16 Harald Anlauf <anlauf@gmx.de> - - PR fortran/102287 - * trans-expr.c (gfc_conv_procedure_call): Wrap deallocation of - allocatable components of optional allocatable derived type - procedure arguments with INTENT(OUT) into a presence check. - -2021-09-14 Harald Anlauf <anlauf@gmx.de> - - PR fortran/102311 - * resolve.c (resolve_entries): Attempt to recover cleanly after - rejecting mismatched function entries. - -2021-09-14 Tobias Burnus <tobias@codesourcery.com> - - PR fortran/102313 - * parse.c (gfc_ascii_statement): Add missing ST_OMP_END_SCOPE. - -2021-09-13 Harald Anlauf <anlauf@gmx.de> - - 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. - -2021-09-13 Harald Anlauf <anlauf@gmx.de> - - PR fortran/85130 - * expr.c (find_substring_ref): Handle given substring start and - end indices as signed integers, not unsigned. - -2021-09-09 Harald Anlauf <anlauf@gmx.de> - - PR fortran/98490 - * trans-expr.c (gfc_conv_substring): Do not generate substring - bounds check for implied do loop index variable before it actually - becomes defined. - -2021-09-08 liuhongt <hongtao.liu@intel.com> - - * options.c (gfc_post_options): Issue an error for - -fexcess-precision=16. - -2021-09-07 Harald Anlauf <anlauf@gmx.de> - - PR fortran/101327 - * expr.c (find_array_element): When bounds cannot be determined as - constant, return error instead of aborting. - -2021-09-07 Marcel Vollweiler <marcel@codesourcery.com> - - * openmp.c (gfc_match_omp_flush): Parse 'seq_cst' clause on 'flush' - directive. - * trans-openmp.c (gfc_trans_omp_flush): Handle OMP_MEMORDER_SEQ_CST. - -2021-09-03 Tobias Burnus <tobias@codesourcery.com> - - * decl.c (gfc_verify_c_interop_param): Reject pointer with - CONTIGUOUS attributes as dummy arg. Reject character len > 1 - when passed as byte stream. - -2021-09-01 Harald Anlauf <anlauf@gmx.de> - - PR fortran/56985 - * resolve.c (resolve_common_vars): Fix grammar and improve wording - of error message rejecting an unlimited polymorphic in COMMON. - -2021-08-31 Harald Anlauf <anlauf@gmx.de> - - PR fortran/100950 - * simplify.c (substring_has_constant_len): Minimize checks for - substring expressions being allowed. - -2021-08-31 Marcel Vollweiler <marcel@codesourcery.com> + * trans-common.cc (GFC_EQUIV_FMT): New macro respecting the + target's NO_DOT_IN_LABEL and NO_DOLLAR_IN_LABEL preferences. + (build_equiv_decl): Use GFC_EQUIV_FMT here. - * gfortran.h: Add variable for 'ancestor' in struct gfc_omp_clauses. - * openmp.c (gfc_match_omp_clauses): Parse device-modifiers 'device_num' - and 'ancestor' in 'target device' clauses. - * trans-openmp.c (gfc_trans_omp_clauses): Set OMP_CLAUSE_DEVICE_ANCESTOR. +2022-02-10 Tobias Burnus <tobias@codesourcery.com> -2021-08-30 Harald Anlauf <anlauf@gmx.de> + PR fortran/104329 + * openmp.cc (resolve_omp_atomic): Defer extra-code assert after + other diagnostics. - PR fortran/102113 - * match.c (gfc_match_goto): Allow for whitespace in parsing list - of labels. +2022-02-10 Marcel Vollweiler <marcel@codesourcery.com> -2021-08-30 Harald Anlauf <anlauf@gmx.de> + * dump-parse-tree.cc (show_omp_clauses): Added OMP_LIST_HAS_DEVICE_ADDR + case. + * gfortran.h: Added OMP_LIST_HAS_DEVICE_ADDR. + * openmp.cc (enum omp_mask2): Added OMP_CLAUSE_HAS_DEVICE_ADDR. + (gfc_match_omp_clauses): Parse HAS_DEVICE_ADDR clause. + (resolve_omp_clauses): Same. + * trans-openmp.cc (gfc_trans_omp_variable_list): Added + OMP_LIST_HAS_DEVICE_ADDR case. + (gfc_trans_omp_clauses): Firstprivatize of array descriptors. - PR fortran/101349 - * resolve.c (resolve_allocate_expr): An unlimited polymorphic - argument to ALLOCATE must be ALLOCATABLE or a POINTER. Fix the - corresponding check. +2022-02-09 Harald Anlauf <anlauf@gmx.de> -2021-08-28 Harald Anlauf <anlauf@gmx.de> + PR fortran/66193 + * arith.cc (reduce_binary_ac): When reducing binary expressions, + try simplification. Handle case of empty constructor. + (reduce_binary_ca): Likewise. - PR fortran/87737 - * resolve.c (resolve_entries): For functions of type CHARACTER - tighten the checks for matching characteristics. +2022-02-03 Harald Anlauf <anlauf@gmx.de> -2021-08-25 Lewis Hyatt <lhyatt@gmail.com> + PR fortran/104311 + * check.cc (gfc_calculate_transfer_sizes): Checks for case when + storage size of SOURCE is greater than zero while the storage size + of MOLD is zero and MOLD is an array shall not depend on SIZE. - PR other/93067 - * cpp.c (gfc_cpp_post_options): Call new function - diagnostic_initialize_input_context(). +2022-02-03 Jakub Jelinek <jakub@redhat.com> -2021-08-24 Harald Anlauf <anlauf@gmx.de> + PR fortran/104328 + * openmp.cc (is_scalar_intrinsic_expr): If must_be_var && conv_ok + and expr is conversion, verify it is a conversion from EXPR_VARIABLE + with non-NULL symtree. Check ->block->next before dereferencing it. - PR fortran/98411 - * trans-decl.c (gfc_finish_var_decl): Adjust check to handle - implicit SAVE as well as variables in the main program. Improve - warning message text. +2022-02-01 Harald Anlauf <anlauf@gmx.de> -2021-08-23 Tobias Burnus <tobias@codesourcery.com> + PR fortran/104331 + * simplify.cc (gfc_simplify_eoshift): Avoid NULL pointer + dereference when shape is not set. - * openmp.c (gfc_match_dupl_check, gfc_match_dupl_memorder, - gfc_match_dupl_atomic): New. - (gfc_match_omp_clauses): Use them; remove duplicate - 'release'/'relaxed' clause matching; improve error dignostic - for 'default'. - -2021-08-23 Tobias Burnus <tobias@codesourcery.com> - - * dump-parse-tree.c (show_omp_clauses): Handle 'strict' modifier - on grainsize/num_tasks - * gfortran.h (gfc_omp_clauses): Add grainsize_strict - and num_tasks_strict. - * trans-openmp.c (gfc_trans_omp_clauses, gfc_split_omp_clauses): - Handle 'strict' modifier on grainsize/num_tasks. - * openmp.c (gfc_match_omp_clauses): Likewise. - -2021-08-20 Tobias Burnus <tobias@codesourcery.com> - - * error.c - (error_uinteger): Take 'long long unsigned' instead - of 'long unsigned' as argumpent. - (error_integer): Take 'long long' instead of 'long'. - (error_hwuint, error_hwint): New. - (error_print): Update to handle 'll' and 'w' - length modifiers. - * simplify.c (substring_has_constant_len): Use '%wd' - in gfc_error. - -2021-08-20 Harald Anlauf <anlauf@gmx.de> - - PR fortran/100950 - * simplify.c (substring_has_constant_len): Fix format string of - gfc_error, pass HOST_WIDE_INT bounds values via char buffer. - -2021-08-20 Tobias Burnus <tobias@codesourcery.com> - - * dump-parse-tree.c (show_omp_clauses): Handle 'at', 'severity' - and 'message' clauses. - (show_omp_node, show_code_node): Handle EXEC_OMP_ERROR. - * gfortran.h (gfc_statement): Add ST_OMP_ERROR. - (gfc_omp_severity_type, gfc_omp_at_type): New. - (gfc_omp_clauses): Add 'at', 'severity' and 'message' clause; - use more bitfields + ENUM_BITFIELD. - (gfc_exec_op): Add EXEC_OMP_ERROR. - * match.h (gfc_match_omp_error): New. - * openmp.c (enum omp_mask1): Add OMP_CLAUSE_(AT,SEVERITY,MESSAGE). - (gfc_match_omp_clauses): Handle new clauses. - (OMP_ERROR_CLAUSES, gfc_match_omp_error): New. - (resolve_omp_clauses): Resolve new clauses. - (omp_code_to_statement, gfc_resolve_omp_directive): Handle - EXEC_OMP_ERROR. - * parse.c (decode_omp_directive, next_statement, - gfc_ascii_statement): Handle 'omp error'. - * resolve.c (gfc_resolve_blocks): Likewise. - * st.c (gfc_free_statement): Likewise. - * trans-openmp.c (gfc_trans_omp_error): Likewise. - (gfc_trans_omp_directive): Likewise. - * trans.c (trans_code): Likewise. - -2021-08-20 Jakub Jelinek <jakub@redhat.com> - - * types.def (BT_FN_VOID_CONST_PTR_SIZE): New DEF_FUNCTION_TYPE_2. - * f95-lang.c (ATTR_COLD_NORETURN_NOTHROW_LEAF_LIST): Define. - -2021-08-19 Harald Anlauf <anlauf@gmx.de> - - PR fortran/100950 - * simplify.c (substring_has_constant_len): New. - (gfc_simplify_len): Handle case of substrings with constant - bounds. - -2021-08-18 Tobias Burnus <tobias@codesourcery.com> - - * match.h (gfc_match_omp_nothing): New. - * openmp.c (gfc_match_omp_nothing): New. - * parse.c (decode_omp_directive): Match 'nothing' directive. - -2021-08-17 Tobias Burnus <tobias@codesourcery.com> - - * dump-parse-tree.c (show_omp_node, show_code_node): Handle - EXEC_OMP_SCOPE. - * gfortran.h (enum gfc_statement): Add ST_OMP_(END_)SCOPE. - (enum gfc_exec_op): Add EXEC_OMP_SCOPE. - * match.h (gfc_match_omp_scope): New. - * openmp.c (OMP_SCOPE_CLAUSES): Define - (gfc_match_omp_scope): New. - (gfc_match_omp_cancellation_point, gfc_match_omp_end_nowait): - Improve error diagnostic. - (omp_code_to_statement): Handle ST_OMP_SCOPE. - (gfc_resolve_omp_directive): Handle EXEC_OMP_SCOPE. - * parse.c (decode_omp_directive, next_statement, - gfc_ascii_statement, parse_omp_structured_block, - parse_executable): Handle OpenMP's scope construct. - * resolve.c (gfc_resolve_blocks): Likewise - * st.c (gfc_free_statement): Likewise - * trans-openmp.c (gfc_trans_omp_scope): New. - (gfc_trans_omp_directive): Call it. - * trans.c (trans_code): handle EXEC_OMP_SCOPE. - -2021-08-16 Tobias Burnus <tobias@codesourcery.com> - - * dump-parse-tree.c (show_omp_clauses): Handle 'filter' clause. - (show_omp_node, show_code_node): Handle (combined) omp masked construct. - * frontend-passes.c (gfc_code_walker): Likewise. - * gfortran.h (enum gfc_statement): Add ST_OMP_*_MASKED*. - (enum gfc_exec_op): Add EXEC_OMP_*_MASKED*. - * match.h (gfc_match_omp_masked, gfc_match_omp_masked_taskloop, - gfc_match_omp_masked_taskloop_simd, gfc_match_omp_parallel_masked, - gfc_match_omp_parallel_masked_taskloop, - gfc_match_omp_parallel_masked_taskloop_simd): New prototypes. - * openmp.c (enum omp_mask1): Add OMP_CLAUSE_FILTER. - (gfc_match_omp_clauses): Match it. - (OMP_MASKED_CLAUSES, gfc_match_omp_parallel_masked, - gfc_match_omp_parallel_masked_taskloop, - gfc_match_omp_parallel_masked_taskloop_simd, - gfc_match_omp_masked, gfc_match_omp_masked_taskloop, - gfc_match_omp_masked_taskloop_simd): New. - (resolve_omp_clauses): Resolve filter clause. - (gfc_resolve_omp_parallel_blocks, resolve_omp_do, - omp_code_to_statement, gfc_resolve_omp_directive): Handle - omp masked constructs. - * parse.c (decode_omp_directive, case_exec_markers, - gfc_ascii_statement, parse_omp_do, parse_omp_structured_block, - parse_executable): Likewise. - * resolve.c (gfc_resolve_blocks, gfc_resolve_code): Likewise. - * st.c (gfc_free_statement): Likewise. - * trans-openmp.c (gfc_trans_omp_clauses): Handle filter clause. - (GFC_OMP_SPLIT_MASKED, GFC_OMP_MASK_MASKED): New enum values. - (gfc_trans_omp_masked): New. - (gfc_split_omp_clauses): Handle combined masked directives. - (gfc_trans_omp_master_taskloop): Rename to ... - (gfc_trans_omp_master_masked_taskloop): ... this; handle also - combined masked directives. - (gfc_trans_omp_parallel_master): Rename to ... - (gfc_trans_omp_parallel_master_masked): ... this; handle - combined masked directives. - (gfc_trans_omp_directive): Handle EXEC_OMP_*_MASKED*. - * trans.c (trans_code): Likewise. - -2021-08-15 Harald Anlauf <anlauf@gmx.de> - - PR fortran/99351 - * match.c (sync_statement): Replace %v code by %e in gfc_match to - allow for function references as STAT and ERRMSG arguments. - * resolve.c (resolve_sync): Adjust checks of STAT= and ERRMSG= to - being definable arguments. Function references with a data - pointer result are accepted. - * trans-stmt.c (gfc_trans_sync): Adjust assertion. - -2021-08-12 Tobias Burnus <tobias@codesourcery.com> - - * gfortran.h (gfc_omp_proc_bind_kind): Add OMP_PROC_BIND_PRIMARY. - * dump-parse-tree.c (show_omp_clauses): Add TODO comment to - change 'master' to 'primary' in proc_bind for OpenMP 5.1. - * intrinsic.texi (OMP_LIB): Mention OpenMP 5.1; add - omp_proc_bind_primary. - * openmp.c (gfc_match_omp_clauses): Accept - 'primary' as alias for 'master'. - * trans-openmp.c (gfc_trans_omp_clauses): Handle - OMP_PROC_BIND_PRIMARY. - -2021-08-11 Sandra Loosemore <sandra@codesourcery.com> - - * iso-c-binding.def (c_float128, c_float128_complex): Check - float128_type_node instead of gfc_float128_type_node. - * trans-types.c (gfc_init_kinds, gfc_build_real_type): - Update comments re supported 128-bit floating-point types. - -2021-08-11 Richard Biener <rguenther@suse.de> - - * trans-common.c (create_common): Set TREE_THIS_VOLATILE on the - COMPONENT_REF if the field is volatile. - -2021-08-07 Harald Anlauf <anlauf@gmx.de> - - PR fortran/68568 - * primary.c (gfc_expr_attr): Variable attribute can only be - inquired when symtree is non-NULL. - -2021-07-28 Harald Anlauf <anlauf@gmx.de> - - PR fortran/101564 - * expr.c (gfc_check_vardef_context): Add check for KIND and LEN - parameter inquiries. - * match.c (gfc_match): Fix comment for %v code. - (gfc_match_allocate, gfc_match_deallocate): Replace use of %v code - by %e in gfc_match to allow for function references as STAT and - ERRMSG arguments. - * resolve.c (resolve_allocate_deallocate): Avoid NULL pointer - dereferences and shortcut for bad STAT and ERRMSG argument to - (DE)ALLOCATE. Remove bogus parts of checks for STAT and ERRMSG. - -2021-07-26 José Rui Faustino de Sousa <jrfsousa@gmail.com> - Tobias Burnus <tobias@codesourcery.com> +2022-01-28 Andre Vehreschild <vehre@gcc.gnu.org> - PR fortran/93308 - PR fortran/93963 - PR fortran/94327 - PR fortran/94331 - PR fortran/97046 - * trans-decl.c (convert_CFI_desc): Only copy out the descriptor - if necessary. - * trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): Updated attribute - handling which reflect a previous intermediate version of the - standard. Only copy out the descriptor if necessary. - -2021-07-23 Harald Anlauf <anlauf@gmx.de> - - PR fortran/101536 - * check.c (array_check): Adjust check for the case of CLASS - arrays. - -2021-07-21 Thomas Schwinge <thomas@codesourcery.com> - Joseph Myers <joseph@codesourcery.com> - Cesar Philippidis <cesar@codesourcery.com> - - * dump-parse-tree.c (show_attr): Update. - * gfortran.h (symbol_attribute): Add 'oacc_routine_nohost' member. - (gfc_omp_clauses): Add 'nohost' member. - * module.c (ab_attribute): Add 'AB_OACC_ROUTINE_NOHOST'. - (attr_bits, mio_symbol_attribute): Update. - * openmp.c (omp_mask2): Add 'OMP_CLAUSE_NOHOST'. - (gfc_match_omp_clauses): Handle 'OMP_CLAUSE_NOHOST'. - (OACC_ROUTINE_CLAUSES): Add 'OMP_CLAUSE_NOHOST'. - (gfc_match_oacc_routine): Update. - * trans-decl.c (add_attributes_to_decl): Update. - * trans-openmp.c (gfc_trans_omp_clauses): Likewise. - -2021-07-21 Harald Anlauf <anlauf@gmx.de> - - PR fortran/101514 - * target-memory.c (gfc_interpret_derived): Size of array component - of derived type can only be computed here for explicit shape. - * trans-types.c (gfc_get_nodesc_array_type): Do not dereference - NULL pointers. - -2021-07-21 Tobias Burnus <tobias@codesourcery.com> - - * 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. - -2021-07-18 Harald Anlauf <anlauf@gmx.de> - - PR fortran/101084 - * io.c (resolve_tag_format): Extend FORMAT check to unknown type. - -2021-07-14 Harald Anlauf <anlauf@gmx.de> - - PR fortran/100949 - * trans-expr.c (gfc_trans_class_init_assign): Call - gfc_conv_expr_present only for dummy variables. - -2021-07-06 Thomas Koenig <tkoenig@gcc.gnu.org> - - PR fortran/100227 - * frontend-passes.c (traverse_io_block): Adjust test for - when a variable is eligible for the transformation to - array slice. - -2021-06-28 Martin Sebor <msebor@redhat.com> - - * trans-array.c (trans_array_constructor): Replace direct uses - of TREE_NO_WARNING with warning_suppressed_p, and suppress_warning. - * trans-decl.c (gfc_build_qualified_array): Same. - (gfc_build_dummy_array_decl): Same. - (generate_local_decl): Same. - (gfc_generate_function_code): Same. - * trans-openmp.c (gfc_omp_clause_default_ctor): Same. - (gfc_omp_clause_copy_ctor): Same. - * trans-types.c (get_dtype_type_node): Same. - (gfc_get_desc_dim_type): Same. - (gfc_get_array_descriptor_base): Same. - (gfc_get_caf_vector_type): Same. - (gfc_get_caf_reference_type): Same. - * trans.c (gfc_create_var_np): Same. - -2021-06-23 Tobias Burnus <tobias@codesourcery.com> - - * dump-parse-tree.c (show_omp_clauses): Fix enum type used - for dumping gfc_omp_defaultmap_category. - -2021-06-23 Andre Vehreschild <vehre@gcc.gnu.org> - - PR fortran/100337 - * trans-intrinsic.c (conv_co_collective): Check stat for null ptr - before dereferrencing. - -2021-06-18 Harald Anlauf <anlauf@gmx.de> - - PR fortran/100283 - PR fortran/101123 - * trans-intrinsic.c (gfc_conv_intrinsic_minmax): Unconditionally - convert result of min/max to result type. - -2021-06-16 Harald Anlauf <anlauf@gmx.de> - - PR fortran/95501 - PR fortran/95502 - * expr.c (gfc_check_pointer_assign): Avoid NULL pointer - dereference. - * match.c (gfc_match_pointer_assignment): Likewise. - * parse.c (gfc_check_do_variable): Avoid comparison with NULL - symtree. + PR fortran/103790 + * trans-array.cc (structure_alloc_comps): Prevent descriptor + stacking for non-array data; do not broadcast caf-tokens. + * trans-intrinsic.cc (conv_co_collective): Prevent generation + of unused descriptor. -2021-06-16 Harald Anlauf <anlauf@gmx.de> +2022-01-28 Andre Vehreschild <vehre@gcc.gnu.org> Revert: - 2021-06-16 Harald Anlauf <anlauf@gmx.de> - - PR fortran/95501 - PR fortran/95502 - * expr.c (gfc_check_pointer_assign): Avoid NULL pointer - dereference. - * match.c (gfc_match_pointer_assignment): Likewise. - * parse.c (gfc_check_do_variable): Avoid comparison with NULL - symtree. - -2021-06-16 Harald Anlauf <anlauf@gmx.de> - - PR fortran/95501 - PR fortran/95502 - * expr.c (gfc_check_pointer_assign): Avoid NULL pointer - dereference. - * match.c (gfc_match_pointer_assignment): Likewise. - * parse.c (gfc_check_do_variable): Avoid comparison with NULL - symtree. - -2021-06-15 Tobias Burnus <tobias@codesourcery.com> - - PR fortran/92568 - * dump-parse-tree.c (show_omp_clauses): Update for defaultmap. - * f95-lang.c (LANG_HOOKS_OMP_ALLOCATABLE_P, - LANG_HOOKS_OMP_SCALAR_TARGET_P): New. - * gfortran.h (enum gfc_omp_defaultmap, - enum gfc_omp_defaultmap_category): New. - * openmp.c (gfc_match_omp_clauses): Update defaultmap matching. - * trans-decl.c (gfc_finish_decl_attrs): Set GFC_DECL_SCALAR_TARGET. - * trans-openmp.c (gfc_omp_allocatable_p, gfc_omp_scalar_target_p): New. - (gfc_omp_scalar_p): Take 'ptr_alloc_ok' argument. - (gfc_trans_omp_clauses, gfc_split_omp_clauses): Update for - defaultmap changes. - * trans.h (gfc_omp_scalar_p): Update prototype. - (gfc_omp_allocatable_p, gfc_omp_scalar_target_p): New. - (struct lang_decl): Add scalar_target. - (GFC_DECL_SCALAR_TARGET, GFC_DECL_GET_SCALAR_TARGET): New. - -2021-06-14 Tobias Burnus <tobias@codesourcery.com> - - * resolve.c (resolve_variable): Remove *XCNEW used to - nullify nullified memory. - -2021-06-09 Martin Liska <mliska@suse.cz> - - * intrinsic.texi: Add missing @headitem to tables with a header. - -2021-06-09 Jakub Jelinek <jakub@redhat.com> - - PR fortran/100965 - * trans-openmp.c (gfc_omp_finish_clause): Gimplify OMP_CLAUSE_SIZE. - -2021-06-08 Tobias Burnus <tobias@codesourcery.com> - - PR middle-end/99928 - * trans-openmp.c (gfc_add_clause_implicitly): New. - (gfc_split_omp_clauses): Use it. - (gfc_free_split_omp_clauses): New. - (gfc_trans_omp_do_simd, gfc_trans_omp_parallel_do, - gfc_trans_omp_parallel_do_simd, gfc_trans_omp_distribute, - gfc_trans_omp_teams, gfc_trans_omp_target, gfc_trans_omp_taskloop, - gfc_trans_omp_master_taskloop, gfc_trans_omp_parallel_master): Use it. - -2021-06-08 Martin Liska <mliska@suse.cz> - - * intrinsic.texi: Fix typo. - * trans-expr.c (gfc_trans_pointer_assignment): Likewise. - -2021-06-05 José Rui Faustino de Sousa <jrfsousa@gmail.com> - - PR fortran/100120 - PR fortran/100816 - PR fortran/100818 - PR fortran/100819 - PR fortran/100821 - * trans-array.c (gfc_get_array_span): rework the way character - array "span" was calculated. - (gfc_conv_expr_descriptor): improve handling of character sections - and unlimited polymorphic objects. - * trans-expr.c (gfc_get_character_len): new function to calculate - character string length. - (gfc_get_character_len_in_bytes): new function to calculate - character string length in bytes. - (gfc_conv_scalar_to_descriptor): add call to set the "span". - (gfc_trans_pointer_assignment): set "_len" and antecipate the - initialization of the deferred character length hidden argument. - * trans-intrinsic.c (gfc_conv_associated): set "force_no_tmp" to - avoid the creation of a temporary. - * trans-types.c (gfc_get_dtype_rank_type): rework type detection - so that unlimited polymorphic objects get proper type infomation, - also important for bind(c). - (gfc_get_dtype): add argument to pass the rank if necessary. - (gfc_get_array_type_bounds): cosmetic change to have character - arrays called character instead of unknown. - * trans-types.h (gfc_get_dtype): modify prototype. - * trans.c (get_array_span): rework the way character array "span" - was calculated. - * trans.h (gfc_get_character_len): new prototype. - (gfc_get_character_len_in_bytes): new prototype. - Add "unlimited_polymorphic" flag to "gfc_se" type to signal when - expression carries an unlimited polymorphic object. - -2021-06-04 Harald Anlauf <anlauf@gmx.de> - - PR fortran/99839 - * frontend-passes.c (inline_matmul_assign): Do not inline matmul - if the assignment to the resulting array if it is not of canonical - type (real/integer/complex/logical). - -2021-06-04 Tobias Burnus <tobias@codesourcery.com> - - * dump-parse-tree.c (show_code_node): Handle - EXEC_OMP_(TARGET_)(,PARALLEL_,TEAMS_)LOOP. - -2021-06-04 Tobias Burnus <tobias@codesourcery.com> - - * scanner.c (skip_fixed_omp_sentinel): Set openacc_flag if - this is not an (OpenMP) continuation line. - (skip_fixed_oacc_sentinel): Likewise for openmp_flag and OpenACC. - (gfc_next_char_literal): gfc_error_now to force error for mixed OMP/ACC - continuation once per location and return '\n'. - -2021-06-04 Tobias Burnus <tobias@codesourcery.com> - - PR middle-end/99928 - * openmp.c (gfc_match_omp_clauses): Fix typo in error message. - -2021-06-04 Tobias Burnus <tobias@codesourcery.com> - - PR middle-end/99928 - * dump-parse-tree.c (show_omp_clauses): Handle bind clause. - (show_omp_node): Handle loop directive. - * frontend-passes.c (gfc_code_walker): Likewise. - * gfortran.h (enum gfc_statement): Add - ST_OMP_(END_)(TARGET_)(|PARALLEL_|TEAMS_)LOOP. - (enum gfc_omp_bind_type): New. - (gfc_omp_clauses): Use it. - (enum gfc_exec_op): Add EXEC_OMP_(TARGET_)(|PARALLEL_|TEAMS_)LOOP. - * match.h (gfc_match_omp_loop, gfc_match_omp_parallel_loop, - gfc_match_omp_target_parallel_loop, gfc_match_omp_target_teams_loop, - gfc_match_omp_teams_loop): New. - * openmp.c (enum omp_mask1): Add OMP_CLAUSE_BIND. - (gfc_match_omp_clauses): Handle it. - (OMP_LOOP_CLAUSES, gfc_match_omp_loop, gfc_match_omp_teams_loop, - gfc_match_omp_target_teams_loop, gfc_match_omp_parallel_loop, - gfc_match_omp_target_parallel_loop): New. - (resolve_omp_clauses, resolve_omp_do, omp_code_to_statement, - gfc_resolve_omp_directive): Handle omp loop. - * parse.c (decode_omp_directive case_exec_markers, gfc_ascii_statement, - parse_omp_do, parse_executable): Likewise. - (parse_omp_structured_block): Remove ST_ which use parse_omp_do. - * resolve.c (gfc_resolve_blocks): Add omp loop. - * st.c (gfc_free_statement): Likewise. - * trans-openmp.c (gfc_trans_omp_clauses): Handle bind clause. - (gfc_trans_omp_do, gfc_trans_omp_parallel_do, gfc_trans_omp_distribute, - gfc_trans_omp_teams, gfc_trans_omp_target, gfc_trans_omp_directive): - Handle loop directive. - (gfc_split_omp_clauses): Likewise; fix firstprivate/lastprivate - and (in_)reduction for taskloop. - * trans.c (trans_code): Handle omp loop directive. - -2021-06-01 Tobias Burnus <tobias@codesourcery.com> - - PR middle-end/99928 - * dump-parse-tree.c (show_omp_node, show_code_node): Handle - (parallel) master taskloop (simd). - * frontend-passes.c (gfc_code_walker): Set in_omp_workshare - to false for parallel master taskloop (simd). - * gfortran.h (enum gfc_statement): - Add ST_OMP_(END_)(PARALLEL_)MASTER_TASKLOOP(_SIMD). - (enum gfc_exec_op): EXEC_OMP_(PARALLEL_)MASTER_TASKLOOP(_SIMD). - * match.h (gfc_match_omp_master_taskloop, - gfc_match_omp_master_taskloop_simd, - gfc_match_omp_parallel_master_taskloop, - gfc_match_omp_parallel_master_taskloop_simd): New prototype. - * openmp.c (gfc_match_omp_parallel_master_taskloop, - gfc_match_omp_parallel_master_taskloop_simd, - gfc_match_omp_master_taskloop, - gfc_match_omp_master_taskloop_simd): New. - (gfc_match_omp_taskloop_simd): Permit 'reduction' clause. - (resolve_omp_clauses): Handle new combined directives; remove - inscan-reduction check to reduce multiple errors; add - task-reduction error for 'taskloop simd'. - (gfc_resolve_omp_parallel_blocks, - resolve_omp_do, omp_code_to_statement, - gfc_resolve_omp_directive): Handle new combined constructs. - * parse.c (decode_omp_directive, next_statement, - gfc_ascii_statement, parse_omp_do, parse_omp_structured_block, - parse_executable): Likewise. - * resolve.c (gfc_resolve_blocks, gfc_resolve_code): Likewise. - * st.c (gfc_free_statement): Likewise. - * trans.c (trans_code): Likewise. - * trans-openmp.c (gfc_split_omp_clauses, - gfc_trans_omp_directive): Likewise. - (gfc_trans_omp_parallel_master): Move after gfc_trans_omp_master_taskloop; - handle parallel master taskloop (simd) as well. - (gfc_trans_omp_taskloop): Take gfc_exec_op as arg. - (gfc_trans_omp_master_taskloop): New. - -2021-05-30 Gerald Pfeifer <gerald@pfeifer.com> - - * gfortran.texi (BOZ literal constants): Fix typo. - -2021-05-28 Tobias Burnus <tobias@codesourcery.com> - - * dump-parse-tree.c (show_iterator): New. - (show_omp_namelist): Handle iterators. - (show_omp_clauses): Handle affinity. - * gfortran.h (gfc_free_omp_namelist): New union with 'udr' and new 'ns'. - * match.c (gfc_free_omp_namelist): Add are to choose union element. - * openmp.c (gfc_free_omp_clauses, gfc_match_omp_detach, - gfc_match_omp_clause_reduction, gfc_match_omp_flush): Update - call to gfc_free_omp_namelist. - (gfc_match_omp_variable_list): Likewise; permit preceeding whitespace. - (enum omp_mask1): Add OMP_CLAUSE_AFFINITY. - (gfc_match_iterator): New. - (gfc_match_omp_clauses): Use it; update call to gfc_free_omp_namelist. - (OMP_TASK_CLAUSES): Add OMP_CLAUSE_AFFINITY. - (gfc_match_omp_taskwait): Match depend clause. - (resolve_omp_clauses): Handle affinity; update for udr/union change. - (gfc_resolve_omp_directive): Resolve clauses of taskwait. - * st.c (gfc_free_statement): Update gfc_free_omp_namelist call. - * trans-openmp.c (gfc_trans_omp_array_reduction_or_udr): Likewise - (handle_iterator): New. - (gfc_trans_omp_clauses): Handle iterators for depend/affinity clause. - (gfc_trans_omp_taskwait): Handle depend clause. - (gfc_trans_omp_directive): Update call. - -2021-05-27 Harald Anlauf <anlauf@gmx.de> - - PR fortran/100602 - * trans-intrinsic.c (gfc_conv_intrinsic_size): Use CLASS data - attributes for CLASS arrays for generation of runtime error. - -2021-05-27 Harald Anlauf <anlauf@gmx.de> - - PR fortran/100656 - * trans-array.c (gfc_conv_ss_startstride): Do not call check for - presence of a dummy argument when a symbol actually refers to a - non-dummy. - -2021-05-25 Tobias Burnus <tobias@codesourcery.com> - Johannes Nendwich <a08727063@unet.univie.ac.at> - - * intrinsic.texi (GERROR, GETARGS, GETLOG, NORM2, PARITY, RANDOM_INIT, - RANDOM_NUMBER): Fix typos and copy'n'paste errors. - -2021-05-24 Tobias Burnus <tobias@codesourcery.com> - - PR fortran/86470 - * trans-expr.c (gfc_copy_class_to_class): Add unshare_expr. - * trans-openmp.c (gfc_is_polymorphic_nonptr, - gfc_is_unlimited_polymorphic_nonptr): New. - (gfc_omp_clause_copy_ctor, gfc_omp_clause_dtor): Handle - polymorphic scalars. - -2021-05-23 Harald Anlauf <anlauf@gmx.de> - - PR fortran/100551 - * trans-expr.c (gfc_conv_procedure_call): Adjust check for - implicit conversion of actual argument to an unlimited polymorphic - procedure argument. - -2021-05-23 Tobias Burnus <tobias@codesourcery.com> - - * intrinsic.texi (ATOMIC_ADD, ATOMIC_FETCH_ADD): Use the - proper variable name in the description. - -2021-05-22 Andre Vehreschild <vehre@gcc.gnu.org> - Steve Kargl <kargl@gcc.gnu.org> - - PR fortran/98301 - * trans-decl.c (gfc_build_builtin_function_decls): Move decl. - * trans-intrinsic.c (conv_intrinsic_random_init): Use bool for - lib-call of caf_random_init instead of logical (4-byte). - * trans.h: Add tree var for random_init. - -2021-05-20 Marcel Vollweiler <marcel@codesourcery.com> - - * openmp.c (gfc_match_omp_clauses): Support map-type-modifier 'close'. - -2021-05-18 Tobias Burnus <tobias@codesourcery.com> - - PR fortran/100642 - * openmp.c (omp_code_to_statement): Add missing EXEC_OMP_DEPOBJ. - -2021-05-17 Harald Anlauf <anlauf@gmx.de> - - PR fortran/98411 - * trans-decl.c (gfc_finish_var_decl): Add check for explicit SAVE - attribute. - -2021-05-17 Tobias Burnus <tobias@codesourcery.com> - - PR fortran/100633 - * resolve.c (gfc_resolve_code): Reject nonintrinsic assignments in - OMP WORKSHARE. - -2021-05-14 Tobias Burnus <tobias@codesourcery.com> - - * dump-parse-tree.c (show_omp_node, show_code_node): Handle - EXEC_OMP_PARALLEL_MASTER. - * frontend-passes.c (gfc_code_walker): Likewise. - * gfortran.h (enum gfc_statement): Add ST_OMP_PARALLEL_MASTER and - ST_OMP_END_PARALLEL_MASTER. - (enum gfc_exec_op): Add EXEC_OMP_PARALLEL_MASTER.. - * match.h (gfc_match_omp_parallel_master): Handle it. - * openmp.c (gfc_match_omp_parallel_master, resolve_omp_clauses, - omp_code_to_statement, gfc_resolve_omp_directive): Likewise. - * parse.c (decode_omp_directive, case_exec_markers, - gfc_ascii_statement, parse_omp_structured_block, - parse_executable): Likewise. - * resolve.c (gfc_resolve_blocks, gfc_resolve_code): Likewise. - * st.c (gfc_free_statement): Likewise. - * trans-openmp.c (gfc_trans_omp_parallel_master, - gfc_trans_omp_workshare, gfc_trans_omp_directive): Likewise. - * trans.c (trans_code): Likewise. - -2021-05-14 Tobias Burnus <tobias@codesourcery.com> - - * resolve.c (resolve_symbol): Handle implicit SAVE of main-program - for vars in 'omp threadprivate' and 'omp declare target'. - -2021-05-10 Martin Liska <mliska@suse.cz> - - * 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. - -2021-05-06 Paul Thomas <pault@gcc.gnu.org> - - PR fortran/46991 - PR fortran/99819 - * class.c (gfc_build_class_symbol): Remove the error that - disables assumed size class arrays. Class array types that are - not deferred shape or assumed rank are given a unique name and - placed in the procedure namespace. - * trans-array.c (gfc_trans_g77_array): Obtain the data pointer - for class arrays. - (gfc_trans_dummy_array_bias): Suppress the runtime error for - extent violations in explicit shape class arrays because it - always fails. - * trans-expr.c (gfc_conv_procedure_call): Handle assumed size - class actual arguments passed to non-descriptor formal args by - using the data pointer, stored as the symbol's backend decl. - -2021-05-05 Harald Anlauf <anlauf@gmx.de> - - PR fortran/100274 - * interface.c (gfc_compare_actual_formal): Continue checks after - emitting warning for argument length mismatch. - * trans-expr.c (gfc_conv_procedure_call): Check for NULL pointer - dereference. - -2021-05-04 Tobias Burnus <tobias@codesourcery.com> - - PR testsuite/100397 - * trans-openmp.c (gfc_trans_omp_depobj): Fix pasto in enum values. - -2021-04-28 Tobias Burnus <tobias@codesourcery.com> - - * openmp.c (gfc_match_omp_variable_list): Gobble whitespace before - checking whether a '%' or parenthesis-open follows as next character. - -2021-04-28 José Rui Faustino de Sousa <jrfsousa@gmail.com> - - PR fortran/82376 - * trans-expr.c (gfc_conv_procedure_call): Evaluate function result - and then pass a pointer. - -2021-04-26 Thomas Schwinge <thomas@codesourcery.com> - Nathan Sidwell <nathan@codesourcery.com> - Tom de Vries <vries@codesourcery.com> - Julian Brown <julian@codesourcery.com> - Kwok Cheung Yeung <kcy@codesourcery.com> - - * lang.opt (Wopenacc-parallelism): New. - -2021-04-24 Harald Anlauf <anlauf@gmx.de> - - PR fortran/100154 - * check.c (variable_check): Allow function reference having a data - pointer result. - (arg_strlen_is_zero): New function. - (gfc_check_fgetputc_sub): Add static check of character and status - arguments. - (gfc_check_fgetput_sub): Likewise. - * intrinsic.c (add_subroutines): Fix argument name for the - character argument to intrinsic subroutines fget[c], fput[c]. - -2021-04-24 Harald Anlauf <anlauf@gmx.de> - - PR fortran/100218 - * expr.c (gfc_check_vardef_context): Extend check to allow pointer - from a function reference. - -2021-04-22 Martin Liska <mliska@suse.cz> - - PR testsuite/100159 - PR testsuite/100192 - * frontend-passes.c (optimize_expr): Fix typos and missing comments. - -2021-04-22 Michael Meissner <meissner@linux.ibm.com> - - PR fortran/96983 - * trans-intrinsic.c (build_round_expr): If int type is larger than - long long, do the round and convert to the integer type. Do not - try to find a floating point type the exact size of the integer - type. - -2021-04-21 Tobias Burnus <tobias@codesourcery.com> - - * dump-parse-tree.c (show_omp_namelist): Handle depobj + mutexinoutset - in the depend clause. - (show_omp_clauses, show_omp_node, show_code_node): Handle depobj. - * gfortran.h (enum gfc_statement): Add ST_OMP_DEPOBJ. - (enum gfc_omp_depend_op): Add OMP_DEPEND_UNSET, - OMP_DEPEND_MUTEXINOUTSET and OMP_DEPEND_DEPOBJ. - (gfc_omp_clauses): Add destroy, depobj_update and depobj. - (enum gfc_exec_op): Add EXEC_OMP_DEPOBJ - * match.h (gfc_match_omp_depobj): Match 'omp depobj'. - * openmp.c (gfc_match_omp_clauses): Add depobj + mutexinoutset - to depend clause. - (gfc_match_omp_depobj, resolve_omp_clauses, gfc_resolve_omp_directive): - Handle 'omp depobj'. - * parse.c (decode_omp_directive, next_statement, gfc_ascii_statement): - Likewise. - * resolve.c (gfc_resolve_code): Likewise. - * st.c (gfc_free_statement): Likewise. - * trans-openmp.c (gfc_trans_omp_clauses): Handle depobj + mutexinoutset - in the depend clause. - (gfc_trans_omp_depobj, gfc_trans_omp_directive): Handle EXEC_OMP_DEPOBJ. - * trans.c (trans_code): Likewise. - -2021-04-20 Paul Thomas <pault@gcc.gnu.org> - - PR fortran/100110 - * trans-decl.c (gfc_get_symbol_decl): Replace test for host - association with a check that the current and symbol namespaces - are the same. - -2021-04-19 Thomas Schwinge <thomas@codesourcery.com> - - * lang.opt (fopenacc-kernels=): Remove. - -2021-04-16 José Rui Faustino de Sousa <jrfsousa@gmail.com> - - PR fortran/100094 - * trans-array.c (gfc_trans_deferred_array): Add code to initialize - pointers and allocatables with correct TKR parameters. - -2021-04-16 José Rui Faustino de Sousa <jrfsousa@gmail.com> - - PR fortran/100018 - * resolve.c: Add association check before de-referencing pointer. - -2021-04-16 Harald Anlauf <anlauf@gmx.de> - Paul Thomas <pault@gcc.gnu.org> - - PR fortran/63797 - * module.c (write_symtree): Do not write interface of intrinsic - procedure to module file for F2003 and newer. - -2021-04-15 Paul Thomas <pault@gcc.gnu.org> - - PR fortran/99307 - * symbol.c: Remove trailing white space. - * trans-array.c (gfc_trans_create_temp_array): Create a class - temporary for class expressions and assign the new descriptor - to the data field. - (build_class_array_ref): If the class expr can be extracted, - then use that for 'decl'. Class function results are reliably - handled this way. Call gfc_find_and_cut_at_last_class_ref to - eliminate largely redundant code. Remove dead code and recast - the rest of the code to extract 'decl' for remaining cases. - Call gfc_build_spanned_array_ref. - (gfc_alloc_allocatable_for_assignment): Use class descriptor - element length for 'elemsize1'. Eliminate repeat set of dtype - for class expressions. - * trans-expr.c (gfc_find_and_cut_at_last_class_ref): Include - additional code from build_class_array_ref, and use optional - gfc_typespec pointer argument. - (gfc_trans_scalar_assign): Make use of pre and post blocks for - all class expressions. - * trans.c (get_array_span): For unlimited polymorphic exprs - multiply the span by the value of the _len field. - (gfc_build_spanned_array_ref): New function. - (gfc_build_array_ref): Call gfc_build_spanned_array_ref and - eliminate repeated code. - * trans.h: Add arg to gfc_find_and_cut_at_last_class_ref and - add prototype for gfc_build_spanned_array_ref. - -2021-04-14 Martin Liska <mliska@suse.cz> - - * intrinsic.texi: The table has first column empty and it makes - trouble when processing makeinfo --xml output. - -2021-04-09 Tobias Burnus <tobias@codesourcery.com> - - PR fortran/99817 - * trans-types.c (gfc_get_function_type): Also generate hidden - coarray argument for character arguments. - -2021-04-03 Paul Thomas <pault@gcc.gnu.org> - - PR fortran/99818 - * interface.c (compare_parameter): The codimension attribute is - applied to the _data field of class formal arguments. - -2021-04-01 Harald Anlauf <anlauf@gmx.de> - - PR fortran/99840 - * simplify.c (gfc_simplify_transpose): Properly initialize - resulting shape. - -2021-03-28 Paul Thomas <pault@gcc.gnu.org> - - PR fortran/99602 - * trans-expr.c (gfc_conv_procedure_call): Use the _data attrs - for class expressions and detect proc pointer evaluations by - the non-null actual argument list. - -2021-03-27 Steve Kargl <kargl@gcc.gnu.org> - - * misc.c (gfc_typename): Fix off-by-one in buffer sizes. - -2021-03-26 Tobias Burnus <tobias@codesourcery.com> - - PR fortran/99651 - * intrinsic.c (gfc_intrinsic_func_interface): Set - attr.proc = PROC_INTRINSIC if FL_PROCEDURE. - -2021-03-24 Tobias Burnus <tobias@codesourcery.com> - - PR fortran/99369 - * resolve.c (resolve_operator): Make 'msg' buffer larger - and use snprintf. - -2021-03-23 Tobias Burnus <tobias@codesourcery.com> - - PR fortran/93660 - * trans-decl.c (build_function_decl): Add comment; - increment hidden_typelist for caf_token/caf_offset. - * trans-types.c (gfc_get_function_type): Add comment; - add missing caf_token/caf_offset args. - -2021-03-22 Tobias Burnus <tobias@codesourcery.com> - - PR fortran/99688 - * match.c (select_type_set_tmp, gfc_match_select_type, - gfc_match_select_rank): Fix 'name' buffersize to avoid out of bounds. - * resolve.c (resolve_select_type): Likewise. - -2021-03-19 Thomas Koenig <tkoenig@gcc.gnu.org> - - * frontend-passes.c (inline_limit_check): Add rank_a - argument. If a is rank 1, set the second dimension to 1. - (inline_matmul_assign): Pass rank_a argument to inline_limit_check. - (call_external_blas): Likewise. - -2021-03-15 Thomas Koenig <tkoenig@gcc.gnu.org> - - PR fortran/99345 - * frontend-passes.c (doloop_contained_procedure_code): - Properly handle EXEC_IOLENGTH. - -2021-03-15 Paul Thomas <pault@gcc.gnu.org> - - PR fortran/99545 - * trans-stmt.c (gfc_trans_allocate): Mark the initialization - assignment by setting init_flag. - -2021-03-14 Harald Anlauf <anlauf@gmx.de> - Paul Thomas <pault@gcc.gnu.org> - - * trans-expr.c (gfc_conv_procedure_call): Fix runtime checks for - CLASS arguments. - * trans-intrinsic.c (gfc_conv_intrinsic_size): Likewise. - -2021-03-13 Paul Thomas <pault@gcc.gnu.org> - - PR fortran/99125 - * trans-array.c (gfc_conv_expr_descriptor): For deferred length - length components use the ss_info string length instead of - gfc_get_expr_charlen. Make sure that the deferred string length - is a variable before assigning to it. Otherwise use the expr. - * trans-expr.c (gfc_conv_string_length): Make sure that the - deferred string length is a variable before assigning to it. - -2021-03-12 Tobias Burnus <tobias@codesourcery.com> - - PR fortran/99514 - * resolve.c (resolve_symbol): Accept vars which are in DATA - and hence (either) implicit SAVE (or in common). - -2021-03-10 Harald Anlauf <anlauf@gmx.de> - - PR fortran/99205 - * data.c (gfc_assign_data_value): Reject non-constant character - length for lvalue. - * trans-array.c (gfc_conv_array_initializer): Restrict loop to - elements which are defined to avoid NULL pointer dereference. - -2021-03-10 Tobias Burnus <tobias@codesourcery.com> - - * intrinsic.texi (MIN): Correct 'maximum' to 'minimum'. - -2021-03-10 Eric Botcazou <ebotcazou@adacore.com> - - PR fortran/96983 - * trans-intrinsic.c (build_round_expr): Do not implicitly assume - that __float128 is the 128-bit floating-point type. - -2021-03-08 Harald Anlauf <anlauf@gmx.de> - - PR fortran/49278 - * data.c (gfc_assign_data_value): Reject variable with PARAMETER - attribute in DATA statement. - -2021-03-05 Tobias Burnus <tobias@codesourcery.com> - - PR fortran/99355 - PR fortran/57871 - * invoke.texi (-freal{4,8}-real-*): Extend description. - * primary.c (match_real_constant): Also promote real literals - with '_kind' number. - -2021-03-04 Tobias Burnus <tobias@codesourcery.com> - - PR fortran/99355 - * decl.c (gfc_match_old_kind_spec, gfc_match_kind_spec): Avoid - redoing kind conversions. - * primary.c (match_real_constant): Likewise. - -2021-02-28 Jakub Jelinek <jakub@redhat.com> - - PR fortran/99303 - * openmp.c (gfc_omp_requires_add_clause): Fix up diagnostic message - wordings. + 2022-01-28 Andre Vehreschild <vehre@gcc.gnu.org> + + PR fortran/103790 + * trans-array.cc (structure_alloc_comps): Prevent descriptor + stacking for non-array data; do not broadcast caf-tokens. + * trans-intrinsic.cc (conv_co_collective): Prevent generation + of unused descriptor. + +2022-01-28 Andre Vehreschild <vehre@gcc.gnu.org> + + PR fortran/103790 + * trans-array.cc (structure_alloc_comps): Prevent descriptor + stacking for non-array data; do not broadcast caf-tokens. + * trans-intrinsic.cc (conv_co_collective): Prevent generation + of unused descriptor. + +2022-01-27 Harald Anlauf <anlauf@gmx.de> + + PR fortran/104128 + * expr.cc (gfc_copy_expr): Convert internal representation of + string to wide char in value only for default character kind. + * target-memory.cc (interpret_array): Pass flag for conversion of + wide chars. + (gfc_target_interpret_expr): Likewise. + +2022-01-27 Harald Anlauf <anlauf@gmx.de> + + PR fortran/84784 + * trans-intrinsic.cc (conv_intrinsic_image_status): Convert result + to resulting (default) integer type. + (conv_intrinsic_team_number): Likewise. + (gfc_conv_intrinsic_popcnt_poppar): Likewise. + +2022-01-25 Harald Anlauf <anlauf@gmx.de> + + PR fortran/104227 + * check.cc (gfc_calculate_transfer_sizes): Fix checking of arrays + passed as MOLD argument to the TRANSFER intrinsic for having + storage size zero. + +2022-01-25 Harald Anlauf <anlauf@gmx.de> + + PR fortran/104212 + * check.cc (gfc_check_norm2): Check that optional argument DIM is + scalar. + (gfc_check_parity): Likewise. + +2022-01-24 Jakub Jelinek <jakub@redhat.com> + + * lang.opt (fconvert=): Add EnumSet property and mention also + r16_ieee and r16_ibm arguments. + (big-endian, little-endian, native, swap): Add Set(1) property. + (r16_ieee, r16_ibm): New EnumValue entries with Set(2) property. + * trans-types.cc (gfc_init_kinds): Emit gfc_fatal_error for + -fconvert=r16_ieee or -fconvert=r16_ibm when R16_IEEE <=> R16_IBM + conversions aren't supported. + +2022-01-22 Harald Anlauf <anlauf@gmx.de> + + PR fortran/104127 + * simplify.cc (gfc_simplify_transfer): Ensure that the result + typespec is set up for TRANSFER with MOLD of type CHARACTER + including character length even if the result is a zero-sized + array. + +2022-01-20 Sandra Loosemore <sandra@codesourcery.com> + + PR fortran/103695 + PR fortran/102621 + * gfortran.h (struct gfc_namespace) Add omp_affinity_iterator + field. + * dump-parse-tree.cc (show_iterator): Use it. + * openmp.cc (gfc_match_iterator): Likewise. (resolve_omp_clauses): Likewise. + * trans-decl.cc (gfc_finish_var_decl): Likewise. + * trans-openmp.cc (handle_iterator): Likewise. + +2022-01-18 Harald Anlauf <anlauf@gmx.de> + + PR fortran/103692 + * array.cc (gfc_expand_constructor): Handle zero-sized array + constructors. + +2022-01-17 Martin Liska <mliska@suse.cz> + + * check.cc (gfc_check_all_any): Rename .c names to .cc. + * class.cc (find_intrinsic_vtab): Likewise. + * config-lang.in: Likewise. + * cpp.cc (cpp_define_builtins): Likewise. + * data.cc (get_array_index): Likewise. + * decl.cc (match_clist_expr): Likewise. + (get_proc_name): Likewise. + (gfc_verify_c_interop_param): Likewise. + (gfc_get_pdt_instance): Likewise. + (gfc_match_formal_arglist): Likewise. + (gfc_get_type_attr_spec): Likewise. + * dependency.cc: Likewise. + * error.cc (gfc_format_decoder): Likewise. + * expr.cc (check_restricted): Likewise. + (gfc_build_default_init_expr): Likewise. + * f95-lang.cc: Likewise. + * gfc-internals.texi: Likewise. + * gfortran.h (enum match): Likewise. + (enum procedure_type): Likewise. + (enum oacc_routine_lop): Likewise. + (gfc_get_pdt_instance): Likewise. + (gfc_end_source_files): Likewise. + (gfc_mpz_set_hwi): Likewise. + (gfc_get_option_string): Likewise. + (gfc_find_sym_in_expr): Likewise. + (gfc_errors_to_warnings): Likewise. + (gfc_real_4_kind): Likewise. + (gfc_free_finalizer): Likewise. + (gfc_sym_get_dummy_args): Likewise. + (gfc_check_intrinsic_standard): Likewise. + (gfc_free_case_list): Likewise. + (gfc_resolve_oacc_routines): Likewise. + (gfc_check_vardef_context): Likewise. + (gfc_free_association_list): Likewise. + (gfc_implicit_pure_function): Likewise. + (gfc_ref_dimen_size): Likewise. + (gfc_compare_actual_formal): Likewise. + (gfc_resolve_wait): Likewise. + (gfc_dt_upper_string): Likewise. + (gfc_generate_module_code): Likewise. + (gfc_delete_bbt): Likewise. + (debug): Likewise. + (gfc_build_block_ns): Likewise. + (gfc_dep_difference): Likewise. + (gfc_invalid_null_arg): Likewise. + (gfc_is_finalizable): Likewise. + (gfc_fix_implicit_pure): Likewise. + (gfc_is_size_zero_array): Likewise. + (gfc_is_reallocatable_lhs): Likewise. + * gfortranspec.cc: Likewise. + * interface.cc (compare_actual_expr): Likewise. + * intrinsic.cc (add_functions): Likewise. + * iresolve.cc (gfc_resolve_matmul): Likewise. + (gfc_resolve_alarm_sub): Likewise. + * iso-c-binding.def: Likewise. + * lang-specs.h: Likewise. + * libgfortran.h (GFC_STDERR_UNIT_NUMBER): Likewise. + * match.cc (gfc_match_label): Likewise. + (gfc_match_symbol): Likewise. + (match_derived_type_spec): Likewise. + (copy_ts_from_selector_to_associate): Likewise. + * match.h (gfc_match_call): Likewise. + (gfc_get_common): Likewise. + (gfc_match_omp_end_single): Likewise. + (gfc_match_volatile): Likewise. + (gfc_match_bind_c): Likewise. + (gfc_match_literal_constant): Likewise. + (gfc_match_init_expr): Likewise. + (gfc_match_array_constructor): Likewise. + (gfc_match_end_interface): Likewise. + (gfc_match_print): Likewise. + (gfc_match_expr): Likewise. + * matchexp.cc (next_operator): Likewise. + * mathbuiltins.def: Likewise. + * module.cc (free_true_name): Likewise. + * openmp.cc (gfc_resolve_omp_parallel_blocks): Likewise. + (gfc_omp_save_and_clear_state): Likewise. + * parse.cc (parse_union): Likewise. + (set_syms_host_assoc): Likewise. + * resolve.cc (resolve_actual_arglist): Likewise. + (resolve_elemental_actual): Likewise. + (check_host_association): Likewise. + (resolve_typebound_function): Likewise. + (resolve_typebound_subroutine): Likewise. + (gfc_resolve_expr): Likewise. + (resolve_assoc_var): Likewise. + (resolve_typebound_procedures): Likewise. + (resolve_equivalence_derived): Likewise. + * simplify.cc (simplify_bound): Likewise. + * symbol.cc (gfc_set_default_type): Likewise. + (gfc_add_ext_attribute): Likewise. + * target-memory.cc (gfc_target_interpret_expr): Likewise. + * target-memory.h (gfc_target_interpret_expr): Likewise. + * trans-array.cc (gfc_get_cfi_dim_sm): Likewise. + (gfc_conv_shift_descriptor_lbound): Likewise. + (gfc_could_be_alias): Likewise. + (gfc_get_dataptr_offset): Likewise. + * trans-const.cc: Likewise. + * trans-decl.cc (trans_function_start): Likewise. + (gfc_trans_deferred_vars): Likewise. + (generate_local_decl): Likewise. + (gfc_generate_function_code): Likewise. + * trans-expr.cc (gfc_vptr_size_get): Likewise. + (gfc_trans_class_array_init_assign): Likewise. + (POWI_TABLE_SIZE): Likewise. + (gfc_conv_procedure_call): Likewise. + (gfc_trans_arrayfunc_assign): Likewise. + * trans-intrinsic.cc (gfc_conv_intrinsic_len): Likewise. + (gfc_conv_intrinsic_loc): Likewise. + (conv_intrinsic_event_query): Likewise. + * trans-io.cc (gfc_build_st_parameter): Likewise. + * trans-openmp.cc (gfc_omp_check_optional_argument): Likewise. + (gfc_omp_unshare_expr_r): Likewise. + (gfc_trans_omp_array_section): Likewise. + (gfc_trans_omp_clauses): Likewise. + * trans-stmt.cc (trans_associate_var): Likewise. + (gfc_trans_deallocate): Likewise. + * trans-stmt.h (gfc_trans_class_init_assign): Likewise. + (gfc_trans_deallocate): Likewise. + (gfc_trans_oacc_declare): Likewise. + * trans-types.cc: Likewise. + * trans-types.h (enum gfc_packed): Likewise. + * trans.cc (N_): Likewise. + (trans_code): Likewise. + * trans.h (gfc_build_compare_string): Likewise. + (gfc_conv_expr_type): Likewise. + (gfc_trans_deferred_vars): Likewise. + (getdecls): Likewise. + (gfc_get_array_descr_info): Likewise. + (gfc_omp_firstprivatize_type_sizes): Likewise. + (GTY): Likewise. + +2022-01-17 Martin Liska <mliska@suse.cz> + + * arith.c: Moved to... + * arith.cc: ...here. + * array.c: Moved to... + * array.cc: ...here. + * bbt.c: Moved to... + * bbt.cc: ...here. + * check.c: Moved to... + * check.cc: ...here. + * class.c: Moved to... + * class.cc: ...here. + * constructor.c: Moved to... + * constructor.cc: ...here. + * convert.c: Moved to... + * convert.cc: ...here. + * cpp.c: Moved to... + * cpp.cc: ...here. + * data.c: Moved to... + * data.cc: ...here. + * decl.c: Moved to... + * decl.cc: ...here. + * dependency.c: Moved to... + * dependency.cc: ...here. + * dump-parse-tree.c: Moved to... + * dump-parse-tree.cc: ...here. + * error.c: Moved to... + * error.cc: ...here. + * expr.c: Moved to... + * expr.cc: ...here. + * f95-lang.c: Moved to... + * f95-lang.cc: ...here. + * frontend-passes.c: Moved to... + * frontend-passes.cc: ...here. + * gfortranspec.c: Moved to... + * gfortranspec.cc: ...here. + * interface.c: Moved to... + * interface.cc: ...here. + * intrinsic.c: Moved to... + * intrinsic.cc: ...here. + * io.c: Moved to... + * io.cc: ...here. + * iresolve.c: Moved to... + * iresolve.cc: ...here. + * match.c: Moved to... + * match.cc: ...here. + * matchexp.c: Moved to... + * matchexp.cc: ...here. + * misc.c: Moved to... + * misc.cc: ...here. + * module.c: Moved to... + * module.cc: ...here. + * openmp.c: Moved to... + * openmp.cc: ...here. + * options.c: Moved to... + * options.cc: ...here. + * parse.c: Moved to... + * parse.cc: ...here. + * primary.c: Moved to... + * primary.cc: ...here. + * resolve.c: Moved to... + * resolve.cc: ...here. + * scanner.c: Moved to... + * scanner.cc: ...here. + * simplify.c: Moved to... + * simplify.cc: ...here. + * st.c: Moved to... + * st.cc: ...here. + * symbol.c: Moved to... + * symbol.cc: ...here. + * target-memory.c: Moved to... + * target-memory.cc: ...here. + * trans-array.c: Moved to... + * trans-array.cc: ...here. + * trans-common.c: Moved to... + * trans-common.cc: ...here. + * trans-const.c: Moved to... + * trans-const.cc: ...here. + * trans-decl.c: Moved to... + * trans-decl.cc: ...here. + * trans-expr.c: Moved to... + * trans-expr.cc: ...here. + * trans-intrinsic.c: Moved to... + * trans-intrinsic.cc: ...here. + * trans-io.c: Moved to... + * trans-io.cc: ...here. + * trans-openmp.c: Moved to... + * trans-openmp.cc: ...here. + * trans-stmt.c: Moved to... + * trans-stmt.cc: ...here. + * trans-types.c: Moved to... + * trans-types.cc: ...here. + * trans.c: Moved to... + * trans.cc: ...here. + +2022-01-17 Andrew Stubbs <ams@codesourcery.com> + + * openmp.c (gfc_match_omp_requires): Don't "sorry" dynamic_allocators. + +2022-01-15 Harald Anlauf <anlauf@gmx.de> + + PR fortran/83079 + * target-memory.c (gfc_interpret_character): Result length is + in bytes and thus depends on the character kind. + * trans-intrinsic.c (gfc_conv_intrinsic_transfer): Compute correct + string length for the result of the TRANSFER intrinsic and for + temporaries for the different character kinds. + +2022-01-14 Harald Anlauf <anlauf@gmx.de> + + PR fortran/99256 + * intrinsic.c: Do not check formal argument type when checking + arguments of intrinsics for alternate return specifiers. + +2022-01-14 Harald Anlauf <anlauf@gmx.de> + + PR fortran/103782 + * expr.c (gfc_simplify_expr): Adjust logic for when to scalarize a + call of an intrinsic which may have been overloaded. + +2022-01-13 Hafiz Abid Qadeer <abidh@codesourcery.com> + + * dump-parse-tree.c (show_omp_clauses): Handle OMP_LIST_ALLOCATE. + * gfortran.h (OMP_LIST_ALLOCATE): New enum value. + * openmp.c (enum omp_mask1): Add OMP_CLAUSE_ALLOCATE. + (gfc_match_omp_clauses): Handle OMP_CLAUSE_ALLOCATE + (OMP_PARALLEL_CLAUSES, OMP_DO_CLAUSES, OMP_SECTIONS_CLAUSES) + (OMP_TASK_CLAUSES, OMP_TASKLOOP_CLAUSES, OMP_TARGET_CLAUSES) + (OMP_TEAMS_CLAUSES, OMP_DISTRIBUTE_CLAUSES) + (OMP_SINGLE_CLAUSES): Add OMP_CLAUSE_ALLOCATE. + (OMP_TASKGROUP_CLAUSES): New. + (gfc_match_omp_taskgroup): Use OMP_TASKGROUP_CLAUSES instead of + OMP_CLAUSE_TASK_REDUCTION. + (resolve_omp_clauses): Handle OMP_LIST_ALLOCATE. + (resolve_omp_do): Avoid warning when loop iteration variable is + in allocate clause. + * trans-openmp.c (gfc_trans_omp_clauses): Handle translation of + allocate clause. + (gfc_split_omp_clauses): Update for OMP_LIST_ALLOCATE. + +2022-01-13 Harald Anlauf <anlauf@gmx.de> + + PR fortran/67804 + * primary.c (gfc_match_structure_constructor): Recover from errors + that occurred while checking for a valid structure constructor in + a DATA statement. + +2022-01-11 Thomas Koenig <tkoenig@gcc.gnu.org> + + * libgfortran.h (unit_convert): Add flags. + +2022-01-11 Jakub Jelinek <jakub@redhat.com> + + * trans-types.c (gfc_init_kinds): When setting abi_kind to 17, if not + targetting glibc 2.32 or later and -fbuilding-libgfortran, set + gfc_real16_is_float128 and c_float128 in gfc_real_kinds. + (gfc_build_real_type): Don't set c_long_double if c_float128 is + already set. + * trans-intrinsic.c (builtin_decl_for_precision): Don't use + long_double_built_in if gfc_real16_is_float128 and + long_double_type_node == gfc_float128_type_node. + * lang.opt (fbuilding-libgfortran): New undocumented option. + +2022-01-11 Jakub Jelinek <jakub@redhat.com> + + * trans-intrinsic.c (gfc_get_intrinsic_lib_fndecl): Use + gfc_type_abi_kind. + +2022-01-11 Jakub Jelinek <jakub@redhat.com> + + * trans-io.c (transfer_array_desc): Pass abi kind instead of kind + to libgfortran. + +2022-01-11 Jakub Jelinek <jakub@redhat.com> + + * trans-io.c (transfer_namelist_element): Use gfc_type_abi_kind, + formatting fixes. + (transfer_expr): Use gfc_type_abi_kind, use *REAL128* APIs even + for abi_kind == 17. + +2022-01-11 Jakub Jelinek <jakub@redhat.com> + + * gfortran.h (gfc_real_info): Add abi_kind member. + (gfc_type_abi_kind): Declare. + * trans-types.c (gfc_init_kinds): Initialize abi_kind. + * intrinsic.c (gfc_type_abi_kind): New function. + (conv_name): Use it. + * iresolve.c (resolve_transformational, gfc_resolve_abs, + gfc_resolve_char_achar, gfc_resolve_acos, gfc_resolve_acosh, + gfc_resolve_aimag, gfc_resolve_and, gfc_resolve_aint, gfc_resolve_all, + gfc_resolve_anint, gfc_resolve_any, gfc_resolve_asin, + gfc_resolve_asinh, gfc_resolve_atan, gfc_resolve_atanh, + gfc_resolve_atan2, gfc_resolve_bessel_n2, gfc_resolve_ceiling, + gfc_resolve_cmplx, gfc_resolve_complex, gfc_resolve_cos, + gfc_resolve_cosh, gfc_resolve_count, gfc_resolve_dble, + gfc_resolve_dim, gfc_resolve_dot_product, gfc_resolve_dprod, + gfc_resolve_exp, gfc_resolve_floor, gfc_resolve_hypot, + gfc_resolve_int, gfc_resolve_int2, gfc_resolve_int8, gfc_resolve_long, + gfc_resolve_log, gfc_resolve_log10, gfc_resolve_logical, + gfc_resolve_matmul, gfc_resolve_minmax, gfc_resolve_maxloc, + gfc_resolve_findloc, gfc_resolve_maxval, gfc_resolve_merge, + gfc_resolve_minloc, gfc_resolve_minval, gfc_resolve_mod, + gfc_resolve_modulo, gfc_resolve_nearest, gfc_resolve_or, + gfc_resolve_real, gfc_resolve_realpart, gfc_resolve_reshape, + gfc_resolve_sign, gfc_resolve_sin, gfc_resolve_sinh, gfc_resolve_sqrt, + gfc_resolve_tan, gfc_resolve_tanh, gfc_resolve_transpose, + gfc_resolve_trigd, gfc_resolve_xor, gfc_resolve_random_number): + Likewise. + * trans-decl.c (gfc_build_intrinsic_function_decls): Likewise. -2021-02-28 Jakub Jelinek <jakub@redhat.com> - - PR fortran/99300 - * frontend-passes.c (doloop_code): Replace double space in diagnostics - with a single space. - -2021-02-24 Paul Thomas <pault@gcc.gnu.org> - - PR fortran/98342 - * trans-expr.c (gfc_conv_derived_to_class): Add optional arg. - 'derived_array' to hold the fixed, parmse expr in the case of - assumed rank formal arguments. Deal with optional arguments. - (gfc_conv_procedure_call): Null 'derived' array for each actual - argument. Add its address to the call to gfc_conv_derived_to_ - class. Access the 'data' field of scalar descriptors before - deallocating allocatable components. Also strip NOPs before the - calls to gfc_deallocate_alloc_comp. Use 'derived' array as the - input to gfc_deallocate_alloc_comp if it is available. - * trans.h : Include the optional argument 'derived_array' to - the prototype of gfc_conv_derived_to_class. The default value - is NULL_TREE. - -2021-02-23 Paul Thomas <pault@gcc.gnu.org> - - PR fortran/99124 - * resolve.c (resolve_fl_procedure): Include class results in - the test for F2018, C15100. - * trans-array.c (get_class_info_from_ss): Do not use the saved - descriptor to obtain the class expression for variables. Use - gfc_get_class_from_expr instead. - -2021-02-23 Harald Anlauf <anlauf@gmx.de> - - PR fortran/99206 - * simplify.c (gfc_simplify_reshape): Set string length for - character arguments. - -2021-02-22 Tobias Burnus <tobias@codesourcery.com> - - PR fortran/99171 - * trans-openmp.c (gfc_omp_is_optional_argument): Regard optional - dummy procs as nonoptional as no special treatment is needed. - -2021-02-21 Harald Anlauf <anlauf@gmx.de> - - * trans-expr.c (gfc_conv_procedure_call): Do not add clobber to - allocatable intent(out) argument. - -2021-02-19 Jerry DeLisle <jvdelisle@gcc.gnu.org> - - PR fortran/98686 - * match.c (gfc_match_namelist): If BT_UNKNOWN, check for - IMPLICIT NONE and and issue an error, otherwise set the type - to its IMPLICIT type so that any subsequent use of objects will - will confirm their types. - -2021-02-19 Harald Anlauf <anlauf@gmx.de> - - * symbol.c (gfc_add_flavor): Reverse order of conditions. - -2021-02-19 Tobias Burnus <tobias@codesourcery.com> - - PR fortran/99010 - * dependency.c (gfc_dep_resolver): Fix coarray handling. - -2021-02-19 Tobias Burnus <tobias@codesourcery.com> - - PR fortran/99146 - * interface.c: - -2021-02-19 Tobias Burnus <tobias@codesourcery.com> - - PR fortran/99027 - * simplify.c (simplify_bound_dim): Honor DIMEN_ELEMENT - when using dim=. - -2021-02-17 Julian Brown <julian@codesourcery.com> - - * openmp.c (resolve_omp_clauses): Disallow selecting components - of arrays of derived type. - -2021-02-17 Julian Brown <julian@codesourcery.com> - - * trans-openmp.c (gfc_trans_omp_clauses): Handle element selection - for arrays of derived types. - -2021-02-16 Tobias Burnus <tobias@codesourcery.com> - - * expr.c (gfc_is_simplify_contiguous): Handle REF_INQUIRY, i.e. - %im and %re which are EXPR_VARIABLE. - * openmp.c (resolve_omp_clauses): Diagnose %re/%im explicitly. - -2021-02-16 Tobias Burnus <tobias@codesourcery.com> - - PR fortran/99111 - * io.c (resolve_tag_format): Reject BT_DERIVED/CLASS/VOID - as (array-valued) FORMAT tag. - -2021-02-12 Tobias Burnus <tobias@codesourcery.com> - - PR fortran/99043 - * trans-expr.c (gfc_conv_procedure_call): Don't reset - rank of assumed-rank array. - -2021-02-11 Paul Thomas <pault@gcc.gnu.org> - - PR fortran/98897 - * match.c (gfc_match_call): Include associate names as possible - entities with typebound subroutines. The target needs to be - resolved for the type. - -2021-02-11 Paul Thomas <pault@gcc.gnu.org> - - PR fortran/99060 - * primary.c (gfc_match_varspec): Test for non-null 'previous' - before using its name in the error message. - -2021-02-11 Tobias Burnus <tobias@codesourcery.com> - - * intrinsic.texi (FINDLOC): Add 'MASK' to argument table. - (MAXLOC, MAXVAL, MINLOC, MINVAL): For 'MASK', remove 'an - array' as scalars are also permitted. - -2021-02-10 Julian Brown <julian@codesourcery.com> - - PR fortran/98979 - * openmp.c (resolve_omp_clauses): Omit OpenACC update in - contiguity check and stride-specified error. - -2021-02-04 Julian Brown <julian@codesourcery.com> - - * openmp.c (resolve_omp_clauses): Omit OpenACC update in - contiguity check and stride-specified error. - -2021-02-04 Julian Brown <julian@codesourcery.com> - - * trans-openmp.c (gfc_trans_omp_clauses): Use class_pointer attribute - for BT_CLASS. - -2021-02-04 Julian Brown <julian@codesourcery.com> - - * trans-openmp.c (gfc_trans_omp_clauses): Fix dereferencing for - BT_DERIVED members. - -2021-02-04 Tobias Burnus <tobias@codesourcery.com> - - * openmp.c (resolve_omp_clauses): Explicitly diagnose - substrings as not permitted. - -2021-02-03 Jeff Law <law@redhat.com> - - * intrinsic.texi (ANINT): Fix typo. - -2021-02-03 Tobias Burnus <tobias@codesourcery.com> - - PR fortran/98913 - * dependency.c (gfc_dep_resolver): Treat local access - to coarrays like any array access in dependency analysis. - -2021-01-28 Harald Anlauf <anlauf@gmx.de> - - PR fortran/86470 - * trans.c (gfc_call_malloc): Allocate area of size 1 if passed - size is NULL (as documented). - -2021-01-27 Paul Thomas <pault@gcc.gnu.org> - - PR fortran/93924 - PR fortran/93925 - * trans-expr.c (gfc_conv_procedure_call): Suppress the call to - gfc_conv_intrinsic_to_class for unlimited polymorphic procedure - pointers. - (gfc_trans_assignment_1): Similarly suppress class assignment - for class valued procedure pointers. - -2021-01-27 Paul Thomas <pault@gcc.gnu.org> - - PR fortran/98472 - * trans-array.c (gfc_conv_expr_descriptor): Include elemental - procedure pointers in the assert under the comment 'elemental - function' and eliminate the second, spurious assert. - -2021-01-25 Harald Anlauf <anlauf@gmx.de> - - PR fortran/70070 - * data.c (create_character_initializer): Check substring indices - against bounds. - (gfc_assign_data_value): Catch error returned from - create_character_initializer. - -2021-01-25 Tobias Burnus <tobias@codesourcery.com> - - * intrinsic.texi (CO_BROADCAST, CO_MIN, CO_REDUCE, CO_SUM): Fix typos. - -2021-01-25 Steve Kargl <kargl@gcc.gnu.org> - - PR fortran/98517 - * resolve.c (resolve_charlen): Check that length expression is - present before testing for scalar/integer.. - -2021-01-22 Paul Thomas <pault@gcc.gnu.org> - - PR fortran/98565 - * trans-intrinsic.c (gfc_conv_associated): Do not add a _data - component for scalar class function targets. Instead, fix the - function result and access the _data from that. - -2021-01-21 Jorge D'Elia <jdelia@cimec.unl.edu.ar> - - * intrinsic.texi (CO_MAX): Fix typo. - -2021-01-21 Paul Thomas <pault@gcc.gnu.org> - - PR fortran/96320 - * decl.c (gfc_match_modproc): It is not an error to find a - module procedure declaration within a contains block. - * expr.c (gfc_check_vardef_context): Pure procedure result is - assignable. Change 'own_scope' accordingly. - * resolve.c (resolve_typebound_procedure): A procedure that - has the module procedure attribute is almost certainly a - module procedure, whatever its interface. - -2021-01-19 Tobias Burnus <tobias@codesourcery.com> - - PR fortran/98476 - * openmp.c (resolve_omp_clauses): Change use_device_ptr - to use_device_addr for unless type(c_ptr); check all - list item for is_device_ptr. - -2021-01-16 Kwok Cheung Yeung <kcy@codesourcery.com> - - * dump-parse-tree.c (show_omp_clauses): Handle detach clause. - * frontend-passes.c (gfc_code_walker): Walk detach expression. - * gfortran.h (struct gfc_omp_clauses): Add detach field. - (gfc_c_intptr_kind): New. - * openmp.c (gfc_free_omp_clauses): Free detach clause. - (gfc_match_omp_detach): New. - (enum omp_mask1): Add OMP_CLAUSE_DETACH. - (enum omp_mask2): Remove OMP_CLAUSE_DETACH. - (gfc_match_omp_clauses): Handle OMP_CLAUSE_DETACH for OpenMP. - (OMP_TASK_CLAUSES): Add OMP_CLAUSE_DETACH. - (resolve_omp_clauses): Prevent use of detach with mergeable and - overriding the data sharing mode of the event handle. - * trans-openmp.c (gfc_trans_omp_clauses): Handle detach clause. - * trans-types.c (gfc_c_intptr_kind): New. - (gfc_init_kinds): Initialize gfc_c_intptr_kind. - * types.def - (BT_FN_VOID_OMPFN_PTR_OMPCPYFN_LONG_LONG_BOOL_UINT_PTR_INT): Rename - to... - (BT_FN_VOID_OMPFN_PTR_OMPCPYFN_LONG_LONG_BOOL_UINT_PTR_INT_PTR): - ...this. Add extra argument. - -2021-01-14 Harald Anlauf <anlauf@gmx.de> - - * gfortran.h (gfc_resolve_substring): Add prototype. - * primary.c (match_string_constant): Simplify substrings with - constant starting and ending points. - * resolve.c: Rename resolve_substring to gfc_resolve_substring. - (gfc_resolve_ref): Use renamed function gfc_resolve_substring. - -2021-01-14 Harald Anlauf <anlauf@gmx.de> - - PR fortran/98661 - * resolve.c (resolve_component): Derived type components with - ALLOCATABLE or POINTER attribute shall have a deferred shape. - -2021-01-14 Harald Anlauf <anlauf@gmx.de> - - Revert: - 2021-01-14 Harald Anlauf <anlauf@gmx.de> +2022-01-10 Paul Thomas <pault@gcc.gnu.org> - PR fortran/98661 - * resolve.c (resolve_component): Derived type components with - ALLOCATABLE or POINTER attribute shall have a deferred shape. + PR fortran/103366 + * trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): Allow unlimited + polymorphic actual argument passed to assumed type formal. -2021-01-14 Harald Anlauf <anlauf@gmx.de> +2022-01-09 Harald Anlauf <anlauf@gmx.de> - PR fortran/98661 - * resolve.c (resolve_component): Derived type components with - ALLOCATABLE or POINTER attribute shall have a deferred shape. + PR fortran/103777 + * simplify.c (gfc_simplify_maskr): Check validity of argument 'I' + before simplifying. + (gfc_simplify_maskl): Likewise. -2021-01-08 Paul Thomas <pault@gcc.gnu.org> +2022-01-09 Harald Anlauf <anlauf@gmx.de> - PR fortran/93794 - * trans-expr.c (gfc_conv_component_ref): Remove the condition - that deferred character length components only be allocatable. + PR fortran/101762 + * expr.c (gfc_check_pointer_assign): For pointer initialization + targets, check that subscripts and substring indices in + specifications are constant expressions. -2021-01-08 Paul Thomas <pault@gcc.gnu.org> +2022-01-09 Mikael Morin <mikael@gcc.gnu.org> - PR fortran/98458 - * simplify.c (is_constant_array_expr): If an array constructor - expression has elements other than constants or structures, try - fixing the expression with gfc_reduce_init_expr. Also, if shape - is NULL, obtain the array size and set it. + PR fortran/103789 + * trans-array.c (arg_evaluated_for_scalarization): Add MASKL, MASKR, + SCAN and VERIFY to the list of intrinsics whose KIND argument is to be + ignored. -2021-01-07 Paul Thomas <pault@gcc.gnu.org> +2022-01-07 Sandra Loosemore <sandra@codesourcery.com> - PR fortran/93701 - * resolve.c (find_array_spec): Put static prototype for - resolve_assoc_var before this function and call for associate - variables. + PR fortran/103898 + * trans-intrinsic.c (gfc_conv_intrinsic_size): Make size_var + actually be a variable and fix surrounding code. -2021-01-06 Harald Anlauf <anlauf@gmx.de> +2022-01-06 Steve Kargl <kargl@gcc.gnu.org> + Sandra Loosemore <sandra@codesourcery.com> - * resolve.c (resolve_component): Add check for valid CLASS - reference before trying to access CLASS data. + PR fortran/103287 + * interface.c (argument_rank_mismatch): Replace incorrect assertion + with return. -2021-01-04 Martin Liska <mliska@suse.cz> +2022-01-05 Sandra Loosemore <sandra@codesourcery.com> - * ChangeLog-2018: Remove duplicate ChangeLog entries. + PR fortran/103258 + * decl.c (gfc_match_char_spec): Suppress errors around call + to gfc_reduce_init_expr. + * error.c (gfc_query_suppress_errors): New. + * gfortran.h (gfc_query_suppress_errors): Declare. + * symbol.c (gfc_set_default_type): Check gfc_query_suppress_errors. -2021-01-01 Harald Anlauf <anlauf@gmx.de> +2022-01-03 Sandra Loosemore <sandra@codesourcery.com> - * class.c (gfc_find_vtab): Add check on attribute is_class. + PR fortran/103390 + * expr.c (gfc_is_simply_contiguous): Make it smarter about + function calls. + * trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): Do not generate + copy loops for array expressions that are not "variables" (lvalues). -2021-01-01 Jakub Jelinek <jakub@redhat.com> +2022-01-03 Jakub Jelinek <jakub@redhat.com> * gfortranspec.c (lang_specific_driver): Update copyright notice dates. @@ -1882,12 +554,8 @@ * intrinsic.texi: Ditto. * invoke.texi: Ditto. -2021-01-01 Jakub Jelinek <jakub@redhat.com> - - * ChangeLog-2020: Rotate ChangeLog. New file. - -Copyright (C) 2021 Free Software Foundation, Inc. +Copyright (C) 2022 Free Software Foundation, Inc. Copying and distribution of this file, with or without modification, are permitted in any medium without royalty provided the copyright diff --git a/gcc/fortran/ChangeLog-2021 b/gcc/fortran/ChangeLog-2021 new file mode 100644 index 0000000..04889e2 --- /dev/null +++ b/gcc/fortran/ChangeLog-2021 @@ -0,0 +1,2563 @@ +2021-12-29 Harald Anlauf <anlauf@gmx.de> + + PR fortran/102332 + * expr.c (gfc_get_variable_expr): Avoid NULL pointer dereferences + during handling of errors with invalid uses of CLASS variables. + * match.c (select_type_set_tmp): Likewise. + * primary.c (gfc_match_varspec): Likewise. + * resolve.c (resolve_variable): Likewise. + (resolve_select_type): Likewise. + +2021-12-28 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org> + + PR fortran/103828 + * trans-decl.c (generate_local_decl): Do not call + gfc_conv_scalar_char_value(), but check the type tree. + * trans-expr.c (gfc_conv_scalar_char_value): Rename to + conv_scalar_char_value, do not alter type tree. + (gfc_conv_procedure_call): Adjust call to renamed + conv_scalar_char_value() function. + * trans-types.c (gfc_sym_type): Take care of + CHARACTER(C_CHAR), VALUE arguments. + * trans.h (gfc_conv_scalar_char_value): Remove prototype. + +2021-12-28 Martin Liska <mliska@suse.cz> + + * gfortran.texi: Replace http:// with https. + * intrinsic.texi: Likewise. + +2021-12-22 Harald Anlauf <anlauf@gmx.de> + + PR fortran/103778 + * check.c (is_c_interoperable): A BOZ literal constant is not + interoperable. + +2021-12-22 Harald Anlauf <anlauf@gmx.de> + + PR fortran/103776 + * match.c (match_case_selector): Reject expressions in CASE + selector which are not scalar. + +2021-12-18 Harald Anlauf <anlauf@gmx.de> + + PR fortran/103412 + * check.c (gfc_check_sizeof): Reject BOZ type argument. + +2021-12-14 Harald Anlauf <anlauf@gmx.de> + + PR fortran/103717 + * frontend-passes.c (doloop_code): Prevent NULL pointer + dereference when checking for passing a do-loop variable to a + contained procedure with an interface mismatch. + +2021-12-14 Harald Anlauf <anlauf@gmx.de> + + PR fortran/103718 + PR fortran/103719 + * frontend-passes.c (doloop_contained_procedure_code): Add several + checks to prevent NULL pointer dereferences on valid and invalid + code called within do-loops. + +2021-12-14 Manfred Schwarb <manfred99@gmx.ch> + + PR fortran/91497 + * simplify.c (simplify_min_max): Disable conversion warnings for + MIN1 and MAX1. + +2021-12-13 Tobias Burnus <tobias@codesourcery.com> + + PR fortran/103576 + * openmp.c (is_scalar_intrinsic_expr): Fix condition. + (resolve_omp_atomic): Fix/update checks, accept compare. + * trans-openmp.c (gfc_trans_omp_atomic): Handle compare. + +2021-12-11 Harald Anlauf <anlauf@gmx.de> + + PR fortran/103606 + * resolve.c (resolve_fl_procedure): Do not access CLASS components + before class container has been built. + +2021-12-10 Harald Anlauf <anlauf@gmx.de> + + PR fortran/103418 + * check.c (variable_check): Replace previous check of procedure + dummy arguments with INTENT(IN) attribute when passed to intrinsic + procedures by gfc_check_vardef_context. + * expr.c (gfc_check_vardef_context): Correct check of INTENT(IN) + dummy arguments for the case of sub-components of a CLASS pointer. + +2021-12-08 Harald Anlauf <anlauf@gmx.de> + + PR fortran/103609 + * symbol.c (gfc_sym_get_dummy_args): Catch NULL pointer + dereference. + +2021-12-08 Harald Anlauf <anlauf@gmx.de> + + PR fortran/103610 + * array.c (spec_dimen_size): Fix simplification of SHAPE: + dimensions must be non-negative. + +2021-12-08 Chung-Lin Tang <cltang@codesourcery.com> + + * trans-openmp.c (gfc_trans_omp_array_section): Do not generate + GOMP_MAP_ALWAYS_POINTER map for main array maps of ARRAY_TYPE type. + +2021-12-07 Harald Anlauf <anlauf@gmx.de> + + PR fortran/103607 + * frontend-passes.c (do_subscript): Ensure that array bounds are + of type INTEGER before performing checks on array subscripts. + +2021-12-07 Harald Anlauf <anlauf@gmx.de> + + PR fortran/103588 + * array.c (gfc_ref_dimen_size): Do not generate internal error on + failed simplification of stride expression; just return failure. + +2021-12-07 Harald Anlauf <anlauf@gmx.de> + + PR fortran/103591 + * match.c (match_case_selector): Check type of upper bound in case + range. + +2021-12-04 Tobias Burnus <tobias@codesourcery.com> + + * dump-parse-tree.c (show_omp_clauses): Handle + weak/compare/fail clause. + * gfortran.h (gfc_omp_clauses): Add weak, compare, fail. + * openmp.c (enum omp_mask1, gfc_match_omp_clauses, + OMP_ATOMIC_CLAUSES): Update for new clauses. + (gfc_match_omp_atomic): Update for 5.1 atomic changes. + (is_conversion): Support widening in one go. + (is_scalar_intrinsic_expr): New. + (resolve_omp_atomic): Update for 5.1 atomic changes. + * parse.c (parse_omp_oacc_atomic): Update for compare. + * resolve.c (gfc_resolve_blocks): Update asserts. + * trans-openmp.c (gfc_trans_omp_atomic): Handle new clauses. + +2021-12-03 Harald Anlauf <anlauf@gmx.de> + Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/103505 + * array.c (match_array_element_spec): Try to simplify array + element specifications to improve early checking. + * expr.c (gfc_try_simplify_expr): New. Try simplification of an + expression via gfc_simplify_expr. When an error occurs, roll + back. + * gfortran.h (gfc_try_simplify_expr): Declare it. + +2021-12-03 Tobias Burnus <tobias@codesourcery.com> + + * trans-stmt.c (gfc_trans_allocate): Set e3_has_nodescriptor to true + only for non-named arrays. + +2021-12-02 Chung-Lin Tang <cltang@codesourcery.com> + + PR fortran/90030 + * trans-openmp.c (gfc_omp_finish_clause): Remove fold_convert to pointer + to char_type_node, add gcc_assert of POINTER_TYPE_P. + (gfc_trans_omp_array_section): Likewise. + (gfc_trans_omp_clauses): Likewise. + +2021-11-30 Harald Anlauf <anlauf@gmx.de> + + PR fortran/102787 + * array.c (expand_constructor): When encountering a constant array + expression or array section within a constructor, simplify it to + enable better expansion. + +2021-11-30 Harald Anlauf <anlauf@gmx.de> + + PR fortran/103473 + * simplify.c (simplify_minmaxloc_nodim): Avoid NULL pointer + dereference when shape is not set. + +2021-11-30 Harald Anlauf <anlauf@gmx.de> + Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/101565 + * check.c (gfc_check_image_index): Verify that SUB argument to + IMAGE_INDEX is of type integer. + +2021-11-30 Richard Biener <rguenther@suse.de> + + * frontend-passes.c (gfc_expr_walker): Add comment to + indicate tail recursion. + +2021-11-30 Richard Biener <rguenther@suse.de> + + * target-memory.c (gfc_element_size): Remove unreachable return. + +2021-11-30 Thomas Schwinge <thomas@codesourcery.com> + + * openmp.c (resolve_oacc_loop_blocks): Remove "gang reduction on + an orphan loop" checking. + (oacc_is_parallel, oacc_is_kernels, oacc_is_serial) + (oacc_is_compute_construct): Remove. + +2021-11-30 Frederik Harwath <frederik@codesourcery.com> + Thomas Schwinge <thomas@codesourcery.com> + + * openmp.c (oacc_is_parallel_or_serial): Evolve into... + (oacc_is_compute_construct): ... this function. + (resolve_oacc_loop_blocks): Use "oacc_is_compute_construct" + instead of "oacc_is_parallel_or_serial" for checking that a + loop is not orphaned. + +2021-11-30 Kwok Cheung Yeung <kcy@codesourcery.com> + Thomas Schwinge <thomas@codesourcery.com> + + * openmp.c (oacc_is_serial, oacc_is_parallel_or_serial): New. + (resolve_oacc_loop_blocks): Use oacc_is_parallel_or_serial instead of + oacc_is_parallel. + +2021-11-30 Cesar Philippidis <cesar@codesourcery.com> + Thomas Schwinge <thomas@codesourcery.com> + + * openmp.c (oacc_is_parallel, oacc_is_kernels): New 'static' + functions. + (resolve_oacc_loop_blocks): Emit an error on orphan OpenACC gang + reductions. + +2021-11-30 Richard Biener <rguenther@suse.de> + + * decl.c (gfc_insert_parameter_exprs): Only return after + resetting type_param_spec_list. + +2021-11-30 Richard Biener <rguenther@suse.de> + + * frontend-passes.c (gfc_expr_walker): Remove unreachable + break. + * scanner.c (skip_fixed_comments): Remove unreachable + gcc_unreachable. + * trans-expr.c (gfc_expr_is_variable): Refactor to make + control flow more obvious. + +2021-11-29 Eric Gallager <egallager@gcc.gnu.org> + + PR other/103021 + * Make-lang.in: Use ETAGS variable in TAGS target. + +2021-11-26 Harald Anlauf <anlauf@gmx.de> + + PR fortran/103411 + * check.c (gfc_check_reshape): Improve check of size of source + array for the RESHAPE intrinsic against the given shape when pad + is not given, and shape is a parameter. Try other simplifications + of shape. + +2021-11-23 Harald Anlauf <anlauf@gmx.de> + + PR fortran/103392 + * simplify.c (simplify_bound): Do not try to simplify + LBOUND/UBOUND for arrays with POINTER or ALLOCATABLE attribute. + +2021-11-23 Harald Anlauf <anlauf@gmx.de> + + PR fortran/87711 + PR fortran/87851 + * trans-array.c (arg_evaluated_for_scalarization): Add LEN_TRIM to + list of intrinsics for which an optional KIND argument needs to be + removed before scalarization. + +2021-11-21 Jakub Jelinek <jakub@redhat.com> + + PR debug/103315 + * trans-types.c (gfc_get_array_descr_info): Use DW_OP_deref_size 1 + instead of DW_OP_deref for DW_AT_rank. + +2021-11-21 Harald Anlauf <anlauf@gmx.de> + Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/99061 + * trans-intrinsic.c (gfc_lookup_intrinsic): Helper function for + looking up gfortran builtin intrinsics. + (gfc_conv_intrinsic_atrigd): Use it. + (gfc_conv_intrinsic_cotan): Likewise. + (gfc_conv_intrinsic_cotand): Likewise. + (gfc_conv_intrinsic_atan2d): Likewise. + +2021-11-18 Harald Anlauf <anlauf@gmx.de> + Steven G. Kargl <kargl@gcc.gnu.org> + + PR fortran/101329 + * check.c (is_c_interoperable): Reject NULL() as it is not + interoperable. + +2021-11-16 Harald Anlauf <anlauf@gmx.de> + + PR fortran/103286 + * resolve.c (resolve_select): Choose appropriate range limit to + avoid NULL pointer dereference when generating error message. + +2021-11-16 Mikael Morin <mikael@gcc.gnu.org> + + * interface.c (gfc_dummy_arg_get_name): New function. + * gfortran.h (gfc_dummy_arg_get_name): Declare it. + * trans-array.c (arg_evaluated_for_scalarization): Pass a dummy + argument wrapper as argument instead of an actual argument + and an index number. Check it’s non-NULL. Use its name + to identify it. + (gfc_walk_elemental_function_args): Update call to + arg_evaluated for scalarization. Remove argument counting. + +2021-11-16 Mikael Morin <mikael@gcc.gnu.org> + + * gfortran.h (gfc_actual_arglist::missing_arg_type): Remove. + * interface.c (gfc_compare_actual_formal): Remove + missing_arg_type initialization. + * intrinsic.c (sort_actual): Ditto. + * trans-expr.c (gfc_conv_procedure_call): Use associated_dummy + and gfc_dummy_arg_get_typespec to get the dummy argument type. + +2021-11-16 Mikael Morin <mikael@gcc.gnu.org> + + * interface.c (gfc_dummy_arg_get_typespec, + gfc_dummy_arg_is_optional): New functions. + * gfortran.h (gfc_dummy_arg_get_typespec, + gfc_dummy_arg_is_optional): Declare them. + * trans.h (gfc_ss_info::dummy_arg): Use the wrapper type + as declaration type. + * trans-array.c (gfc_scalar_elemental_arg_saved_as_reference): + use gfc_dummy_arg_get_typespec function to get the type. + (gfc_walk_elemental_function_args): Remove proc_ifc argument. + Get info about the dummy arg using the associated_dummy field. + * trans-array.h (gfc_walk_elemental_function_args): Update declaration. + * trans-intrinsic.c (gfc_walk_intrinsic_function): + Update call to gfc_walk_elemental_function_args. + * trans-stmt.c (gfc_trans_call): Ditto. + (get_proc_ifc_for_call): Remove. + +2021-11-16 Mikael Morin <mikael@gcc.gnu.org> + + * gfortran.h (gfc_dummy_arg_kind, gfc_dummy_arg): New. + (gfc_actual_arglist): New field associated_dummy. + (gfc_intrinsic_arg): Remove field actual. + * interface.c (get_nonintrinsic_dummy_arg): New. + (gfc_compare_actual): Initialize associated_dummy. + * intrinsic.c (get_intrinsic_dummy_arg): New. + (sort_actual): Add argument vectors. + Use loops with indices on argument vectors. + Initialize associated_dummy. + +2021-11-16 Mikael Morin <mikael@gcc.gnu.org> + + * intrinsic.c (sort_actual): initialise variable and use it earlier. + +2021-11-15 Tobias Burnus <tobias@codesourcery.com> + + * openmp.c (OMP_TARGET_CLAUSES): Add thread_limit. + * trans-openmp.c (gfc_split_omp_clauses): Add thread_limit also to + teams. + +2021-11-12 Tobias Burnus <tobias@codesourcery.com> + + * parse.c (decode_omp_directive): Fix permitting 'nowait' for some + combined directives, add missing 'omp end ... loop'. + (gfc_ascii_statement): Fix ST_OMP_END_TEAMS_LOOP result. + * openmp.c (resolve_omp_clauses): Add missing combined loop constructs + case values to the 'if(directive-name: ...)' check. + * trans-openmp.c (gfc_split_omp_clauses): Put nowait on target if + first leaf construct accepting it. + +2021-11-12 Martin Jambor <mjambor@suse.cz> + + * trans-types.c (gfc_get_array_descr_info): Use build_debug_expr_decl + instead of building DEBUG_EXPR_DECL manually. + +2021-11-12 Mikael Morin <mikael@gcc.gnu.org> + + PR fortran/97896 + * intrinsic.c (add_sym_4ind): Remove. + (add_functions): Use add_sym4 instead of add_sym4ind. + Don’t special case the index intrinsic. + * iresolve.c (gfc_resolve_index_func): Use the individual arguments + directly instead of the full argument list. + * intrinsic.h (gfc_resolve_index_func): Update the declaration + accordingly. + * trans-decl.c (gfc_get_extern_function_decl): Don’t modify the + list of arguments in the case of the index intrinsic. + * trans-array.h (gfc_get_intrinsic_for_expr, + gfc_get_proc_ifc_for_expr): New. + * trans-array.c (gfc_get_intrinsic_for_expr, + arg_evaluated_for_scalarization): New. + (gfc_walk_elemental_function_args): Add intrinsic procedure + as argument. Count arguments. Check arg_evaluated_for_scalarization. + * trans-intrinsic.c (gfc_walk_intrinsic_function): Update call. + * trans-stmt.c (get_intrinsic_for_code): New. + (gfc_trans_call): Update call. + +2021-11-12 Jakub Jelinek <jakub@redhat.com> + + * types.def (BT_FN_VOID_UINT_UINT): Remove. + (BT_FN_BOOL_UINT_UINT_UINT_BOOL): New. + +2021-11-11 Tobias Burnus <tobias@codesourcery.com> + + * gfortran.h (struct gfc_omp_clauses): Rename num_teams to + num_teams_upper, add num_teams_upper. + * dump-parse-tree.c (show_omp_clauses): Update to handle + lower-bound num_teams clause. + * frontend-passes.c (gfc_code_walker): Likewise + * openmp.c (gfc_free_omp_clauses, gfc_match_omp_clauses, + resolve_omp_clauses): Likewise. + * trans-openmp.c (gfc_trans_omp_clauses, gfc_split_omp_clauses, + gfc_trans_omp_target): Likewise. + +2021-11-11 Jakub Jelinek <jakub@redhat.com> + + * trans-openmp.c (gfc_trans_omp_clauses): Use + OMP_CLAUSE_NUM_TEAMS_UPPER_EXPR instead of OMP_CLAUSE_NUM_TEAMS_EXPR. + +2021-11-10 Harald Anlauf <anlauf@gmx.de> + + PR fortran/103137 + PR fortran/103138 + * check.c (gfc_check_shape): Avoid NULL pointer dereference on + missing ref. + * simplify.c (gfc_simplify_cshift): Avoid NULL pointer dereference + when shape not set. + (gfc_simplify_transpose): Likewise. + +2021-11-09 Bernhard Reutner-Fischer <aldot@gcc.gnu.org> + + PR fortran/68800 + * class.c (generate_finalization_wrapper): Do not leak + finalization wrappers if they will not be used. + * expr.c (gfc_free_actual_arglist): Formatting fix. + * gfortran.h (gfc_free_symbol): Pass argument by reference. + (gfc_release_symbol): Likewise. + (gfc_free_namespace): Likewise. + * symbol.c (gfc_release_symbol): Adjust acordingly. + (free_components): Set procedure pointer components + of derived types to NULL after freeing. + (free_tb_tree): Likewise. + (gfc_free_symbol): Set sym to NULL after freeing. + (gfc_free_namespace): Set namespace to NULL after freeing. + +2021-11-09 Martin Liska <mliska@suse.cz> + + * symbol.c (gfc_get_ultimate_derived_super_type): Remove. + +2021-11-09 Aldy Hernandez <aldyh@redhat.com> + + * misc.c (gfc_dummy_typename): Make sure ts->kind is + non-negative. + +2021-11-07 Thomas Koenig <tkoenig@gcc.gnu.org> + + * intrinsic.c (add_subroutines): Change keyword "operator" + to the correct one, "operation". + * check.c (gfc_check_co_reduce): Change OPERATOR to + OPERATION in error messages. + * intrinsic.texi: Change OPERATOR to OPERATION in + documentation. + +2021-11-07 Sandra Loosemore <sandra@codesourcery.com> + + * interface.c (gfc_compare_actual_formal): Continue checking + all arguments after encountering an error. + * intrinsic.c (do_ts29113_check): Likewise. + * resolve.c (resolve_operator): Continue resolving on op2 error. + +2021-11-06 Harald Anlauf <anlauf@gmx.de> + + PR fortran/102715 + * decl.c (add_init_expr_to_sym): Reject rank mismatch between + array and its initializer. + +2021-11-05 Harald Anlauf <anlauf@gmx.de> + + PR fortran/102817 + * expr.c (simplify_parameter_variable): Copy shape of referenced + subobject when simplifying. + +2021-11-05 Harald Anlauf <anlauf@gmx.de> + + PR fortran/69419 + * match.c (gfc_match_common): Check array spec of a symbol in a + COMMON object list and reject it if it is a coarray. + +2021-11-05 Bernhard Reutner-Fischer <aldot@gcc.gnu.org> + + PR fortran/100972 + * decl.c (gfc_match_implicit_none): Fix typo in warning. + * resolve.c (resolve_unknown_f): Reject external procedures + without explicit EXTERNAL attribute whe IMPLICIT none (external) + is in effect. + +2021-11-05 Bernhard Reutner-Fischer <aldot@gcc.gnu.org> + + * decl.c (gfc_insert_kind_parameter_exprs): Make static. + * expr.c (gfc_build_init_expr): Make static + (gfc_build_default_init_expr): Move below its static helper. + * gfortran.h (gfc_insert_kind_parameter_exprs, gfc_add_saved_common, + gfc_add_common, gfc_use_derived_tree, gfc_free_charlen, + gfc_get_ultimate_derived_super_type, + gfc_resolve_oacc_parallel_loop_blocks, gfc_build_init_expr, + gfc_iso_c_sub_interface): Delete. + * symbol.c (gfc_new_charlen, gfc_get_derived_super_type): Make + static. + +2021-11-05 Sandra Loosemore <sandra@codesourcery.com> + + PR fortran/35276 + * gfortran.texi (Mixed-Language Programming): Talk about C++, + and how to link. + +2021-11-04 Sandra Loosemore <sandra@codesourcery.com> + + * gfortran.texi (Projects): Add bullet for helping with + incomplete standards compliance. + (Proposed Extensions): Delete section. + +2021-11-04 Sandra Loosemore <sandra@codesourcery.com> + + * intrinsic.texi (Introduction to Intrinsics): Genericize + references to standard versions. + * invoke.texi (-fall-intrinsics): Likewise. + (-fmax-identifier-length=): Likewise. + +2021-11-04 Sandra Loosemore <sandra@codesourcery.com> + + * gfortran.texi (Interoperability with C): Copy-editing. Add + more index entries. + (Intrinsic Types): Likewise. + (Derived Types and struct): Likewise. + (Interoperable Global Variables): Likewise. + (Interoperable Subroutines and Functions): Likewise. + (Working with C Pointers): Likewise. + (Further Interoperability of Fortran with C): Likewise. Rewrite + to reflect that this is now fully supported by gfortran. + +2021-11-04 Sandra Loosemore <sandra@codesourcery.com> + + * gfortran.texi (About GNU Fortran): Consolidate material + formerly in other sections. Copy-editing. + (Preprocessing and conditional compilation): Delete, moving + most material to invoke.texi. + (GNU Fortran and G77): Delete. + (Project Status): Delete. + (Standards): Update. + (Fortran 95 status): Mention conditional compilation here. + (Fortran 2003 status): Rewrite to mention the 1 missing feature + instead of all the ones implemented. + (Fortran 2008 status): Similarly for the 2 missing features. + (Fortran 2018 status): Rewrite to reflect completion of TS29113 + feature support. + * invoke.texi (Preprocessing Options): Move material formerly + in introductory chapter here. + +2021-11-04 Sandra Loosemore <sandra@codesourcery.com> + + * gfortran.texi (Standards): Move discussion of specific + standard versions here.... + (Fortran standards status): ...from here, and delete this node. + +2021-10-31 Bernhard Reutner-Fischer <aldot@gcc.gnu.org> + + * symbol.c (gfc_get_typebound_proc): Revert memcpy. + +2021-10-31 Bernhard Reutner-Fischer <aldot@gcc.gnu.org> + + * resolve.c (resolve_fl_procedure): Initialize + allocatable_or_pointer. + +2021-10-30 Manfred Schwarb <manfred99@gmx.ch> + + * intrinsic.texi: Remove entries for SHORT and LONG intrinsics. + +2021-10-30 Manfred Schwarb <manfred99@gmx.ch> + + * check.c (gfc_check_intconv): Change error message. + +2021-10-30 Manfred Schwarb <manfred99@gmx.ch> + + * intrinsic.texi (REAL): Fix entries in Specific names table. + +2021-10-30 Manfred Schwarb <manfred99@gmx.ch> + + * intrinsic.texi: Adjust @columnfractions commands to improve + appearance for narrow 80 character terminals. + +2021-10-30 Bernhard Reutner-Fischer <aldot@gcc.gnu.org> + + * parse.c (clean_up_modules): Free gsym. + +2021-10-30 Harald Anlauf <anlauf@gmx.de> + + * gfortran.texi (bug reports): credit Gerhard Steinmetz for + numerous bug reports. + +2021-10-30 Steve Kargl <kargl@gcc.gnu.org> + + PR fortran/99853 + * resolve.c (resolve_select): Generate regular gfc_error on + invalid conversions instead of an gfc_internal_error. + +2021-10-29 Bernhard Reutner-Fischer <aldot@gcc.gnu.org> + + * symbol.c (free_tb_tree): Free type-bound procedure struct. + (gfc_get_typebound_proc): Use explicit memcpy for clarity. + +2021-10-27 Bernhard Reutner-Fischer <aldot@gcc.gnu.org> + + * intrinsic.h (gfc_check_sum, gfc_resolve_atan2d, gfc_resolve_kill, + gfc_resolve_kill_sub): Delete declaration. + +2021-10-27 Bernhard Reutner-Fischer <aldot@gcc.gnu.org> + + * trans-types.h (gfc_convert_function_code): Delete. + +2021-10-27 Bernhard Reutner-Fischer <aldot@gcc.gnu.org> + + * trans-stmt.h (gfc_trans_deallocate_array): Delete. + +2021-10-27 Bernhard Reutner-Fischer <aldot@gcc.gnu.org> + + * trans-array.c (gfc_trans_scalarized_loop_end): Make static. + * trans-array.h (gfc_trans_scalarized_loop_end, + gfc_conv_tmp_ref, gfc_conv_array_transpose): Delete declaration. + +2021-10-27 Bernhard Reutner-Fischer <aldot@gcc.gnu.org> + + * constructor.c (gfc_constructor_get_base): Make static. + (gfc_constructor_expr_foreach, gfc_constructor_swap): Delete. + * constructor.h (gfc_constructor_get_base): Remove declaration. + (gfc_constructor_expr_foreach, gfc_constructor_swap): Delete. + +2021-10-27 Bernhard Reutner-Fischer <aldot@gcc.gnu.org> + + * decl.c (gfc_match_old_kind_spec, set_com_block_bind_c, + set_verify_bind_c_sym, set_verify_bind_c_com_block, + get_bind_c_idents, gfc_match_suffix, gfc_get_type_attr_spec, + check_extended_derived_type): Make static. + (gfc_match_gcc_unroll): Add comment. + * match.c (gfc_match_small_int_expr): Delete definition. + * match.h (gfc_match_small_int_expr): Delete declaration. + (gfc_match_name_C, gfc_match_old_kind_spec, set_com_block_bind_c, + set_verify_bind_c_sym, set_verify_bind_c_com_block, + get_bind_c_idents, gfc_match_suffix, + gfc_get_type_attr_spec): Delete declaration. + +2021-10-27 Bernhard Reutner-Fischer <aldot@gcc.gnu.org> + + * expr.c (is_non_empty_structure_constructor): Make static. + * gfortran.h (gfc_check_any_c_kind): Delete. + * match.c (gfc_match_label): Make static. + * match.h (gfc_match_label): Delete declaration. + * scanner.c (file_changes_cur, file_changes_count, + file_changes_allocated): Make static. + * trans-expr.c (gfc_get_character_len): Make static. + (gfc_class_len_or_zero_get): Make static. + (VTAB_GET_FIELD_GEN): Undefine. + (gfc_get_class_array_ref): Make static. + (gfc_finish_interface_mapping): Make static. + * trans-types.c (gfc_check_any_c_kind): Delete. + (pfunc_type_node, dtype_type_node, gfc_get_ppc_type): Make static. + * trans-types.h (gfc_get_ppc_type): Delete declaration. + * trans.c (gfc_msg_wrong_return): Delete. + * trans.h (gfc_class_len_or_zero_get, gfc_class_vtab_extends_get, + gfc_vptr_extends_get, gfc_get_class_array_ref, gfc_get_character_len, + gfc_finish_interface_mapping, gfc_msg_wrong_return, + gfc_get_function_decl): Delete declaration. + +2021-10-27 Tobias Burnus <tobias@codesourcery.com> + + * trans-stmt.c (gfc_trans_select_rank_cases): Fix condition + for allocatables/pointers. + +2021-10-26 Harald Anlauf <anlauf@gmx.de> + + PR fortran/102956 + * symbol.c (gfc_check_conflict): Add conflict check for PDT KIND + and LEN type parameters. + +2021-10-26 Harald Anlauf <anlauf@gmx.de> + + PR fortran/102917 + * decl.c (match_attr_spec): Remove invalid integer kind checks on + KIND and LEN attributes of PDTs. + +2021-10-26 Harald Anlauf <anlauf@gmx.de> + + PR fortran/102816 + * resolve.c (resolve_structure_cons): Reject invalid array spec of + a DT component referenced in a structure constructor. + +2021-10-26 Tobias Burnus <tobias@codesourcery.com> + + PR fortran/102885 + * trans-decl.c (gfc_conv_cfi_to_gfc): Properly handle nonconstant + character lenghts. + +2021-10-25 Andrew MacLeod <amacleod@redhat.com> + + * trans-decl.c (gfc_conv_cfi_to_gfc): Initialize rank to NULL_TREE. + +2021-10-22 Eric Gallager <egallager@gcc.gnu.org> + + PR other/102663 + * Make-lang.in: Allow dvi-formatted documentation + to be installed. + +2021-10-22 Tobias Burnus <tobias@codesourcery.com> + + PR fortran/92621 + * trans-expr.c (gfc_trans_assignment_1): Add STRIP_NOPS. + +2021-10-21 Chung-Lin Tang <cltang@codesourcery.com> + + * decl.c (gfc_match_end): Add COMP_OMP_STRICTLY_STRUCTURED_BLOCK case + together with COMP_BLOCK. + * parse.c (parse_omp_structured_block): Change return type to + 'gfc_statement', add handling for strictly-structured block case, adjust + recursive calls to parse_omp_structured_block. + (parse_executable): Adjust calls to parse_omp_structured_block. + * parse.h (enum gfc_compile_state): Add + COMP_OMP_STRICTLY_STRUCTURED_BLOCK. + * trans-openmp.c (gfc_trans_omp_workshare): Add EXEC_BLOCK case + handling. + +2021-10-21 Sandra Loosemore <sandra@codesourcery.com> + + PR fortran/94070 + * expr.c (gfc_simplify_expr): Handle GFC_ISYM_SHAPE along with + GFC_ISYM_LBOUND and GFC_ISYM_UBOUND. + * trans-array.c (gfc_conv_ss_startstride): Likewise. + (set_loop_bounds): Likewise. + * trans-intrinsic.c (gfc_trans_intrinsic_bound): Extend to + handle SHAPE. Correct logic for zero-size special cases and + detecting assumed-rank arrays associated with an assumed-size + argument. + (gfc_conv_intrinsic_shape): Deleted. + (gfc_conv_intrinsic_function): Handle GFC_ISYM_SHAPE like + GFC_ISYM_LBOUND and GFC_ISYM_UBOUND. + (gfc_add_intrinsic_ss_code): Likewise. + (gfc_walk_intrinsic_bound): Likewise. + +2021-10-20 Chung-Lin Tang <cltang@codesourcery.com> + + * openmp.c (gfc_match_omp_clause_reduction): Add 'openmp_target' default + false parameter. Add 'always,tofrom' map for OMP_LIST_IN_REDUCTION case. + (gfc_match_omp_clauses): Add 'openmp_target' default false parameter, + adjust call to gfc_match_omp_clause_reduction. + (match_omp): Adjust call to gfc_match_omp_clauses + * trans-openmp.c (gfc_trans_omp_taskgroup): Add call to + gfc_match_omp_clause, create and return block. + +2021-10-19 Tobias Burnus <tobias@codesourcery.com> + + * trans-types.c (create_fn_spec): For allocatable/pointer + character(len=:), use 'w' not 'R' as fn spec for the length dummy + argument. + +2021-10-19 Tobias Burnus <tobias@codesourcery.com> + + PR fortran/92482 + * trans-expr.c (gfc_conv_procedure_call): Use TREE_OPERAND not + build_fold_indirect_ref_loc to undo an ADDR_EXPR. + +2021-10-18 Tobias Burnus <tobias@codesourcery.com> + + PR fortran/102086 + PR fortran/92189 + PR fortran/92621 + PR fortran/101308 + PR fortran/101309 + PR fortran/101635 + PR fortran/92482 + * decl.c (gfc_verify_c_interop_param): Remove 'sorry' for + scalar allocatable/pointer and len=*. + * expr.c (is_CFI_desc): Return true for for those. + * gfortran.h (CFI_type_kind_shift, CFI_type_mask, + CFI_type_from_type_kind, CFI_VERSION, CFI_MAX_RANK, + CFI_attribute_pointer, CFI_attribute_allocatable, + CFI_attribute_other, CFI_type_Integer, CFI_type_Logical, + CFI_type_Real, CFI_type_Complex, CFI_type_Character, + CFI_type_ucs4_char, CFI_type_struct, CFI_type_cptr, + CFI_type_cfunptr, CFI_type_other): New #define. + * trans-array.c (CFI_FIELD_BASE_ADDR, CFI_FIELD_ELEM_LEN, + CFI_FIELD_VERSION, CFI_FIELD_RANK, CFI_FIELD_ATTRIBUTE, + CFI_FIELD_TYPE, CFI_FIELD_DIM, CFI_DIM_FIELD_LOWER_BOUND, + CFI_DIM_FIELD_EXTENT, CFI_DIM_FIELD_SM, + gfc_get_cfi_descriptor_field, gfc_get_cfi_desc_base_addr, + gfc_get_cfi_desc_elem_len, gfc_get_cfi_desc_version, + gfc_get_cfi_desc_rank, gfc_get_cfi_desc_type, + gfc_get_cfi_desc_attribute, gfc_get_cfi_dim_item, + gfc_get_cfi_dim_lbound, gfc_get_cfi_dim_extent, gfc_get_cfi_dim_sm): + New define/functions to access the CFI array descriptor. + (gfc_conv_descriptor_type): New function for the GFC descriptor. + (gfc_get_array_span): Handle expr of CFI descriptors and + assumed-type descriptors. + (gfc_trans_array_bounds): Remove 'static'. + (gfc_conv_expr_descriptor): For assumed type, use the dtype of + the actual argument. + (structure_alloc_comps): Remove ' ' inside tabs. + * trans-array.h (gfc_trans_array_bounds, gfc_conv_descriptor_type, + gfc_get_cfi_desc_base_addr, gfc_get_cfi_desc_elem_len, + gfc_get_cfi_desc_version, gfc_get_cfi_desc_rank, + gfc_get_cfi_desc_type, gfc_get_cfi_desc_attribute, + gfc_get_cfi_dim_lbound, gfc_get_cfi_dim_extent, gfc_get_cfi_dim_sm): + New prototypes. + * trans-decl.c (gfor_fndecl_cfi_to_gfc, gfor_fndecl_gfc_to_cfi): + Remove global vars. + (gfc_build_builtin_function_decls): Remove their initialization. + (gfc_get_symbol_decl, create_function_arglist, + gfc_trans_deferred_vars): Update for CFI. + (convert_CFI_desc): Remove and replace by ... + (gfc_conv_cfi_to_gfc): ... this function + (gfc_generate_function_code): Call it; create local GFC var for CFI. + * trans-expr.c (gfc_maybe_dereference_var): Handle CFI. + (gfc_conv_subref_array_arg): Handle the if-noncontigous-only copy in + when the result should be a descriptor. + (gfc_conv_gfc_desc_to_cfi_desc): Completely rewritten. + (gfc_conv_procedure_call): CFI fixes. + * trans-openmp.c (gfc_omp_is_optional_argument, + gfc_omp_check_optional_argument): Handle optional + CFI. + * trans-stmt.c (gfc_trans_select_rank_cases): Cleanup, avoid invalid + code for allocatable/pointer dummies, which cannot be assumed size. + * trans-types.c (gfc_cfi_descriptor_base): New global var. + (gfc_get_dtype_rank_type): Skip rank init for rank < 0. + (gfc_sym_type): Handle CFI dummies. + (gfc_get_function_type): Update call. + (gfc_get_cfi_dim_type, gfc_get_cfi_type): New. + * trans-types.h (gfc_sym_type): Update prototype. + (gfc_get_cfi_type): New prototype. + * trans.c (gfc_trans_runtime_check): Make conditions more consistent + to avoid '<logical> AND_THEN <long int>' in conditions. + * trans.h (gfor_fndecl_cfi_to_gfc, gfor_fndecl_gfc_to_cfi): Remove + global-var declaration. + +2021-10-18 Tobias Burnus <tobias@codesourcery.com> + + PR fortran/102745 + * intrinsic.c (gfc_convert_type_warn): Fix checks by checking CLASS + and do typcheck in correct order for type extension. + * misc.c (gfc_typename): Print proper not internal CLASS type name. + +2021-10-15 Harald Anlauf <anlauf@gmx.de> + Tobias Burnus <tobias@codesourcery.com> + + PR fortran/102685 + * decl.c (match_clist_expr): Set rank/shape of clist initializer + to match LHS. + * resolve.c (resolve_structure_cons): In a structure constructor, + compare shapes of array components against declared shape. + +2021-10-14 Harald Anlauf <anlauf@gmx.de> + + PR fortran/102717 + * simplify.c (gfc_simplify_reshape): Replace assert by error + message for negative elements in SHAPE array. + +2021-10-14 Harald Anlauf <anlauf@gmx.de> + + PR fortran/102716 + * check.c (gfc_check_shape): Reorder checks so that invalid KIND + arguments can be detected. + +2021-10-14 Kwok Cheung Yeung <kcy@codesourcery.com> + + * gfortran.h (enum gfc_statement): Add ST_OMP_DECLARE_VARIANT. + (enum gfc_omp_trait_property_kind): New. + (struct gfc_omp_trait_property): New. + (gfc_get_omp_trait_property): New macro. + (struct gfc_omp_selector): New. + (gfc_get_omp_selector): New macro. + (struct gfc_omp_set_selector): New. + (gfc_get_omp_set_selector): New macro. + (struct gfc_omp_declare_variant): New. + (gfc_get_omp_declare_variant): New macro. + (struct gfc_namespace): Add omp_declare_variant field. + (gfc_free_omp_declare_variant_list): New prototype. + * match.h (gfc_match_omp_declare_variant): New prototype. + * openmp.c (gfc_free_omp_trait_property_list): New. + (gfc_free_omp_selector_list): New. + (gfc_free_omp_set_selector_list): New. + (gfc_free_omp_declare_variant_list): New. + (gfc_match_omp_clauses): Add extra optional argument. Handle end of + clauses for context selectors. + (omp_construct_selectors, omp_device_selectors, + omp_implementation_selectors, omp_user_selectors): New. + (gfc_match_omp_context_selector): New. + (gfc_match_omp_context_selector_specification): New. + (gfc_match_omp_declare_variant): New. + * parse.c: Include tree-core.h and omp-general.h. + (decode_omp_directive): Handle 'declare variant'. + (case_omp_decl): Include ST_OMP_DECLARE_VARIANT. + (gfc_ascii_statement): Handle ST_OMP_DECLARE_VARIANT. + (gfc_parse_file): Initialize omp_requires_mask. + * symbol.c (gfc_free_namespace): Call + gfc_free_omp_declare_variant_list. + * trans-decl.c (gfc_get_extern_function_decl): Call + gfc_trans_omp_declare_variant. + (gfc_create_function_decl): Call gfc_trans_omp_declare_variant. + * trans-openmp.c (gfc_trans_omp_declare_variant): New. + * trans-stmt.h (gfc_trans_omp_declare_variant): New prototype. + +2021-10-13 Tobias Burnus <tobias@codesourcery.com> + + * dump-parse-tree.c (show_omp_clauses): Handle ancestor modifier, + avoid ICE for GFC_OMP_ATOMIC_SWAP. + * gfortran.h (gfc_omp_clauses): Change 'anecestor' into a bitfield. + +2021-10-12 Tobias Burnus <tobias@codesourcery.com> + + PR fortran/102541 + * check.c (gfc_check_present): Handle optional CLASS. + * interface.c (gfc_compare_actual_formal): Likewise. + * trans-array.c (gfc_trans_g77_array): Likewise. + * trans-decl.c (gfc_build_dummy_array_decl): Likewise. + * trans-types.c (gfc_sym_type): Likewise. + * primary.c (gfc_variable_attr): Fixes for dummy and + pointer when 'class%_data' is passed. + * trans-expr.c (set_dtype_for_unallocated, gfc_conv_procedure_call): + For assumed-rank dummy, fix setting rank for dealloc/notassoc actual + and setting ubound to -1 for assumed-size actuals. + +2021-10-10 Harald Anlauf <anlauf@gmx.de> + + PR fortran/99348 + PR fortran/102521 + * decl.c (add_init_expr_to_sym): Extend initialization of + parameter arrays from scalars to handle derived types. + +2021-10-09 Harald Anlauf <anlauf@gmx.de> + + PR fortran/65454 + * module.c (read_module): Handle old and new-style relational + operators when used in USE module, ONLY: OPERATOR(op). + +2021-10-08 Sandra Loosemore <sandra@codesourcery.com> + + PR fortran/54753 + * interface.c (gfc_compare_actual_formal): Add diagnostic + for F2018:C839. Refactor shared code and fix bugs with class + array info lookup, and extend similar diagnostic from PR94110 + to also cover class types. + +2021-10-08 Martin Liska <mliska@suse.cz> + + * options.c (gfc_post_options): Use new macro + OPTION_SET_P. + +2021-10-06 Tobias Burnus <tobias@codesourcery.com> + + * resolve.c (resolve_values): Only show + deprecated warning if attr.referenced. + +2021-10-04 Tobias Burnus <tobias@codesourcery.com> + + PR fortran/54753 + * resolve.c (can_generate_init, resolve_fl_variable_derived, + resolve_symbol): Only do initialization with intent(out) if not + inside of an interface block. + +2021-10-01 Martin Sebor <msebor@redhat.com> + + PR c/102103 + * array.c: Remove an unnecessary test. + * trans-array.c: Same. + +2021-10-01 Jakub Jelinek <jakub@redhat.com> + + * gfortran.h (gfc_omp_clauses): Add order_reproducible bitfield. + * dump-parse-tree.c (show_omp_clauses): Print REPRODUCIBLE: for it. + * openmp.c (gfc_match_omp_clauses): Set order_reproducible for + explicit reproducible: modifier. + * trans-openmp.c (gfc_trans_omp_clauses): Set + OMP_CLAUSE_ORDER_REPRODUCIBLE for order_reproducible. + (gfc_split_omp_clauses): Also copy order_reproducible. + +2021-09-30 Harald Anlauf <anlauf@gmx.de> + + PR fortran/102458 + * simplify.c (simplify_size): Resolve expressions used in array + specifications so that SIZE can be simplified. + +2021-09-30 Harald Anlauf <anlauf@gmx.de> + + * expr.c: The correct reference to Fortran standard is: F2018:10.1.12. + +2021-09-30 Tobias Burnus <tobias@codesourcery.com> + + PR fortran/71703 + PR fortran/84007 + * trans-intrinsic.c (gfc_conv_same_type_as): Fix handling + of UNLIMITED_POLY. + * trans.h (gfc_vtpr_hash_get): Renamed prototype to ... + (gfc_vptr_hash_get): ... this to match function name. + +2021-09-29 Harald Anlauf <anlauf@gmx.de> + + PR fortran/102520 + * array.c (expand_constructor): Do not dereference NULL pointer. + +2021-09-27 Tobias Burnus <tobias@codesourcery.com> + + PR fortran/94070 + * trans-array.c (gfc_tree_array_size): New function to + find size inline (whole array or one dimension). + (array_parameter_size): Use it, take stmt_block as arg. + (gfc_conv_array_parameter): Update call. + * trans-array.h (gfc_tree_array_size): Add prototype. + * trans-decl.c (gfor_fndecl_size0, gfor_fndecl_size1): Remove + these global vars. + (gfc_build_intrinsic_function_decls): Remove their initialization. + * trans-expr.c (gfc_conv_procedure_call): Update + bounds of pointer/allocatable actual args to nonallocatable/nonpointer + dummies to be one based. + * trans-intrinsic.c (gfc_conv_intrinsic_shape): Fix case for + assumed rank with allocatable/pointer dummy. + (gfc_conv_intrinsic_size): Update to use inline function. + * trans.h (gfor_fndecl_size0, gfor_fndecl_size1): Remove var decl. + +2021-09-26 Tobias Burnus <tobias@codesourcery.com> + + PR fortran/101334 + * trans-intrinsic.c (gfc_conv_associated): Support assumed-rank + 'pointer' with scalar/array 'target' argument. + +2021-09-24 Harald Anlauf <anlauf@gmx.de> + + PR fortran/102458 + * expr.c (is_non_constant_intrinsic): Check for intrinsics + excluded in constant expressions (F2018:10.1.2). + (gfc_is_constant_expr): Use that check. + +2021-09-24 Sandra Loosemore <sandra@codesourcery.com> + + PR fortran/101333 + * interface.c (compare_parameter): Enforce F2018 C711. + +2021-09-24 Tobias Burnus <tobias@codesourcery.com> + + PR fortran/55534 + * scanner.c (load_file): Return void, call (gfc_)fatal_error for + all errors. + (include_line, include_stmt, gfc_new_file): Remove exit call + for failed load_file run. + +2021-09-23 Sandra Loosemore <sandra@codesourcery.com> + + PR fortran/101320 + * decl.c (gfc_verify_c_interop_param): Handle F2018 C1557, + aka TS29113 C516. + +2021-09-23 Harald Anlauf <anlauf@gmx.de> + Tobias Burnus <tobias@codesourcery.com> + + PR fortran/93834 + * trans-intrinsic.c (gfc_conv_allocated): Cleanup. Handle + coindexed scalar coarrays. + +2021-09-23 Sandra Loosemore <sandra@codesourcery.com> + + PR fortran/101319 + * interface.c (gfc_compare_actual_formal): Extend existing + assumed-type diagnostic to also check for argument with type + parameters. + +2021-09-23 Sandra Loosemore <sandra@codesourcery.com> + + PR fortran/101334 + * check.c (gfc_check_associated): Allow an assumed-rank + array for the pointer argument. + * interface.c (compare_parameter): Also give rank mismatch + error on assumed-rank array. + +2021-09-23 Sandra Loosemore <sandra@codesourcery.com> + + * trans-stmt.c (trans_associate_var): Check that result of + GFC_DECL_SAVED_DESCRIPTOR is not null before using it. + +2021-09-22 Tobias Burnus <tobias@codesourcery.com> + + PR fortran/55534 + * cpp.c (gfc_cpp_register_include_paths, gfc_cpp_post_options): + Add new bool verbose_missing_dir_warn argument. + * cpp.h (gfc_cpp_post_options): Update prototype. + * f95-lang.c (gfc_init): Remove duplicated file-not found diag. + * gfortran.h (gfc_check_include_dirs): Takes bool + verbose_missing_dir_warn arg. + (gfc_new_file): Returns now void. + * options.c (gfc_post_options): Update to warn for -I and -J, + only, by default but for all when user requested. + * scanner.c (gfc_do_check_include_dir): + (gfc_do_check_include_dirs, gfc_check_include_dirs): Take bool + verbose warn arg and update to avoid printing the same message + twice or never. + (load_file): Fix indent. + (gfc_new_file): Return void and exit when load_file failed + as all other load_file users do. + +2021-09-22 Tobias Burnus <tobias@codesourcery.com> + + * trans-expr.c (gfc_simple_for_loop): New. + * trans.h (gfc_simple_for_loop): New prototype. + +2021-09-21 Tobias Burnus <tobias@codesourcery.com> + + PR fortran/55534 + * cpp.c: Define GCC_C_COMMON_C for #include "options.h" to make + cpp_reason_option_codes available. + (gfc_cpp_register_include_paths): Make static, set pfile's + warn_missing_include_dirs and move before caller. + (gfc_cpp_init_cb): New, cb code moved from ... + (gfc_cpp_init_0): ... here. + (gfc_cpp_post_options): Call gfc_cpp_init_cb. + (cb_cpp_diagnostic_cpp_option): New. As implemented in c-family + to match CppReason flags to -W... names. + (cb_cpp_diagnostic): Use it to replace single special case. + * cpp.h (gfc_cpp_register_include_paths): Remove as now static. + * gfortran.h (gfc_check_include_dirs): New prototype. + (gfc_add_include_path): Add new bool arg. + * options.c (gfc_init_options): Don't set -Wmissing-include-dirs. + (gfc_post_options): Set it here after commandline processing. Call + gfc_add_include_path with defer_warn=false. + (gfc_handle_option): Call it with defer_warn=true. + * scanner.c (gfc_do_check_include_dir, gfc_do_check_include_dirs, + gfc_check_include_dirs): New. Diagnostic moved from ... + (add_path_to_list): ... here, which came before cmdline processing. + Take additional bool defer_warn argument. + (gfc_add_include_path): Take additional defer_warn arg. + * scanner.h (struct gfc_directorylist): Reorder for alignment issues, + add new 'bool warn'. + +2021-09-20 Tobias Burnus <tobias@codesourcery.com> + + * gfortran.h (gfc_omp_clauses): Add order_unconstrained. + * dump-parse-tree.c (show_omp_clauses): Dump it. + * openmp.c (gfc_match_omp_clauses): Match unconstrained/reproducible + modifiers to ordered(concurrent). + (OMP_DISTRIBUTE_CLAUSES): Accept ordered clause. + (resolve_omp_clauses): Reject ordered + order on same directive. + * trans-openmp.c (gfc_trans_omp_clauses, gfc_split_omp_clauses): Pass + on unconstrained modifier of ordered(concurrent). + +2021-09-17 Harald Anlauf <anlauf@gmx.de> + + PR fortran/102366 + * trans-decl.c (gfc_finish_var_decl): Disable the warning message + for variables moved from stack to static storange if they are + declared in the main, but allow the move to happen. + +2021-09-17 Sandra Loosemore <sandra@codesourcery.com> + + * intrinsic.texi (ISO_C_BINDING): Change C_FLOAT128 to correspond + to _Float128 rather than __float128. + * iso-c-binding.def (c_float128): Update comments. + * trans-intrinsic.c (gfc_builtin_decl_for_float_kind): Likewise. + (build_round_expr): Likewise. + (gfc_build_intrinsic_lib_fndcecls): Likewise. + * trans-types.h (gfc_real16_is_float128): Likewise. + +2021-09-16 Harald Anlauf <anlauf@gmx.de> + + PR fortran/102287 + * trans-expr.c (gfc_conv_procedure_call): Wrap deallocation of + allocatable components of optional allocatable derived type + procedure arguments with INTENT(OUT) into a presence check. + +2021-09-14 Harald Anlauf <anlauf@gmx.de> + + PR fortran/102311 + * resolve.c (resolve_entries): Attempt to recover cleanly after + rejecting mismatched function entries. + +2021-09-14 Tobias Burnus <tobias@codesourcery.com> + + PR fortran/102313 + * parse.c (gfc_ascii_statement): Add missing ST_OMP_END_SCOPE. + +2021-09-13 Harald Anlauf <anlauf@gmx.de> + + 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. + +2021-09-13 Harald Anlauf <anlauf@gmx.de> + + PR fortran/85130 + * expr.c (find_substring_ref): Handle given substring start and + end indices as signed integers, not unsigned. + +2021-09-09 Harald Anlauf <anlauf@gmx.de> + + PR fortran/98490 + * trans-expr.c (gfc_conv_substring): Do not generate substring + bounds check for implied do loop index variable before it actually + becomes defined. + +2021-09-08 liuhongt <hongtao.liu@intel.com> + + * options.c (gfc_post_options): Issue an error for + -fexcess-precision=16. + +2021-09-07 Harald Anlauf <anlauf@gmx.de> + + PR fortran/101327 + * expr.c (find_array_element): When bounds cannot be determined as + constant, return error instead of aborting. + +2021-09-07 Marcel Vollweiler <marcel@codesourcery.com> + + * openmp.c (gfc_match_omp_flush): Parse 'seq_cst' clause on 'flush' + directive. + * trans-openmp.c (gfc_trans_omp_flush): Handle OMP_MEMORDER_SEQ_CST. + +2021-09-03 Tobias Burnus <tobias@codesourcery.com> + + * decl.c (gfc_verify_c_interop_param): Reject pointer with + CONTIGUOUS attributes as dummy arg. Reject character len > 1 + when passed as byte stream. + +2021-09-01 Harald Anlauf <anlauf@gmx.de> + + PR fortran/56985 + * resolve.c (resolve_common_vars): Fix grammar and improve wording + of error message rejecting an unlimited polymorphic in COMMON. + +2021-08-31 Harald Anlauf <anlauf@gmx.de> + + PR fortran/100950 + * simplify.c (substring_has_constant_len): Minimize checks for + substring expressions being allowed. + +2021-08-31 Marcel Vollweiler <marcel@codesourcery.com> + + * gfortran.h: Add variable for 'ancestor' in struct gfc_omp_clauses. + * openmp.c (gfc_match_omp_clauses): Parse device-modifiers 'device_num' + and 'ancestor' in 'target device' clauses. + * trans-openmp.c (gfc_trans_omp_clauses): Set OMP_CLAUSE_DEVICE_ANCESTOR. + +2021-08-30 Harald Anlauf <anlauf@gmx.de> + + PR fortran/102113 + * match.c (gfc_match_goto): Allow for whitespace in parsing list + of labels. + +2021-08-30 Harald Anlauf <anlauf@gmx.de> + + PR fortran/101349 + * resolve.c (resolve_allocate_expr): An unlimited polymorphic + argument to ALLOCATE must be ALLOCATABLE or a POINTER. Fix the + corresponding check. + +2021-08-28 Harald Anlauf <anlauf@gmx.de> + + PR fortran/87737 + * resolve.c (resolve_entries): For functions of type CHARACTER + tighten the checks for matching characteristics. + +2021-08-25 Lewis Hyatt <lhyatt@gmail.com> + + PR other/93067 + * cpp.c (gfc_cpp_post_options): Call new function + diagnostic_initialize_input_context(). + +2021-08-24 Harald Anlauf <anlauf@gmx.de> + + PR fortran/98411 + * trans-decl.c (gfc_finish_var_decl): Adjust check to handle + implicit SAVE as well as variables in the main program. Improve + warning message text. + +2021-08-23 Tobias Burnus <tobias@codesourcery.com> + + * openmp.c (gfc_match_dupl_check, gfc_match_dupl_memorder, + gfc_match_dupl_atomic): New. + (gfc_match_omp_clauses): Use them; remove duplicate + 'release'/'relaxed' clause matching; improve error dignostic + for 'default'. + +2021-08-23 Tobias Burnus <tobias@codesourcery.com> + + * dump-parse-tree.c (show_omp_clauses): Handle 'strict' modifier + on grainsize/num_tasks + * gfortran.h (gfc_omp_clauses): Add grainsize_strict + and num_tasks_strict. + * trans-openmp.c (gfc_trans_omp_clauses, gfc_split_omp_clauses): + Handle 'strict' modifier on grainsize/num_tasks. + * openmp.c (gfc_match_omp_clauses): Likewise. + +2021-08-20 Tobias Burnus <tobias@codesourcery.com> + + * error.c + (error_uinteger): Take 'long long unsigned' instead + of 'long unsigned' as argumpent. + (error_integer): Take 'long long' instead of 'long'. + (error_hwuint, error_hwint): New. + (error_print): Update to handle 'll' and 'w' + length modifiers. + * simplify.c (substring_has_constant_len): Use '%wd' + in gfc_error. + +2021-08-20 Harald Anlauf <anlauf@gmx.de> + + PR fortran/100950 + * simplify.c (substring_has_constant_len): Fix format string of + gfc_error, pass HOST_WIDE_INT bounds values via char buffer. + +2021-08-20 Tobias Burnus <tobias@codesourcery.com> + + * dump-parse-tree.c (show_omp_clauses): Handle 'at', 'severity' + and 'message' clauses. + (show_omp_node, show_code_node): Handle EXEC_OMP_ERROR. + * gfortran.h (gfc_statement): Add ST_OMP_ERROR. + (gfc_omp_severity_type, gfc_omp_at_type): New. + (gfc_omp_clauses): Add 'at', 'severity' and 'message' clause; + use more bitfields + ENUM_BITFIELD. + (gfc_exec_op): Add EXEC_OMP_ERROR. + * match.h (gfc_match_omp_error): New. + * openmp.c (enum omp_mask1): Add OMP_CLAUSE_(AT,SEVERITY,MESSAGE). + (gfc_match_omp_clauses): Handle new clauses. + (OMP_ERROR_CLAUSES, gfc_match_omp_error): New. + (resolve_omp_clauses): Resolve new clauses. + (omp_code_to_statement, gfc_resolve_omp_directive): Handle + EXEC_OMP_ERROR. + * parse.c (decode_omp_directive, next_statement, + gfc_ascii_statement): Handle 'omp error'. + * resolve.c (gfc_resolve_blocks): Likewise. + * st.c (gfc_free_statement): Likewise. + * trans-openmp.c (gfc_trans_omp_error): Likewise. + (gfc_trans_omp_directive): Likewise. + * trans.c (trans_code): Likewise. + +2021-08-20 Jakub Jelinek <jakub@redhat.com> + + * types.def (BT_FN_VOID_CONST_PTR_SIZE): New DEF_FUNCTION_TYPE_2. + * f95-lang.c (ATTR_COLD_NORETURN_NOTHROW_LEAF_LIST): Define. + +2021-08-19 Harald Anlauf <anlauf@gmx.de> + + PR fortran/100950 + * simplify.c (substring_has_constant_len): New. + (gfc_simplify_len): Handle case of substrings with constant + bounds. + +2021-08-18 Tobias Burnus <tobias@codesourcery.com> + + * match.h (gfc_match_omp_nothing): New. + * openmp.c (gfc_match_omp_nothing): New. + * parse.c (decode_omp_directive): Match 'nothing' directive. + +2021-08-17 Tobias Burnus <tobias@codesourcery.com> + + * dump-parse-tree.c (show_omp_node, show_code_node): Handle + EXEC_OMP_SCOPE. + * gfortran.h (enum gfc_statement): Add ST_OMP_(END_)SCOPE. + (enum gfc_exec_op): Add EXEC_OMP_SCOPE. + * match.h (gfc_match_omp_scope): New. + * openmp.c (OMP_SCOPE_CLAUSES): Define + (gfc_match_omp_scope): New. + (gfc_match_omp_cancellation_point, gfc_match_omp_end_nowait): + Improve error diagnostic. + (omp_code_to_statement): Handle ST_OMP_SCOPE. + (gfc_resolve_omp_directive): Handle EXEC_OMP_SCOPE. + * parse.c (decode_omp_directive, next_statement, + gfc_ascii_statement, parse_omp_structured_block, + parse_executable): Handle OpenMP's scope construct. + * resolve.c (gfc_resolve_blocks): Likewise + * st.c (gfc_free_statement): Likewise + * trans-openmp.c (gfc_trans_omp_scope): New. + (gfc_trans_omp_directive): Call it. + * trans.c (trans_code): handle EXEC_OMP_SCOPE. + +2021-08-16 Tobias Burnus <tobias@codesourcery.com> + + * dump-parse-tree.c (show_omp_clauses): Handle 'filter' clause. + (show_omp_node, show_code_node): Handle (combined) omp masked construct. + * frontend-passes.c (gfc_code_walker): Likewise. + * gfortran.h (enum gfc_statement): Add ST_OMP_*_MASKED*. + (enum gfc_exec_op): Add EXEC_OMP_*_MASKED*. + * match.h (gfc_match_omp_masked, gfc_match_omp_masked_taskloop, + gfc_match_omp_masked_taskloop_simd, gfc_match_omp_parallel_masked, + gfc_match_omp_parallel_masked_taskloop, + gfc_match_omp_parallel_masked_taskloop_simd): New prototypes. + * openmp.c (enum omp_mask1): Add OMP_CLAUSE_FILTER. + (gfc_match_omp_clauses): Match it. + (OMP_MASKED_CLAUSES, gfc_match_omp_parallel_masked, + gfc_match_omp_parallel_masked_taskloop, + gfc_match_omp_parallel_masked_taskloop_simd, + gfc_match_omp_masked, gfc_match_omp_masked_taskloop, + gfc_match_omp_masked_taskloop_simd): New. + (resolve_omp_clauses): Resolve filter clause. + (gfc_resolve_omp_parallel_blocks, resolve_omp_do, + omp_code_to_statement, gfc_resolve_omp_directive): Handle + omp masked constructs. + * parse.c (decode_omp_directive, case_exec_markers, + gfc_ascii_statement, parse_omp_do, parse_omp_structured_block, + parse_executable): Likewise. + * resolve.c (gfc_resolve_blocks, gfc_resolve_code): Likewise. + * st.c (gfc_free_statement): Likewise. + * trans-openmp.c (gfc_trans_omp_clauses): Handle filter clause. + (GFC_OMP_SPLIT_MASKED, GFC_OMP_MASK_MASKED): New enum values. + (gfc_trans_omp_masked): New. + (gfc_split_omp_clauses): Handle combined masked directives. + (gfc_trans_omp_master_taskloop): Rename to ... + (gfc_trans_omp_master_masked_taskloop): ... this; handle also + combined masked directives. + (gfc_trans_omp_parallel_master): Rename to ... + (gfc_trans_omp_parallel_master_masked): ... this; handle + combined masked directives. + (gfc_trans_omp_directive): Handle EXEC_OMP_*_MASKED*. + * trans.c (trans_code): Likewise. + +2021-08-15 Harald Anlauf <anlauf@gmx.de> + + PR fortran/99351 + * match.c (sync_statement): Replace %v code by %e in gfc_match to + allow for function references as STAT and ERRMSG arguments. + * resolve.c (resolve_sync): Adjust checks of STAT= and ERRMSG= to + being definable arguments. Function references with a data + pointer result are accepted. + * trans-stmt.c (gfc_trans_sync): Adjust assertion. + +2021-08-12 Tobias Burnus <tobias@codesourcery.com> + + * gfortran.h (gfc_omp_proc_bind_kind): Add OMP_PROC_BIND_PRIMARY. + * dump-parse-tree.c (show_omp_clauses): Add TODO comment to + change 'master' to 'primary' in proc_bind for OpenMP 5.1. + * intrinsic.texi (OMP_LIB): Mention OpenMP 5.1; add + omp_proc_bind_primary. + * openmp.c (gfc_match_omp_clauses): Accept + 'primary' as alias for 'master'. + * trans-openmp.c (gfc_trans_omp_clauses): Handle + OMP_PROC_BIND_PRIMARY. + +2021-08-11 Sandra Loosemore <sandra@codesourcery.com> + + * iso-c-binding.def (c_float128, c_float128_complex): Check + float128_type_node instead of gfc_float128_type_node. + * trans-types.c (gfc_init_kinds, gfc_build_real_type): + Update comments re supported 128-bit floating-point types. + +2021-08-11 Richard Biener <rguenther@suse.de> + + * trans-common.c (create_common): Set TREE_THIS_VOLATILE on the + COMPONENT_REF if the field is volatile. + +2021-08-07 Harald Anlauf <anlauf@gmx.de> + + PR fortran/68568 + * primary.c (gfc_expr_attr): Variable attribute can only be + inquired when symtree is non-NULL. + +2021-07-28 Harald Anlauf <anlauf@gmx.de> + + PR fortran/101564 + * expr.c (gfc_check_vardef_context): Add check for KIND and LEN + parameter inquiries. + * match.c (gfc_match): Fix comment for %v code. + (gfc_match_allocate, gfc_match_deallocate): Replace use of %v code + by %e in gfc_match to allow for function references as STAT and + ERRMSG arguments. + * resolve.c (resolve_allocate_deallocate): Avoid NULL pointer + dereferences and shortcut for bad STAT and ERRMSG argument to + (DE)ALLOCATE. Remove bogus parts of checks for STAT and ERRMSG. + +2021-07-26 José Rui Faustino de Sousa <jrfsousa@gmail.com> + Tobias Burnus <tobias@codesourcery.com> + + PR fortran/93308 + PR fortran/93963 + PR fortran/94327 + PR fortran/94331 + PR fortran/97046 + * trans-decl.c (convert_CFI_desc): Only copy out the descriptor + if necessary. + * trans-expr.c (gfc_conv_gfc_desc_to_cfi_desc): Updated attribute + handling which reflect a previous intermediate version of the + standard. Only copy out the descriptor if necessary. + +2021-07-23 Harald Anlauf <anlauf@gmx.de> + + PR fortran/101536 + * check.c (array_check): Adjust check for the case of CLASS + arrays. + +2021-07-21 Thomas Schwinge <thomas@codesourcery.com> + Joseph Myers <joseph@codesourcery.com> + Cesar Philippidis <cesar@codesourcery.com> + + * dump-parse-tree.c (show_attr): Update. + * gfortran.h (symbol_attribute): Add 'oacc_routine_nohost' member. + (gfc_omp_clauses): Add 'nohost' member. + * module.c (ab_attribute): Add 'AB_OACC_ROUTINE_NOHOST'. + (attr_bits, mio_symbol_attribute): Update. + * openmp.c (omp_mask2): Add 'OMP_CLAUSE_NOHOST'. + (gfc_match_omp_clauses): Handle 'OMP_CLAUSE_NOHOST'. + (OACC_ROUTINE_CLAUSES): Add 'OMP_CLAUSE_NOHOST'. + (gfc_match_oacc_routine): Update. + * trans-decl.c (add_attributes_to_decl): Update. + * trans-openmp.c (gfc_trans_omp_clauses): Likewise. + +2021-07-21 Harald Anlauf <anlauf@gmx.de> + + PR fortran/101514 + * target-memory.c (gfc_interpret_derived): Size of array component + of derived type can only be computed here for explicit shape. + * trans-types.c (gfc_get_nodesc_array_type): Do not dereference + NULL pointers. + +2021-07-21 Tobias Burnus <tobias@codesourcery.com> + + * 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. + +2021-07-18 Harald Anlauf <anlauf@gmx.de> + + PR fortran/101084 + * io.c (resolve_tag_format): Extend FORMAT check to unknown type. + +2021-07-14 Harald Anlauf <anlauf@gmx.de> + + PR fortran/100949 + * trans-expr.c (gfc_trans_class_init_assign): Call + gfc_conv_expr_present only for dummy variables. + +2021-07-06 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/100227 + * frontend-passes.c (traverse_io_block): Adjust test for + when a variable is eligible for the transformation to + array slice. + +2021-06-28 Martin Sebor <msebor@redhat.com> + + * trans-array.c (trans_array_constructor): Replace direct uses + of TREE_NO_WARNING with warning_suppressed_p, and suppress_warning. + * trans-decl.c (gfc_build_qualified_array): Same. + (gfc_build_dummy_array_decl): Same. + (generate_local_decl): Same. + (gfc_generate_function_code): Same. + * trans-openmp.c (gfc_omp_clause_default_ctor): Same. + (gfc_omp_clause_copy_ctor): Same. + * trans-types.c (get_dtype_type_node): Same. + (gfc_get_desc_dim_type): Same. + (gfc_get_array_descriptor_base): Same. + (gfc_get_caf_vector_type): Same. + (gfc_get_caf_reference_type): Same. + * trans.c (gfc_create_var_np): Same. + +2021-06-23 Tobias Burnus <tobias@codesourcery.com> + + * dump-parse-tree.c (show_omp_clauses): Fix enum type used + for dumping gfc_omp_defaultmap_category. + +2021-06-23 Andre Vehreschild <vehre@gcc.gnu.org> + + PR fortran/100337 + * trans-intrinsic.c (conv_co_collective): Check stat for null ptr + before dereferrencing. + +2021-06-18 Harald Anlauf <anlauf@gmx.de> + + PR fortran/100283 + PR fortran/101123 + * trans-intrinsic.c (gfc_conv_intrinsic_minmax): Unconditionally + convert result of min/max to result type. + +2021-06-16 Harald Anlauf <anlauf@gmx.de> + + PR fortran/95501 + PR fortran/95502 + * expr.c (gfc_check_pointer_assign): Avoid NULL pointer + dereference. + * match.c (gfc_match_pointer_assignment): Likewise. + * parse.c (gfc_check_do_variable): Avoid comparison with NULL + symtree. + +2021-06-16 Harald Anlauf <anlauf@gmx.de> + + Revert: + 2021-06-16 Harald Anlauf <anlauf@gmx.de> + + PR fortran/95501 + PR fortran/95502 + * expr.c (gfc_check_pointer_assign): Avoid NULL pointer + dereference. + * match.c (gfc_match_pointer_assignment): Likewise. + * parse.c (gfc_check_do_variable): Avoid comparison with NULL + symtree. + +2021-06-16 Harald Anlauf <anlauf@gmx.de> + + PR fortran/95501 + PR fortran/95502 + * expr.c (gfc_check_pointer_assign): Avoid NULL pointer + dereference. + * match.c (gfc_match_pointer_assignment): Likewise. + * parse.c (gfc_check_do_variable): Avoid comparison with NULL + symtree. + +2021-06-15 Tobias Burnus <tobias@codesourcery.com> + + PR fortran/92568 + * dump-parse-tree.c (show_omp_clauses): Update for defaultmap. + * f95-lang.c (LANG_HOOKS_OMP_ALLOCATABLE_P, + LANG_HOOKS_OMP_SCALAR_TARGET_P): New. + * gfortran.h (enum gfc_omp_defaultmap, + enum gfc_omp_defaultmap_category): New. + * openmp.c (gfc_match_omp_clauses): Update defaultmap matching. + * trans-decl.c (gfc_finish_decl_attrs): Set GFC_DECL_SCALAR_TARGET. + * trans-openmp.c (gfc_omp_allocatable_p, gfc_omp_scalar_target_p): New. + (gfc_omp_scalar_p): Take 'ptr_alloc_ok' argument. + (gfc_trans_omp_clauses, gfc_split_omp_clauses): Update for + defaultmap changes. + * trans.h (gfc_omp_scalar_p): Update prototype. + (gfc_omp_allocatable_p, gfc_omp_scalar_target_p): New. + (struct lang_decl): Add scalar_target. + (GFC_DECL_SCALAR_TARGET, GFC_DECL_GET_SCALAR_TARGET): New. + +2021-06-14 Tobias Burnus <tobias@codesourcery.com> + + * resolve.c (resolve_variable): Remove *XCNEW used to + nullify nullified memory. + +2021-06-09 Martin Liska <mliska@suse.cz> + + * intrinsic.texi: Add missing @headitem to tables with a header. + +2021-06-09 Jakub Jelinek <jakub@redhat.com> + + PR fortran/100965 + * trans-openmp.c (gfc_omp_finish_clause): Gimplify OMP_CLAUSE_SIZE. + +2021-06-08 Tobias Burnus <tobias@codesourcery.com> + + PR middle-end/99928 + * trans-openmp.c (gfc_add_clause_implicitly): New. + (gfc_split_omp_clauses): Use it. + (gfc_free_split_omp_clauses): New. + (gfc_trans_omp_do_simd, gfc_trans_omp_parallel_do, + gfc_trans_omp_parallel_do_simd, gfc_trans_omp_distribute, + gfc_trans_omp_teams, gfc_trans_omp_target, gfc_trans_omp_taskloop, + gfc_trans_omp_master_taskloop, gfc_trans_omp_parallel_master): Use it. + +2021-06-08 Martin Liska <mliska@suse.cz> + + * intrinsic.texi: Fix typo. + * trans-expr.c (gfc_trans_pointer_assignment): Likewise. + +2021-06-05 José Rui Faustino de Sousa <jrfsousa@gmail.com> + + PR fortran/100120 + PR fortran/100816 + PR fortran/100818 + PR fortran/100819 + PR fortran/100821 + * trans-array.c (gfc_get_array_span): rework the way character + array "span" was calculated. + (gfc_conv_expr_descriptor): improve handling of character sections + and unlimited polymorphic objects. + * trans-expr.c (gfc_get_character_len): new function to calculate + character string length. + (gfc_get_character_len_in_bytes): new function to calculate + character string length in bytes. + (gfc_conv_scalar_to_descriptor): add call to set the "span". + (gfc_trans_pointer_assignment): set "_len" and antecipate the + initialization of the deferred character length hidden argument. + * trans-intrinsic.c (gfc_conv_associated): set "force_no_tmp" to + avoid the creation of a temporary. + * trans-types.c (gfc_get_dtype_rank_type): rework type detection + so that unlimited polymorphic objects get proper type infomation, + also important for bind(c). + (gfc_get_dtype): add argument to pass the rank if necessary. + (gfc_get_array_type_bounds): cosmetic change to have character + arrays called character instead of unknown. + * trans-types.h (gfc_get_dtype): modify prototype. + * trans.c (get_array_span): rework the way character array "span" + was calculated. + * trans.h (gfc_get_character_len): new prototype. + (gfc_get_character_len_in_bytes): new prototype. + Add "unlimited_polymorphic" flag to "gfc_se" type to signal when + expression carries an unlimited polymorphic object. + +2021-06-04 Harald Anlauf <anlauf@gmx.de> + + PR fortran/99839 + * frontend-passes.c (inline_matmul_assign): Do not inline matmul + if the assignment to the resulting array if it is not of canonical + type (real/integer/complex/logical). + +2021-06-04 Tobias Burnus <tobias@codesourcery.com> + + * dump-parse-tree.c (show_code_node): Handle + EXEC_OMP_(TARGET_)(,PARALLEL_,TEAMS_)LOOP. + +2021-06-04 Tobias Burnus <tobias@codesourcery.com> + + * scanner.c (skip_fixed_omp_sentinel): Set openacc_flag if + this is not an (OpenMP) continuation line. + (skip_fixed_oacc_sentinel): Likewise for openmp_flag and OpenACC. + (gfc_next_char_literal): gfc_error_now to force error for mixed OMP/ACC + continuation once per location and return '\n'. + +2021-06-04 Tobias Burnus <tobias@codesourcery.com> + + PR middle-end/99928 + * openmp.c (gfc_match_omp_clauses): Fix typo in error message. + +2021-06-04 Tobias Burnus <tobias@codesourcery.com> + + PR middle-end/99928 + * dump-parse-tree.c (show_omp_clauses): Handle bind clause. + (show_omp_node): Handle loop directive. + * frontend-passes.c (gfc_code_walker): Likewise. + * gfortran.h (enum gfc_statement): Add + ST_OMP_(END_)(TARGET_)(|PARALLEL_|TEAMS_)LOOP. + (enum gfc_omp_bind_type): New. + (gfc_omp_clauses): Use it. + (enum gfc_exec_op): Add EXEC_OMP_(TARGET_)(|PARALLEL_|TEAMS_)LOOP. + * match.h (gfc_match_omp_loop, gfc_match_omp_parallel_loop, + gfc_match_omp_target_parallel_loop, gfc_match_omp_target_teams_loop, + gfc_match_omp_teams_loop): New. + * openmp.c (enum omp_mask1): Add OMP_CLAUSE_BIND. + (gfc_match_omp_clauses): Handle it. + (OMP_LOOP_CLAUSES, gfc_match_omp_loop, gfc_match_omp_teams_loop, + gfc_match_omp_target_teams_loop, gfc_match_omp_parallel_loop, + gfc_match_omp_target_parallel_loop): New. + (resolve_omp_clauses, resolve_omp_do, omp_code_to_statement, + gfc_resolve_omp_directive): Handle omp loop. + * parse.c (decode_omp_directive case_exec_markers, gfc_ascii_statement, + parse_omp_do, parse_executable): Likewise. + (parse_omp_structured_block): Remove ST_ which use parse_omp_do. + * resolve.c (gfc_resolve_blocks): Add omp loop. + * st.c (gfc_free_statement): Likewise. + * trans-openmp.c (gfc_trans_omp_clauses): Handle bind clause. + (gfc_trans_omp_do, gfc_trans_omp_parallel_do, gfc_trans_omp_distribute, + gfc_trans_omp_teams, gfc_trans_omp_target, gfc_trans_omp_directive): + Handle loop directive. + (gfc_split_omp_clauses): Likewise; fix firstprivate/lastprivate + and (in_)reduction for taskloop. + * trans.c (trans_code): Handle omp loop directive. + +2021-06-01 Tobias Burnus <tobias@codesourcery.com> + + PR middle-end/99928 + * dump-parse-tree.c (show_omp_node, show_code_node): Handle + (parallel) master taskloop (simd). + * frontend-passes.c (gfc_code_walker): Set in_omp_workshare + to false for parallel master taskloop (simd). + * gfortran.h (enum gfc_statement): + Add ST_OMP_(END_)(PARALLEL_)MASTER_TASKLOOP(_SIMD). + (enum gfc_exec_op): EXEC_OMP_(PARALLEL_)MASTER_TASKLOOP(_SIMD). + * match.h (gfc_match_omp_master_taskloop, + gfc_match_omp_master_taskloop_simd, + gfc_match_omp_parallel_master_taskloop, + gfc_match_omp_parallel_master_taskloop_simd): New prototype. + * openmp.c (gfc_match_omp_parallel_master_taskloop, + gfc_match_omp_parallel_master_taskloop_simd, + gfc_match_omp_master_taskloop, + gfc_match_omp_master_taskloop_simd): New. + (gfc_match_omp_taskloop_simd): Permit 'reduction' clause. + (resolve_omp_clauses): Handle new combined directives; remove + inscan-reduction check to reduce multiple errors; add + task-reduction error for 'taskloop simd'. + (gfc_resolve_omp_parallel_blocks, + resolve_omp_do, omp_code_to_statement, + gfc_resolve_omp_directive): Handle new combined constructs. + * parse.c (decode_omp_directive, next_statement, + gfc_ascii_statement, parse_omp_do, parse_omp_structured_block, + parse_executable): Likewise. + * resolve.c (gfc_resolve_blocks, gfc_resolve_code): Likewise. + * st.c (gfc_free_statement): Likewise. + * trans.c (trans_code): Likewise. + * trans-openmp.c (gfc_split_omp_clauses, + gfc_trans_omp_directive): Likewise. + (gfc_trans_omp_parallel_master): Move after gfc_trans_omp_master_taskloop; + handle parallel master taskloop (simd) as well. + (gfc_trans_omp_taskloop): Take gfc_exec_op as arg. + (gfc_trans_omp_master_taskloop): New. + +2021-05-30 Gerald Pfeifer <gerald@pfeifer.com> + + * gfortran.texi (BOZ literal constants): Fix typo. + +2021-05-28 Tobias Burnus <tobias@codesourcery.com> + + * dump-parse-tree.c (show_iterator): New. + (show_omp_namelist): Handle iterators. + (show_omp_clauses): Handle affinity. + * gfortran.h (gfc_free_omp_namelist): New union with 'udr' and new 'ns'. + * match.c (gfc_free_omp_namelist): Add are to choose union element. + * openmp.c (gfc_free_omp_clauses, gfc_match_omp_detach, + gfc_match_omp_clause_reduction, gfc_match_omp_flush): Update + call to gfc_free_omp_namelist. + (gfc_match_omp_variable_list): Likewise; permit preceeding whitespace. + (enum omp_mask1): Add OMP_CLAUSE_AFFINITY. + (gfc_match_iterator): New. + (gfc_match_omp_clauses): Use it; update call to gfc_free_omp_namelist. + (OMP_TASK_CLAUSES): Add OMP_CLAUSE_AFFINITY. + (gfc_match_omp_taskwait): Match depend clause. + (resolve_omp_clauses): Handle affinity; update for udr/union change. + (gfc_resolve_omp_directive): Resolve clauses of taskwait. + * st.c (gfc_free_statement): Update gfc_free_omp_namelist call. + * trans-openmp.c (gfc_trans_omp_array_reduction_or_udr): Likewise + (handle_iterator): New. + (gfc_trans_omp_clauses): Handle iterators for depend/affinity clause. + (gfc_trans_omp_taskwait): Handle depend clause. + (gfc_trans_omp_directive): Update call. + +2021-05-27 Harald Anlauf <anlauf@gmx.de> + + PR fortran/100602 + * trans-intrinsic.c (gfc_conv_intrinsic_size): Use CLASS data + attributes for CLASS arrays for generation of runtime error. + +2021-05-27 Harald Anlauf <anlauf@gmx.de> + + PR fortran/100656 + * trans-array.c (gfc_conv_ss_startstride): Do not call check for + presence of a dummy argument when a symbol actually refers to a + non-dummy. + +2021-05-25 Tobias Burnus <tobias@codesourcery.com> + Johannes Nendwich <a08727063@unet.univie.ac.at> + + * intrinsic.texi (GERROR, GETARGS, GETLOG, NORM2, PARITY, RANDOM_INIT, + RANDOM_NUMBER): Fix typos and copy'n'paste errors. + +2021-05-24 Tobias Burnus <tobias@codesourcery.com> + + PR fortran/86470 + * trans-expr.c (gfc_copy_class_to_class): Add unshare_expr. + * trans-openmp.c (gfc_is_polymorphic_nonptr, + gfc_is_unlimited_polymorphic_nonptr): New. + (gfc_omp_clause_copy_ctor, gfc_omp_clause_dtor): Handle + polymorphic scalars. + +2021-05-23 Harald Anlauf <anlauf@gmx.de> + + PR fortran/100551 + * trans-expr.c (gfc_conv_procedure_call): Adjust check for + implicit conversion of actual argument to an unlimited polymorphic + procedure argument. + +2021-05-23 Tobias Burnus <tobias@codesourcery.com> + + * intrinsic.texi (ATOMIC_ADD, ATOMIC_FETCH_ADD): Use the + proper variable name in the description. + +2021-05-22 Andre Vehreschild <vehre@gcc.gnu.org> + Steve Kargl <kargl@gcc.gnu.org> + + PR fortran/98301 + * trans-decl.c (gfc_build_builtin_function_decls): Move decl. + * trans-intrinsic.c (conv_intrinsic_random_init): Use bool for + lib-call of caf_random_init instead of logical (4-byte). + * trans.h: Add tree var for random_init. + +2021-05-20 Marcel Vollweiler <marcel@codesourcery.com> + + * openmp.c (gfc_match_omp_clauses): Support map-type-modifier 'close'. + +2021-05-18 Tobias Burnus <tobias@codesourcery.com> + + PR fortran/100642 + * openmp.c (omp_code_to_statement): Add missing EXEC_OMP_DEPOBJ. + +2021-05-17 Harald Anlauf <anlauf@gmx.de> + + PR fortran/98411 + * trans-decl.c (gfc_finish_var_decl): Add check for explicit SAVE + attribute. + +2021-05-17 Tobias Burnus <tobias@codesourcery.com> + + PR fortran/100633 + * resolve.c (gfc_resolve_code): Reject nonintrinsic assignments in + OMP WORKSHARE. + +2021-05-14 Tobias Burnus <tobias@codesourcery.com> + + * dump-parse-tree.c (show_omp_node, show_code_node): Handle + EXEC_OMP_PARALLEL_MASTER. + * frontend-passes.c (gfc_code_walker): Likewise. + * gfortran.h (enum gfc_statement): Add ST_OMP_PARALLEL_MASTER and + ST_OMP_END_PARALLEL_MASTER. + (enum gfc_exec_op): Add EXEC_OMP_PARALLEL_MASTER.. + * match.h (gfc_match_omp_parallel_master): Handle it. + * openmp.c (gfc_match_omp_parallel_master, resolve_omp_clauses, + omp_code_to_statement, gfc_resolve_omp_directive): Likewise. + * parse.c (decode_omp_directive, case_exec_markers, + gfc_ascii_statement, parse_omp_structured_block, + parse_executable): Likewise. + * resolve.c (gfc_resolve_blocks, gfc_resolve_code): Likewise. + * st.c (gfc_free_statement): Likewise. + * trans-openmp.c (gfc_trans_omp_parallel_master, + gfc_trans_omp_workshare, gfc_trans_omp_directive): Likewise. + * trans.c (trans_code): Likewise. + +2021-05-14 Tobias Burnus <tobias@codesourcery.com> + + * resolve.c (resolve_symbol): Handle implicit SAVE of main-program + for vars in 'omp threadprivate' and 'omp declare target'. + +2021-05-10 Martin Liska <mliska@suse.cz> + + * 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. + +2021-05-06 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/46991 + PR fortran/99819 + * class.c (gfc_build_class_symbol): Remove the error that + disables assumed size class arrays. Class array types that are + not deferred shape or assumed rank are given a unique name and + placed in the procedure namespace. + * trans-array.c (gfc_trans_g77_array): Obtain the data pointer + for class arrays. + (gfc_trans_dummy_array_bias): Suppress the runtime error for + extent violations in explicit shape class arrays because it + always fails. + * trans-expr.c (gfc_conv_procedure_call): Handle assumed size + class actual arguments passed to non-descriptor formal args by + using the data pointer, stored as the symbol's backend decl. + +2021-05-05 Harald Anlauf <anlauf@gmx.de> + + PR fortran/100274 + * interface.c (gfc_compare_actual_formal): Continue checks after + emitting warning for argument length mismatch. + * trans-expr.c (gfc_conv_procedure_call): Check for NULL pointer + dereference. + +2021-05-04 Tobias Burnus <tobias@codesourcery.com> + + PR testsuite/100397 + * trans-openmp.c (gfc_trans_omp_depobj): Fix pasto in enum values. + +2021-04-28 Tobias Burnus <tobias@codesourcery.com> + + * openmp.c (gfc_match_omp_variable_list): Gobble whitespace before + checking whether a '%' or parenthesis-open follows as next character. + +2021-04-28 José Rui Faustino de Sousa <jrfsousa@gmail.com> + + PR fortran/82376 + * trans-expr.c (gfc_conv_procedure_call): Evaluate function result + and then pass a pointer. + +2021-04-26 Thomas Schwinge <thomas@codesourcery.com> + Nathan Sidwell <nathan@codesourcery.com> + Tom de Vries <vries@codesourcery.com> + Julian Brown <julian@codesourcery.com> + Kwok Cheung Yeung <kcy@codesourcery.com> + + * lang.opt (Wopenacc-parallelism): New. + +2021-04-24 Harald Anlauf <anlauf@gmx.de> + + PR fortran/100154 + * check.c (variable_check): Allow function reference having a data + pointer result. + (arg_strlen_is_zero): New function. + (gfc_check_fgetputc_sub): Add static check of character and status + arguments. + (gfc_check_fgetput_sub): Likewise. + * intrinsic.c (add_subroutines): Fix argument name for the + character argument to intrinsic subroutines fget[c], fput[c]. + +2021-04-24 Harald Anlauf <anlauf@gmx.de> + + PR fortran/100218 + * expr.c (gfc_check_vardef_context): Extend check to allow pointer + from a function reference. + +2021-04-22 Martin Liska <mliska@suse.cz> + + PR testsuite/100159 + PR testsuite/100192 + * frontend-passes.c (optimize_expr): Fix typos and missing comments. + +2021-04-22 Michael Meissner <meissner@linux.ibm.com> + + PR fortran/96983 + * trans-intrinsic.c (build_round_expr): If int type is larger than + long long, do the round and convert to the integer type. Do not + try to find a floating point type the exact size of the integer + type. + +2021-04-21 Tobias Burnus <tobias@codesourcery.com> + + * dump-parse-tree.c (show_omp_namelist): Handle depobj + mutexinoutset + in the depend clause. + (show_omp_clauses, show_omp_node, show_code_node): Handle depobj. + * gfortran.h (enum gfc_statement): Add ST_OMP_DEPOBJ. + (enum gfc_omp_depend_op): Add OMP_DEPEND_UNSET, + OMP_DEPEND_MUTEXINOUTSET and OMP_DEPEND_DEPOBJ. + (gfc_omp_clauses): Add destroy, depobj_update and depobj. + (enum gfc_exec_op): Add EXEC_OMP_DEPOBJ + * match.h (gfc_match_omp_depobj): Match 'omp depobj'. + * openmp.c (gfc_match_omp_clauses): Add depobj + mutexinoutset + to depend clause. + (gfc_match_omp_depobj, resolve_omp_clauses, gfc_resolve_omp_directive): + Handle 'omp depobj'. + * parse.c (decode_omp_directive, next_statement, gfc_ascii_statement): + Likewise. + * resolve.c (gfc_resolve_code): Likewise. + * st.c (gfc_free_statement): Likewise. + * trans-openmp.c (gfc_trans_omp_clauses): Handle depobj + mutexinoutset + in the depend clause. + (gfc_trans_omp_depobj, gfc_trans_omp_directive): Handle EXEC_OMP_DEPOBJ. + * trans.c (trans_code): Likewise. + +2021-04-20 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/100110 + * trans-decl.c (gfc_get_symbol_decl): Replace test for host + association with a check that the current and symbol namespaces + are the same. + +2021-04-19 Thomas Schwinge <thomas@codesourcery.com> + + * lang.opt (fopenacc-kernels=): Remove. + +2021-04-16 José Rui Faustino de Sousa <jrfsousa@gmail.com> + + PR fortran/100094 + * trans-array.c (gfc_trans_deferred_array): Add code to initialize + pointers and allocatables with correct TKR parameters. + +2021-04-16 José Rui Faustino de Sousa <jrfsousa@gmail.com> + + PR fortran/100018 + * resolve.c: Add association check before de-referencing pointer. + +2021-04-16 Harald Anlauf <anlauf@gmx.de> + Paul Thomas <pault@gcc.gnu.org> + + PR fortran/63797 + * module.c (write_symtree): Do not write interface of intrinsic + procedure to module file for F2003 and newer. + +2021-04-15 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/99307 + * symbol.c: Remove trailing white space. + * trans-array.c (gfc_trans_create_temp_array): Create a class + temporary for class expressions and assign the new descriptor + to the data field. + (build_class_array_ref): If the class expr can be extracted, + then use that for 'decl'. Class function results are reliably + handled this way. Call gfc_find_and_cut_at_last_class_ref to + eliminate largely redundant code. Remove dead code and recast + the rest of the code to extract 'decl' for remaining cases. + Call gfc_build_spanned_array_ref. + (gfc_alloc_allocatable_for_assignment): Use class descriptor + element length for 'elemsize1'. Eliminate repeat set of dtype + for class expressions. + * trans-expr.c (gfc_find_and_cut_at_last_class_ref): Include + additional code from build_class_array_ref, and use optional + gfc_typespec pointer argument. + (gfc_trans_scalar_assign): Make use of pre and post blocks for + all class expressions. + * trans.c (get_array_span): For unlimited polymorphic exprs + multiply the span by the value of the _len field. + (gfc_build_spanned_array_ref): New function. + (gfc_build_array_ref): Call gfc_build_spanned_array_ref and + eliminate repeated code. + * trans.h: Add arg to gfc_find_and_cut_at_last_class_ref and + add prototype for gfc_build_spanned_array_ref. + +2021-04-14 Martin Liska <mliska@suse.cz> + + * intrinsic.texi: The table has first column empty and it makes + trouble when processing makeinfo --xml output. + +2021-04-09 Tobias Burnus <tobias@codesourcery.com> + + PR fortran/99817 + * trans-types.c (gfc_get_function_type): Also generate hidden + coarray argument for character arguments. + +2021-04-03 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/99818 + * interface.c (compare_parameter): The codimension attribute is + applied to the _data field of class formal arguments. + +2021-04-01 Harald Anlauf <anlauf@gmx.de> + + PR fortran/99840 + * simplify.c (gfc_simplify_transpose): Properly initialize + resulting shape. + +2021-03-28 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/99602 + * trans-expr.c (gfc_conv_procedure_call): Use the _data attrs + for class expressions and detect proc pointer evaluations by + the non-null actual argument list. + +2021-03-27 Steve Kargl <kargl@gcc.gnu.org> + + * misc.c (gfc_typename): Fix off-by-one in buffer sizes. + +2021-03-26 Tobias Burnus <tobias@codesourcery.com> + + PR fortran/99651 + * intrinsic.c (gfc_intrinsic_func_interface): Set + attr.proc = PROC_INTRINSIC if FL_PROCEDURE. + +2021-03-24 Tobias Burnus <tobias@codesourcery.com> + + PR fortran/99369 + * resolve.c (resolve_operator): Make 'msg' buffer larger + and use snprintf. + +2021-03-23 Tobias Burnus <tobias@codesourcery.com> + + PR fortran/93660 + * trans-decl.c (build_function_decl): Add comment; + increment hidden_typelist for caf_token/caf_offset. + * trans-types.c (gfc_get_function_type): Add comment; + add missing caf_token/caf_offset args. + +2021-03-22 Tobias Burnus <tobias@codesourcery.com> + + PR fortran/99688 + * match.c (select_type_set_tmp, gfc_match_select_type, + gfc_match_select_rank): Fix 'name' buffersize to avoid out of bounds. + * resolve.c (resolve_select_type): Likewise. + +2021-03-19 Thomas Koenig <tkoenig@gcc.gnu.org> + + * frontend-passes.c (inline_limit_check): Add rank_a + argument. If a is rank 1, set the second dimension to 1. + (inline_matmul_assign): Pass rank_a argument to inline_limit_check. + (call_external_blas): Likewise. + +2021-03-15 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/99345 + * frontend-passes.c (doloop_contained_procedure_code): + Properly handle EXEC_IOLENGTH. + +2021-03-15 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/99545 + * trans-stmt.c (gfc_trans_allocate): Mark the initialization + assignment by setting init_flag. + +2021-03-14 Harald Anlauf <anlauf@gmx.de> + Paul Thomas <pault@gcc.gnu.org> + + * trans-expr.c (gfc_conv_procedure_call): Fix runtime checks for + CLASS arguments. + * trans-intrinsic.c (gfc_conv_intrinsic_size): Likewise. + +2021-03-13 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/99125 + * trans-array.c (gfc_conv_expr_descriptor): For deferred length + length components use the ss_info string length instead of + gfc_get_expr_charlen. Make sure that the deferred string length + is a variable before assigning to it. Otherwise use the expr. + * trans-expr.c (gfc_conv_string_length): Make sure that the + deferred string length is a variable before assigning to it. + +2021-03-12 Tobias Burnus <tobias@codesourcery.com> + + PR fortran/99514 + * resolve.c (resolve_symbol): Accept vars which are in DATA + and hence (either) implicit SAVE (or in common). + +2021-03-10 Harald Anlauf <anlauf@gmx.de> + + PR fortran/99205 + * data.c (gfc_assign_data_value): Reject non-constant character + length for lvalue. + * trans-array.c (gfc_conv_array_initializer): Restrict loop to + elements which are defined to avoid NULL pointer dereference. + +2021-03-10 Tobias Burnus <tobias@codesourcery.com> + + * intrinsic.texi (MIN): Correct 'maximum' to 'minimum'. + +2021-03-10 Eric Botcazou <ebotcazou@adacore.com> + + PR fortran/96983 + * trans-intrinsic.c (build_round_expr): Do not implicitly assume + that __float128 is the 128-bit floating-point type. + +2021-03-08 Harald Anlauf <anlauf@gmx.de> + + PR fortran/49278 + * data.c (gfc_assign_data_value): Reject variable with PARAMETER + attribute in DATA statement. + +2021-03-05 Tobias Burnus <tobias@codesourcery.com> + + PR fortran/99355 + PR fortran/57871 + * invoke.texi (-freal{4,8}-real-*): Extend description. + * primary.c (match_real_constant): Also promote real literals + with '_kind' number. + +2021-03-04 Tobias Burnus <tobias@codesourcery.com> + + PR fortran/99355 + * decl.c (gfc_match_old_kind_spec, gfc_match_kind_spec): Avoid + redoing kind conversions. + * primary.c (match_real_constant): Likewise. + +2021-02-28 Jakub Jelinek <jakub@redhat.com> + + PR fortran/99303 + * openmp.c (gfc_omp_requires_add_clause): Fix up diagnostic message + wordings. + (resolve_omp_clauses): Likewise. + +2021-02-28 Jakub Jelinek <jakub@redhat.com> + + PR fortran/99300 + * frontend-passes.c (doloop_code): Replace double space in diagnostics + with a single space. + +2021-02-24 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/98342 + * trans-expr.c (gfc_conv_derived_to_class): Add optional arg. + 'derived_array' to hold the fixed, parmse expr in the case of + assumed rank formal arguments. Deal with optional arguments. + (gfc_conv_procedure_call): Null 'derived' array for each actual + argument. Add its address to the call to gfc_conv_derived_to_ + class. Access the 'data' field of scalar descriptors before + deallocating allocatable components. Also strip NOPs before the + calls to gfc_deallocate_alloc_comp. Use 'derived' array as the + input to gfc_deallocate_alloc_comp if it is available. + * trans.h : Include the optional argument 'derived_array' to + the prototype of gfc_conv_derived_to_class. The default value + is NULL_TREE. + +2021-02-23 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/99124 + * resolve.c (resolve_fl_procedure): Include class results in + the test for F2018, C15100. + * trans-array.c (get_class_info_from_ss): Do not use the saved + descriptor to obtain the class expression for variables. Use + gfc_get_class_from_expr instead. + +2021-02-23 Harald Anlauf <anlauf@gmx.de> + + PR fortran/99206 + * simplify.c (gfc_simplify_reshape): Set string length for + character arguments. + +2021-02-22 Tobias Burnus <tobias@codesourcery.com> + + PR fortran/99171 + * trans-openmp.c (gfc_omp_is_optional_argument): Regard optional + dummy procs as nonoptional as no special treatment is needed. + +2021-02-21 Harald Anlauf <anlauf@gmx.de> + + * trans-expr.c (gfc_conv_procedure_call): Do not add clobber to + allocatable intent(out) argument. + +2021-02-19 Jerry DeLisle <jvdelisle@gcc.gnu.org> + + PR fortran/98686 + * match.c (gfc_match_namelist): If BT_UNKNOWN, check for + IMPLICIT NONE and and issue an error, otherwise set the type + to its IMPLICIT type so that any subsequent use of objects will + will confirm their types. + +2021-02-19 Harald Anlauf <anlauf@gmx.de> + + * symbol.c (gfc_add_flavor): Reverse order of conditions. + +2021-02-19 Tobias Burnus <tobias@codesourcery.com> + + PR fortran/99010 + * dependency.c (gfc_dep_resolver): Fix coarray handling. + +2021-02-19 Tobias Burnus <tobias@codesourcery.com> + + PR fortran/99146 + * interface.c: + +2021-02-19 Tobias Burnus <tobias@codesourcery.com> + + PR fortran/99027 + * simplify.c (simplify_bound_dim): Honor DIMEN_ELEMENT + when using dim=. + +2021-02-17 Julian Brown <julian@codesourcery.com> + + * openmp.c (resolve_omp_clauses): Disallow selecting components + of arrays of derived type. + +2021-02-17 Julian Brown <julian@codesourcery.com> + + * trans-openmp.c (gfc_trans_omp_clauses): Handle element selection + for arrays of derived types. + +2021-02-16 Tobias Burnus <tobias@codesourcery.com> + + * expr.c (gfc_is_simplify_contiguous): Handle REF_INQUIRY, i.e. + %im and %re which are EXPR_VARIABLE. + * openmp.c (resolve_omp_clauses): Diagnose %re/%im explicitly. + +2021-02-16 Tobias Burnus <tobias@codesourcery.com> + + PR fortran/99111 + * io.c (resolve_tag_format): Reject BT_DERIVED/CLASS/VOID + as (array-valued) FORMAT tag. + +2021-02-12 Tobias Burnus <tobias@codesourcery.com> + + PR fortran/99043 + * trans-expr.c (gfc_conv_procedure_call): Don't reset + rank of assumed-rank array. + +2021-02-11 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/98897 + * match.c (gfc_match_call): Include associate names as possible + entities with typebound subroutines. The target needs to be + resolved for the type. + +2021-02-11 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/99060 + * primary.c (gfc_match_varspec): Test for non-null 'previous' + before using its name in the error message. + +2021-02-11 Tobias Burnus <tobias@codesourcery.com> + + * intrinsic.texi (FINDLOC): Add 'MASK' to argument table. + (MAXLOC, MAXVAL, MINLOC, MINVAL): For 'MASK', remove 'an + array' as scalars are also permitted. + +2021-02-10 Julian Brown <julian@codesourcery.com> + + PR fortran/98979 + * openmp.c (resolve_omp_clauses): Omit OpenACC update in + contiguity check and stride-specified error. + +2021-02-04 Julian Brown <julian@codesourcery.com> + + * openmp.c (resolve_omp_clauses): Omit OpenACC update in + contiguity check and stride-specified error. + +2021-02-04 Julian Brown <julian@codesourcery.com> + + * trans-openmp.c (gfc_trans_omp_clauses): Use class_pointer attribute + for BT_CLASS. + +2021-02-04 Julian Brown <julian@codesourcery.com> + + * trans-openmp.c (gfc_trans_omp_clauses): Fix dereferencing for + BT_DERIVED members. + +2021-02-04 Tobias Burnus <tobias@codesourcery.com> + + * openmp.c (resolve_omp_clauses): Explicitly diagnose + substrings as not permitted. + +2021-02-03 Jeff Law <law@redhat.com> + + * intrinsic.texi (ANINT): Fix typo. + +2021-02-03 Tobias Burnus <tobias@codesourcery.com> + + PR fortran/98913 + * dependency.c (gfc_dep_resolver): Treat local access + to coarrays like any array access in dependency analysis. + +2021-01-28 Harald Anlauf <anlauf@gmx.de> + + PR fortran/86470 + * trans.c (gfc_call_malloc): Allocate area of size 1 if passed + size is NULL (as documented). + +2021-01-27 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/93924 + PR fortran/93925 + * trans-expr.c (gfc_conv_procedure_call): Suppress the call to + gfc_conv_intrinsic_to_class for unlimited polymorphic procedure + pointers. + (gfc_trans_assignment_1): Similarly suppress class assignment + for class valued procedure pointers. + +2021-01-27 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/98472 + * trans-array.c (gfc_conv_expr_descriptor): Include elemental + procedure pointers in the assert under the comment 'elemental + function' and eliminate the second, spurious assert. + +2021-01-25 Harald Anlauf <anlauf@gmx.de> + + PR fortran/70070 + * data.c (create_character_initializer): Check substring indices + against bounds. + (gfc_assign_data_value): Catch error returned from + create_character_initializer. + +2021-01-25 Tobias Burnus <tobias@codesourcery.com> + + * intrinsic.texi (CO_BROADCAST, CO_MIN, CO_REDUCE, CO_SUM): Fix typos. + +2021-01-25 Steve Kargl <kargl@gcc.gnu.org> + + PR fortran/98517 + * resolve.c (resolve_charlen): Check that length expression is + present before testing for scalar/integer.. + +2021-01-22 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/98565 + * trans-intrinsic.c (gfc_conv_associated): Do not add a _data + component for scalar class function targets. Instead, fix the + function result and access the _data from that. + +2021-01-21 Jorge D'Elia <jdelia@cimec.unl.edu.ar> + + * intrinsic.texi (CO_MAX): Fix typo. + +2021-01-21 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/96320 + * decl.c (gfc_match_modproc): It is not an error to find a + module procedure declaration within a contains block. + * expr.c (gfc_check_vardef_context): Pure procedure result is + assignable. Change 'own_scope' accordingly. + * resolve.c (resolve_typebound_procedure): A procedure that + has the module procedure attribute is almost certainly a + module procedure, whatever its interface. + +2021-01-19 Tobias Burnus <tobias@codesourcery.com> + + PR fortran/98476 + * openmp.c (resolve_omp_clauses): Change use_device_ptr + to use_device_addr for unless type(c_ptr); check all + list item for is_device_ptr. + +2021-01-16 Kwok Cheung Yeung <kcy@codesourcery.com> + + * dump-parse-tree.c (show_omp_clauses): Handle detach clause. + * frontend-passes.c (gfc_code_walker): Walk detach expression. + * gfortran.h (struct gfc_omp_clauses): Add detach field. + (gfc_c_intptr_kind): New. + * openmp.c (gfc_free_omp_clauses): Free detach clause. + (gfc_match_omp_detach): New. + (enum omp_mask1): Add OMP_CLAUSE_DETACH. + (enum omp_mask2): Remove OMP_CLAUSE_DETACH. + (gfc_match_omp_clauses): Handle OMP_CLAUSE_DETACH for OpenMP. + (OMP_TASK_CLAUSES): Add OMP_CLAUSE_DETACH. + (resolve_omp_clauses): Prevent use of detach with mergeable and + overriding the data sharing mode of the event handle. + * trans-openmp.c (gfc_trans_omp_clauses): Handle detach clause. + * trans-types.c (gfc_c_intptr_kind): New. + (gfc_init_kinds): Initialize gfc_c_intptr_kind. + * types.def + (BT_FN_VOID_OMPFN_PTR_OMPCPYFN_LONG_LONG_BOOL_UINT_PTR_INT): Rename + to... + (BT_FN_VOID_OMPFN_PTR_OMPCPYFN_LONG_LONG_BOOL_UINT_PTR_INT_PTR): + ...this. Add extra argument. + +2021-01-14 Harald Anlauf <anlauf@gmx.de> + + * gfortran.h (gfc_resolve_substring): Add prototype. + * primary.c (match_string_constant): Simplify substrings with + constant starting and ending points. + * resolve.c: Rename resolve_substring to gfc_resolve_substring. + (gfc_resolve_ref): Use renamed function gfc_resolve_substring. + +2021-01-14 Harald Anlauf <anlauf@gmx.de> + + PR fortran/98661 + * resolve.c (resolve_component): Derived type components with + ALLOCATABLE or POINTER attribute shall have a deferred shape. + +2021-01-14 Harald Anlauf <anlauf@gmx.de> + + Revert: + 2021-01-14 Harald Anlauf <anlauf@gmx.de> + + PR fortran/98661 + * resolve.c (resolve_component): Derived type components with + ALLOCATABLE or POINTER attribute shall have a deferred shape. + +2021-01-14 Harald Anlauf <anlauf@gmx.de> + + PR fortran/98661 + * resolve.c (resolve_component): Derived type components with + ALLOCATABLE or POINTER attribute shall have a deferred shape. + +2021-01-08 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/93794 + * trans-expr.c (gfc_conv_component_ref): Remove the condition + that deferred character length components only be allocatable. + +2021-01-08 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/98458 + * simplify.c (is_constant_array_expr): If an array constructor + expression has elements other than constants or structures, try + fixing the expression with gfc_reduce_init_expr. Also, if shape + is NULL, obtain the array size and set it. + +2021-01-07 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/93701 + * resolve.c (find_array_spec): Put static prototype for + resolve_assoc_var before this function and call for associate + variables. + +2021-01-06 Harald Anlauf <anlauf@gmx.de> + + * resolve.c (resolve_component): Add check for valid CLASS + reference before trying to access CLASS data. + +2021-01-04 Martin Liska <mliska@suse.cz> + + * ChangeLog-2018: Remove duplicate ChangeLog entries. + +2021-01-01 Harald Anlauf <anlauf@gmx.de> + + * class.c (gfc_find_vtab): Add check on attribute is_class. + +2021-01-01 Jakub Jelinek <jakub@redhat.com> + + * gfortranspec.c (lang_specific_driver): Update copyright notice + dates. + * gfc-internals.texi: Bump @copying's copyright year. + * gfortran.texi: Ditto. + * intrinsic.texi: Ditto. + * invoke.texi: Ditto. + +2021-01-01 Jakub Jelinek <jakub@redhat.com> + + * ChangeLog-2020: Rotate ChangeLog. New file. + +Copyright (C) 2021 Free Software Foundation, Inc. + +Copying and distribution of this file, with or without modification, +are permitted in any medium without royalty provided the copyright +notice and this notice are preserved. diff --git a/gcc/fortran/Make-lang.in b/gcc/fortran/Make-lang.in index 58ce589..a558fc8 100644 --- a/gcc/fortran/Make-lang.in +++ b/gcc/fortran/Make-lang.in @@ -1,6 +1,6 @@ # -*- makefile -*- # Top level makefile fragment for GNU gfortran, the GNU Fortran 95 compiler. -# Copyright (C) 2002-2021 Free Software Foundation, Inc. +# Copyright (C) 2002-2022 Free Software Foundation, Inc. # Contributed by Paul Brook <paul@nowt.org # and Steven Bosscher <s.bosscher@student.tudelft.nl> @@ -113,8 +113,8 @@ fortran.srcinfo: doc/gfortran.info -cp -p $^ $(srcdir)/fortran fortran.tags: force - cd $(srcdir)/fortran; etags -o TAGS.sub *.c *.h; \ - etags --include TAGS.sub --include ../TAGS.sub + cd $(srcdir)/fortran; $(ETAGS) -o TAGS.sub *.c *.h; \ + $(ETAGS) --include TAGS.sub --include ../TAGS.sub fortran.info: doc/gfortran.info doc/gfc-internals.info diff --git a/gcc/fortran/arith.c b/gcc/fortran/arith.cc index 70062e2..06e032e 100644 --- a/gcc/fortran/arith.c +++ b/gcc/fortran/arith.cc @@ -1,5 +1,5 @@ /* Compiler arithmetic - Copyright (C) 2000-2021 Free Software Foundation, Inc. + Copyright (C) 2000-2022 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. @@ -1305,6 +1305,8 @@ reduce_binary_ac (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **), head = gfc_constructor_copy (op1->value.constructor); for (c = gfc_constructor_first (head); c; c = gfc_constructor_next (c)) { + gfc_simplify_expr (c->expr, 0); + if (c->expr->expr_type == EXPR_CONSTANT) rc = eval (c->expr, op2, &r); else @@ -1321,9 +1323,19 @@ reduce_binary_ac (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **), else { gfc_constructor *c = gfc_constructor_first (head); - r = gfc_get_array_expr (c->expr->ts.type, c->expr->ts.kind, - &op1->where); - r->shape = gfc_copy_shape (op1->shape, op1->rank); + if (c) + { + r = gfc_get_array_expr (c->expr->ts.type, c->expr->ts.kind, + &op1->where); + r->shape = gfc_copy_shape (op1->shape, op1->rank); + } + else + { + gcc_assert (op1->ts.type != BT_UNKNOWN); + r = gfc_get_array_expr (op1->ts.type, op1->ts.kind, + &op1->where); + r->shape = gfc_get_shape (op1->rank); + } r->rank = op1->rank; r->value.constructor = head; *result = r; @@ -1345,6 +1357,8 @@ reduce_binary_ca (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **), head = gfc_constructor_copy (op2->value.constructor); for (c = gfc_constructor_first (head); c; c = gfc_constructor_next (c)) { + gfc_simplify_expr (c->expr, 0); + if (c->expr->expr_type == EXPR_CONSTANT) rc = eval (op1, c->expr, &r); else @@ -1361,9 +1375,19 @@ reduce_binary_ca (arith (*eval) (gfc_expr *, gfc_expr *, gfc_expr **), else { gfc_constructor *c = gfc_constructor_first (head); - r = gfc_get_array_expr (c->expr->ts.type, c->expr->ts.kind, - &op2->where); - r->shape = gfc_copy_shape (op2->shape, op2->rank); + if (c) + { + r = gfc_get_array_expr (c->expr->ts.type, c->expr->ts.kind, + &op2->where); + r->shape = gfc_copy_shape (op2->shape, op2->rank); + } + else + { + gcc_assert (op2->ts.type != BT_UNKNOWN); + r = gfc_get_array_expr (op2->ts.type, op2->ts.kind, + &op2->where); + r->shape = gfc_get_shape (op2->rank); + } r->rank = op2->rank; r->value.constructor = head; *result = r; diff --git a/gcc/fortran/arith.h b/gcc/fortran/arith.h index 88fa67d..4a79c98 100644 --- a/gcc/fortran/arith.h +++ b/gcc/fortran/arith.h @@ -1,5 +1,5 @@ /* Compiler arithmetic header. - Copyright (C) 2000-2021 Free Software Foundation, Inc. + Copyright (C) 2000-2022 Free Software Foundation, Inc. Contributed by Steven Bosscher This file is part of GCC. diff --git a/gcc/fortran/array.c b/gcc/fortran/array.cc index 6552eaf..f1d92e0 100644 --- a/gcc/fortran/array.c +++ b/gcc/fortran/array.cc @@ -1,5 +1,5 @@ /* Array things - Copyright (C) 2000-2021 Free Software Foundation, Inc. + Copyright (C) 2000-2022 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. @@ -492,6 +492,8 @@ match_array_element_spec (gfc_array_spec *as) if (!gfc_expr_check_typed (*upper, gfc_current_ns, false)) return AS_UNKNOWN; + gfc_try_simplify_expr (*upper, 0); + if (((*upper)->expr_type == EXPR_CONSTANT && (*upper)->ts.type != BT_INTEGER) || ((*upper)->expr_type == EXPR_FUNCTION @@ -524,6 +526,8 @@ match_array_element_spec (gfc_array_spec *as) if (!gfc_expr_check_typed (*upper, gfc_current_ns, false)) return AS_UNKNOWN; + gfc_try_simplify_expr (*upper, 0); + if (((*upper)->expr_type == EXPR_CONSTANT && (*upper)->ts.type != BT_INTEGER) || ((*upper)->expr_type == EXPR_FUNCTION @@ -1804,6 +1808,12 @@ expand_constructor (gfc_constructor_base base) if (empty_constructor) empty_ts = e->ts; + /* Simplify constant array expression/section within constructor. */ + if (e->expr_type == EXPR_VARIABLE && e->rank > 0 && e->ref + && e->symtree && e->symtree->n.sym + && e->symtree->n.sym->attr.flavor == FL_PARAMETER) + gfc_simplify_expr (e, 0); + if (e->expr_type == EXPR_ARRAY) { if (!expand_constructor (e->value.constructor)) @@ -1873,6 +1883,9 @@ gfc_expand_constructor (gfc_expr *e, bool fatal) gfc_expr *f; bool rc; + if (gfc_is_size_zero_array (e)) + return true; + /* If we can successfully get an array element at the max array size then the array is too big to expand, so we just return. */ f = gfc_get_array_element (e, flag_max_array_constructor); @@ -2286,8 +2299,7 @@ gfc_copy_iterator (gfc_iterator *src) /********* Subroutines for determining the size of an array *********/ /* These are needed just to accommodate RESHAPE(). There are no - diagnostics here, we just return a negative number if something - goes wrong. */ + diagnostics here, we just return false if something goes wrong. */ /* Get the size of single dimension of an array specification. The @@ -2320,6 +2332,9 @@ spec_dimen_size (gfc_array_spec *as, int dimen, mpz_t *result) mpz_add_ui (*result, *result, 1); + if (mpz_cmp_si (*result, 0) < 0) + mpz_set_si (*result, 0); + return true; } @@ -2393,12 +2408,11 @@ gfc_ref_dimen_size (gfc_array_ref *ar, int dimen, mpz_t *result, mpz_t *end) { stride_expr = gfc_copy_expr(ar->stride[dimen]); - if(!gfc_simplify_expr(stride_expr, 1)) - gfc_internal_error("Simplification error"); - - if (stride_expr->expr_type != EXPR_CONSTANT - || mpz_cmp_ui (stride_expr->value.integer, 0) == 0) + if (!gfc_simplify_expr (stride_expr, 1) + || stride_expr->expr_type != EXPR_CONSTANT + || mpz_cmp_ui (stride_expr->value.integer, 0) == 0) { + gfc_free_expr (stride_expr); mpz_clear (stride); return false; } diff --git a/gcc/fortran/bbt.c b/gcc/fortran/bbt.cc index 6ffa2d6..8b65471 100644 --- a/gcc/fortran/bbt.c +++ b/gcc/fortran/bbt.cc @@ -1,5 +1,5 @@ /* Balanced binary trees using treaps. - Copyright (C) 2000-2021 Free Software Foundation, Inc. + Copyright (C) 2000-2022 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. diff --git a/gcc/fortran/check.c b/gcc/fortran/check.cc index cfaf9d2..fc97bb1 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.cc @@ -1,5 +1,5 @@ /* Check functions - Copyright (C) 2002-2021 Free Software Foundation, Inc. + Copyright (C) 2002-2022 Free Software Foundation, Inc. Contributed by Andy Vaught & Katherine Holcomb This file is part of GCC. @@ -36,7 +36,7 @@ along with GCC; see the file COPYING3. If not see /* Reset a BOZ to a zero value. This is used to prevent run-on errors - from resolve.c(resolve_function). */ + from resolve.cc(resolve_function). */ static void reset_boz (gfc_expr *x) @@ -1011,33 +1011,13 @@ variable_check (gfc_expr *e, int n, bool allow_proc) if (e->expr_type == EXPR_VARIABLE && e->symtree->n.sym->attr.intent == INTENT_IN && (gfc_current_intrinsic_arg[n]->intent == INTENT_OUT - || gfc_current_intrinsic_arg[n]->intent == INTENT_INOUT)) + || gfc_current_intrinsic_arg[n]->intent == INTENT_INOUT) + && !gfc_check_vardef_context (e, false, true, false, NULL)) { - gfc_ref *ref; - bool pointer = e->symtree->n.sym->ts.type == BT_CLASS - && CLASS_DATA (e->symtree->n.sym) - ? CLASS_DATA (e->symtree->n.sym)->attr.class_pointer - : e->symtree->n.sym->attr.pointer; - - for (ref = e->ref; ref; ref = ref->next) - { - if (pointer && ref->type == REF_COMPONENT) - break; - if (ref->type == REF_COMPONENT - && ((ref->u.c.component->ts.type == BT_CLASS - && CLASS_DATA (ref->u.c.component)->attr.class_pointer) - || (ref->u.c.component->ts.type != BT_CLASS - && ref->u.c.component->attr.pointer))) - break; - } - - if (!ref) - { - gfc_error ("%qs argument of %qs intrinsic at %L cannot be " - "INTENT(IN)", gfc_current_intrinsic_arg[n]->name, - gfc_current_intrinsic, &e->where); - return false; - } + gfc_error ("%qs argument of %qs intrinsic at %L cannot be INTENT(IN)", + gfc_current_intrinsic_arg[n]->name, + gfc_current_intrinsic, &e->where); + return false; } if (e->expr_type == EXPR_VARIABLE @@ -1376,7 +1356,7 @@ gfc_check_all_any (gfc_expr *mask, gfc_expr *dim) /* Limited checking for ALLOCATED intrinsic. Additional checking - is performed in intrinsic.c(sort_actual), because ALLOCATED + is performed in intrinsic.cc(sort_actual), because ALLOCATED has two mutually exclusive non-optional arguments. */ bool @@ -2265,7 +2245,7 @@ gfc_check_co_reduce (gfc_expr *a, gfc_expr *op, gfc_expr *result_image, attr = gfc_expr_attr (op); if (!attr.pure || !attr.function) { - gfc_error ("OPERATOR argument at %L must be a PURE function", + gfc_error ("OPERATION argument at %L must be a PURE function", &op->where); return false; } @@ -2292,7 +2272,7 @@ gfc_check_co_reduce (gfc_expr *a, gfc_expr *op, gfc_expr *result_image, if (!formal || !formal->next || formal->next->next) { - gfc_error ("The function passed as OPERATOR at %L shall have two " + gfc_error ("The function passed as OPERATION at %L shall have two " "arguments", &op->where); return false; } @@ -2303,7 +2283,7 @@ gfc_check_co_reduce (gfc_expr *a, gfc_expr *op, gfc_expr *result_image, if (!gfc_compare_types (&a->ts, &sym->result->ts)) { gfc_error ("The A argument at %L has type %s but the function passed as " - "OPERATOR at %L returns %s", + "OPERATION at %L returns %s", &a->where, gfc_typename (a), &op->where, gfc_typename (&sym->result->ts)); return false; @@ -2311,7 +2291,7 @@ gfc_check_co_reduce (gfc_expr *a, gfc_expr *op, gfc_expr *result_image, if (!gfc_compare_types (&a->ts, &formal->sym->ts) || !gfc_compare_types (&a->ts, &formal->next->sym->ts)) { - gfc_error ("The function passed as OPERATOR at %L has arguments of type " + gfc_error ("The function passed as OPERATION at %L has arguments of type " "%s and %s but shall have type %s", &op->where, gfc_typename (&formal->sym->ts), gfc_typename (&formal->next->sym->ts), gfc_typename (a)); @@ -2322,7 +2302,7 @@ gfc_check_co_reduce (gfc_expr *a, gfc_expr *op, gfc_expr *result_image, || formal->next->sym->attr.allocatable || formal->sym->attr.pointer || formal->next->sym->attr.pointer) { - gfc_error ("The function passed as OPERATOR at %L shall have scalar " + gfc_error ("The function passed as OPERATION at %L shall have scalar " "nonallocatable nonpointer arguments and return a " "nonallocatable nonpointer scalar", &op->where); return false; @@ -2330,21 +2310,21 @@ gfc_check_co_reduce (gfc_expr *a, gfc_expr *op, gfc_expr *result_image, if (formal->sym->attr.value != formal->next->sym->attr.value) { - gfc_error ("The function passed as OPERATOR at %L shall have the VALUE " + gfc_error ("The function passed as OPERATION at %L shall have the VALUE " "attribute either for none or both arguments", &op->where); return false; } if (formal->sym->attr.target != formal->next->sym->attr.target) { - gfc_error ("The function passed as OPERATOR at %L shall have the TARGET " + gfc_error ("The function passed as OPERATION at %L shall have the TARGET " "attribute either for none or both arguments", &op->where); return false; } if (formal->sym->attr.asynchronous != formal->next->sym->attr.asynchronous) { - gfc_error ("The function passed as OPERATOR at %L shall have the " + gfc_error ("The function passed as OPERATION at %L shall have the " "ASYNCHRONOUS attribute either for none or both arguments", &op->where); return false; @@ -2352,7 +2332,7 @@ gfc_check_co_reduce (gfc_expr *a, gfc_expr *op, gfc_expr *result_image, if (formal->sym->attr.optional || formal->next->sym->attr.optional) { - gfc_error ("The function passed as OPERATOR at %L shall not have the " + gfc_error ("The function passed as OPERATION at %L shall not have the " "OPTIONAL attribute for either of the arguments", &op->where); return false; } @@ -2383,14 +2363,14 @@ gfc_check_co_reduce (gfc_expr *a, gfc_expr *op, gfc_expr *result_image, || (formal_size2 && actual_size != formal_size2))) { gfc_error ("The character length of the A argument at %L and of the " - "arguments of the OPERATOR at %L shall be the same", + "arguments of the OPERATION at %L shall be the same", &a->where, &op->where); return false; } if (actual_size && result_size && actual_size != result_size) { gfc_error ("The character length of the A argument at %L and of the " - "function result of the OPERATOR at %L shall be the same", + "function result of the OPERATION at %L shall be the same", &a->where, &op->where); return false; } @@ -3240,7 +3220,7 @@ gfc_check_intconv (gfc_expr *x) if (strcmp (gfc_current_intrinsic, "short") == 0 || strcmp (gfc_current_intrinsic, "long") == 0) { - gfc_error ("%qs intrinsic subprogram at %L has been deprecated. " + gfc_error ("%qs intrinsic subprogram at %L has been removed. " "Use INT intrinsic subprogram.", gfc_current_intrinsic, &x->where); return false; @@ -4358,6 +4338,9 @@ gfc_check_norm2 (gfc_expr *array, gfc_expr *dim) if (!array_check (array, 0)) return false; + if (!dim_check (dim, 1, false)) + return false; + if (!dim_rank_check (dim, array, false)) return false; @@ -4496,6 +4479,9 @@ gfc_check_parity (gfc_expr *mask, gfc_expr *dim) if (!array_check (mask, 0)) return false; + if (!dim_check (dim, 1, false)) + return false; + if (!dim_rank_check (dim, mask, false)) return false; @@ -4699,6 +4685,7 @@ gfc_check_reshape (gfc_expr *source, gfc_expr *shape, mpz_t size; mpz_t nelems; int shape_size; + bool shape_is_const; if (!array_check (source, 0)) return false; @@ -4732,7 +4719,11 @@ gfc_check_reshape (gfc_expr *source, gfc_expr *shape, "than %d elements", &shape->where, GFC_MAX_DIMENSIONS); return false; } - else if (shape->expr_type == EXPR_ARRAY && gfc_is_constant_expr (shape)) + + gfc_simplify_expr (shape, 0); + shape_is_const = gfc_is_constant_expr (shape); + + if (shape->expr_type == EXPR_ARRAY && shape_is_const) { gfc_expr *e; int i, extent; @@ -4748,38 +4739,7 @@ gfc_check_reshape (gfc_expr *source, gfc_expr *shape, gfc_error ("%qs argument of %qs intrinsic at %L has " "negative element (%d)", gfc_current_intrinsic_arg[1]->name, - gfc_current_intrinsic, &e->where, extent); - return false; - } - } - } - else if (shape->expr_type == EXPR_VARIABLE && shape->ref - && shape->ref->u.ar.type == AR_FULL && shape->ref->u.ar.dimen == 1 - && shape->ref->u.ar.as - && shape->ref->u.ar.as->lower[0]->expr_type == EXPR_CONSTANT - && shape->ref->u.ar.as->lower[0]->ts.type == BT_INTEGER - && shape->ref->u.ar.as->upper[0]->expr_type == EXPR_CONSTANT - && shape->ref->u.ar.as->upper[0]->ts.type == BT_INTEGER - && shape->symtree->n.sym->attr.flavor == FL_PARAMETER - && shape->symtree->n.sym->value) - { - int i, extent; - gfc_expr *e, *v; - - v = shape->symtree->n.sym->value; - - for (i = 0; i < shape_size; i++) - { - e = gfc_constructor_lookup_expr (v->value.constructor, i); - if (e == NULL) - break; - - gfc_extract_int (e, &extent); - - if (extent < 0) - { - gfc_error ("Element %d of actual argument of RESHAPE at %L " - "cannot be negative", i + 1, &shape->where); + gfc_current_intrinsic, &shape->where, extent); return false; } } @@ -4856,8 +4816,7 @@ gfc_check_reshape (gfc_expr *source, gfc_expr *shape, } } - if (pad == NULL && shape->expr_type == EXPR_ARRAY - && gfc_is_constant_expr (shape) + if (pad == NULL && shape->expr_type == EXPR_ARRAY && shape_is_const && !(source->expr_type == EXPR_VARIABLE && source->symtree->n.sym->as && source->symtree->n.sym->as->type == AS_ASSUMED_SIZE)) { @@ -5096,6 +5055,9 @@ gfc_check_shape (gfc_expr *source, gfc_expr *kind) if (source->rank == 0 || source->expr_type != EXPR_VARIABLE) return true; + if (source->ref == NULL) + return false; + ar = gfc_find_array_ref (source); if (ar->as && ar->as->type == AS_ASSUMED_SIZE && ar->type == AR_FULL) @@ -5179,6 +5141,9 @@ gfc_check_sizeof (gfc_expr *arg) return false; } + if (illegal_boz_arg (arg)) + return false; + /* TYPE(*) is acceptable if and only if it uses an array descriptor. */ if (arg->ts.type == BT_ASSUMED && (arg->symtree->n.sym->as == NULL @@ -5220,6 +5185,18 @@ is_c_interoperable (gfc_expr *expr, const char **msg, bool c_loc, bool c_f_ptr) { *msg = NULL; + if (expr->expr_type == EXPR_NULL) + { + *msg = "NULL() is not interoperable"; + return false; + } + + if (expr->ts.type == BT_BOZ) + { + *msg = "BOZ literal constant"; + return false; + } + if (expr->ts.type == BT_CLASS) { *msg = "Expression is polymorphic"; @@ -5973,6 +5950,13 @@ gfc_check_image_index (gfc_expr *coarray, gfc_expr *sub) return false; } + if (sub->ts.type != BT_INTEGER) + { + gfc_error ("Type of %s argument of IMAGE_INDEX at %L shall be INTEGER", + gfc_current_intrinsic_arg[1]->name, &sub->where); + return false; + } + if (gfc_array_size (sub, &nelems)) { int corank = gfc_get_corank (coarray); @@ -6166,8 +6150,8 @@ gfc_calculate_transfer_sizes (gfc_expr *source, gfc_expr *mold, gfc_expr *size, * representation is not shorter than that of SOURCE. * If SIZE is present, the result is an array of rank one and size SIZE. */ - if (result_elt_size == 0 && *source_size > 0 && !size - && mold->expr_type == EXPR_ARRAY) + if (result_elt_size == 0 && *source_size > 0 + && (mold->expr_type == EXPR_ARRAY || mold->rank)) { gfc_error ("%<MOLD%> argument of %<TRANSFER%> intrinsic at %L is an " "array and shall not have storage size 0 when %<SOURCE%> " diff --git a/gcc/fortran/class.c b/gcc/fortran/class.cc index 93118ad..731e9b0 100644 --- a/gcc/fortran/class.c +++ b/gcc/fortran/class.cc @@ -1,5 +1,5 @@ /* Implementation of Fortran 2003 Polymorphism. - Copyright (C) 2009-2021 Free Software Foundation, Inc. + Copyright (C) 2009-2022 Free Software Foundation, Inc. Contributed by Paul Richard Thomas <pault@gcc.gnu.org> and Janus Weil <janus@gcc.gnu.org> @@ -20,7 +20,7 @@ along with GCC; see the file COPYING3. If not see <http://www.gnu.org/licenses/>. */ -/* class.c -- This file contains the front end functions needed to service +/* class.cc -- This file contains the front end functions needed to service the implementation of Fortran 2003 polymorphism and other object-oriented features. */ @@ -1602,7 +1602,6 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, gfc_code *last_code, *block; char *name; bool finalizable_comp = false; - bool expr_null_wrapper = false; gfc_expr *ancestor_wrapper = NULL, *rank; gfc_iterator *iter; @@ -1636,7 +1635,11 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, && !derived->attr.alloc_comp && (!derived->f2k_derived || !derived->f2k_derived->finalizers) && !has_finalizer_component (derived)) - expr_null_wrapper = true; + { + vtab_final->initializer = gfc_get_null_expr (NULL); + gcc_assert (vtab_final->ts.interface == NULL); + return; + } else /* Check whether there are new allocatable components. */ for (comp = derived->components; comp; comp = comp->next) @@ -1650,7 +1653,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, /* If there is no new finalizer and no new allocatable, return with an expr to the ancestor's one. */ - if (!expr_null_wrapper && !finalizable_comp + if (!finalizable_comp && (!derived->f2k_derived || !derived->f2k_derived->finalizers)) { gcc_assert (ancestor_wrapper && ancestor_wrapper->ref == NULL @@ -1674,8 +1677,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, /* Set up the namespace. */ sub_ns = gfc_get_namespace (ns, 0); sub_ns->sibling = ns->contained; - if (!expr_null_wrapper) - ns->contained = sub_ns; + ns->contained = sub_ns; sub_ns->resolved = 1; /* Set up the procedure symbol. */ @@ -1691,7 +1693,7 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, final->ts.kind = 4; final->attr.artificial = 1; final->attr.always_explicit = 1; - final->attr.if_source = expr_null_wrapper ? IFSRC_IFBODY : IFSRC_DECL; + final->attr.if_source = IFSRC_DECL; if (ns->proc_name->attr.flavor == FL_MODULE) final->module = ns->proc_name->name; gfc_set_sym_referenced (final); @@ -1741,15 +1743,6 @@ generate_finalization_wrapper (gfc_symbol *derived, gfc_namespace *ns, final->formal->next->next->sym = fini_coarray; gfc_commit_symbol (fini_coarray); - /* Return with a NULL() expression but with an interface which has - the formal arguments. */ - if (expr_null_wrapper) - { - vtab_final->initializer = gfc_get_null_expr (NULL); - vtab_final->ts.interface = final; - return; - } - /* Local variables. */ gfc_get_symbol ("idx", sub_ns, &idx); @@ -2768,7 +2761,7 @@ find_intrinsic_vtab (gfc_typespec *ts) c->attr.access = ACCESS_PRIVATE; /* Build a minimal expression to make use of - target-memory.c/gfc_element_size for 'size'. Special handling + target-memory.cc/gfc_element_size for 'size'. Special handling for character arrays, that are not constant sized: to support len (str) * kind, only the kind information is stored in the vtab. */ diff --git a/gcc/fortran/config-lang.in b/gcc/fortran/config-lang.in index a900e88..7492bfd 100644 --- a/gcc/fortran/config-lang.in +++ b/gcc/fortran/config-lang.in @@ -1,4 +1,4 @@ -# Copyright (C) 2004-2021 Free Software Foundation, Inc. +# Copyright (C) 2004-2022 Free Software Foundation, Inc. # # This file is part of GCC. # @@ -29,5 +29,5 @@ compilers="f951\$(exeext)" target_libs="target-libgfortran target-libbacktrace" -gtfiles="\$(srcdir)/fortran/f95-lang.c \$(srcdir)/fortran/trans-decl.c \$(srcdir)/fortran/trans-intrinsic.c \$(srcdir)/fortran/trans-io.c \$(srcdir)/fortran/trans-stmt.c \$(srcdir)/fortran/trans-types.c \$(srcdir)/fortran/trans-types.h \$(srcdir)/fortran/trans.h \$(srcdir)/fortran/trans-const.h" +gtfiles="\$(srcdir)/fortran/f95-lang.cc \$(srcdir)/fortran/trans-decl.cc \$(srcdir)/fortran/trans-intrinsic.cc \$(srcdir)/fortran/trans-io.cc \$(srcdir)/fortran/trans-stmt.cc \$(srcdir)/fortran/trans-types.cc \$(srcdir)/fortran/trans-types.h \$(srcdir)/fortran/trans.h \$(srcdir)/fortran/trans-const.h" diff --git a/gcc/fortran/constructor.c b/gcc/fortran/constructor.cc index 3e4377a..d07dc84 100644 --- a/gcc/fortran/constructor.c +++ b/gcc/fortran/constructor.cc @@ -1,5 +1,5 @@ /* Array and structure constructors - Copyright (C) 2009-2021 Free Software Foundation, Inc. + Copyright (C) 2009-2022 Free Software Foundation, Inc. This file is part of GCC. @@ -85,7 +85,8 @@ gfc_constructor_get (void) return c; } -gfc_constructor_base gfc_constructor_get_base (void) +static gfc_constructor_base +gfc_constructor_get_base (void) { return splay_tree_new (splay_tree_compare_ints, NULL, node_free); } @@ -209,23 +210,6 @@ gfc_constructor_lookup_expr (gfc_constructor_base base, int offset) } -int -gfc_constructor_expr_foreach (gfc_constructor *ctor ATTRIBUTE_UNUSED, - int(*f)(gfc_expr *) ATTRIBUTE_UNUSED) -{ - gcc_assert (0); - return 0; -} - -void -gfc_constructor_swap (gfc_constructor *ctor ATTRIBUTE_UNUSED, - int n ATTRIBUTE_UNUSED, int m ATTRIBUTE_UNUSED) -{ - gcc_assert (0); -} - - - gfc_constructor * gfc_constructor_first (gfc_constructor_base base) { diff --git a/gcc/fortran/constructor.h b/gcc/fortran/constructor.h index 85a72dc..0c64098 100644 --- a/gcc/fortran/constructor.h +++ b/gcc/fortran/constructor.h @@ -1,5 +1,5 @@ /* Array and structure constructors - Copyright (C) 2009-2021 Free Software Foundation, Inc. + Copyright (C) 2009-2022 Free Software Foundation, Inc. This file is part of GCC. @@ -23,8 +23,6 @@ along with GCC; see the file COPYING3. If not see /* Get a new constructor structure. */ gfc_constructor *gfc_constructor_get (void); -gfc_constructor_base gfc_constructor_get_base (void); - /* Copy a constructor structure. */ gfc_constructor_base gfc_constructor_copy (gfc_constructor_base base); @@ -64,14 +62,6 @@ gfc_constructor *gfc_constructor_lookup (gfc_constructor_base base, int n); */ gfc_expr *gfc_constructor_lookup_expr (gfc_constructor_base base, int n); - -int gfc_constructor_expr_foreach (gfc_constructor *ctor, int(*)(gfc_expr *)); - - -void gfc_constructor_swap (gfc_constructor *ctor, int n, int m); - - - /* Get the first constructor node in the constructure structure. Returns NULL if there is no such expression. */ gfc_constructor *gfc_constructor_first (gfc_constructor_base base); diff --git a/gcc/fortran/convert.c b/gcc/fortran/convert.cc index 3dcdc21..926a873 100644 --- a/gcc/fortran/convert.c +++ b/gcc/fortran/convert.cc @@ -1,5 +1,5 @@ /* Data type conversion - Copyright (C) 1987-2021 Free Software Foundation, Inc. + Copyright (C) 1987-2022 Free Software Foundation, Inc. This file is part of GCC. diff --git a/gcc/fortran/cpp.c b/gcc/fortran/cpp.cc index e86386c..364bd0d 100644 --- a/gcc/fortran/cpp.c +++ b/gcc/fortran/cpp.cc @@ -1,4 +1,4 @@ -/* Copyright (C) 2008-2021 Free Software Foundation, Inc. +/* Copyright (C) 2008-2022 Free Software Foundation, Inc. This file is part of GCC. @@ -178,7 +178,7 @@ cpp_define_builtins (cpp_reader *pfile) /* The defines below are necessary for the TARGET_* macros. FIXME: Note that builtin_define_std() actually is a function - in c-cppbuiltin.c which uses flags undefined for Fortran. + in c-cppbuiltin.cc which uses flags undefined for Fortran. Let's skip this for now. If needed, one needs to look into it once more. */ @@ -189,7 +189,7 @@ cpp_define_builtins (cpp_reader *pfile) /* FIXME: Pandora's Box Using the macros below results in multiple breakages: - mingw will fail to compile this file as dependent macros - assume to be used in c-cppbuiltin.c only. Further, they use + assume to be used in c-cppbuiltin.cc only. Further, they use flags only valid/defined in C (same as noted above). [config/i386/mingw32.h, config/i386/cygming.h] - other platforms (not as popular) break similarly diff --git a/gcc/fortran/cpp.h b/gcc/fortran/cpp.h index 44644a2..28673e3 100644 --- a/gcc/fortran/cpp.h +++ b/gcc/fortran/cpp.h @@ -1,4 +1,4 @@ -/* Copyright (C) 2008-2021 Free Software Foundation, Inc. +/* Copyright (C) 2008-2022 Free Software Foundation, Inc. This file is part of GCC. diff --git a/gcc/fortran/data.c b/gcc/fortran/data.cc index 71e2552..f7c9143 100644 --- a/gcc/fortran/data.c +++ b/gcc/fortran/data.cc @@ -1,5 +1,5 @@ /* Supporting functions for resolving DATA statement. - Copyright (C) 2002-2021 Free Software Foundation, Inc. + Copyright (C) 2002-2022 Free Software Foundation, Inc. Contributed by Lifang Zeng <zlf605@hotmail.com> This file is part of GCC. @@ -23,14 +23,14 @@ along with GCC; see the file COPYING3. If not see We first assign initial value to each symbol by gfc_assign_data_value during resolving DATA statement. Refer to check_data_variable and - traverse_data_list in resolve.c. + traverse_data_list in resolve.cc. The complexity exists in the handling of array section, implied do and array of struct appeared in DATA statement. We call gfc_conv_structure, gfc_con_array_array_initializer, - etc., to convert the initial value. Refer to trans-expr.c and - trans-array.c. */ + etc., to convert the initial value. Refer to trans-expr.cc and + trans-array.cc. */ #include "config.h" #include "system.h" @@ -80,7 +80,7 @@ get_array_index (gfc_array_ref *ar, mpz_t *offset) } /* Find if there is a constructor which component is equal to COM. - TODO: remove this, use symbol.c(gfc_find_component) instead. */ + TODO: remove this, use symbol.cc(gfc_find_component) instead. */ static gfc_constructor * find_con_by_component (gfc_component *com, gfc_constructor_base base) diff --git a/gcc/fortran/data.h b/gcc/fortran/data.h index a0cab4e..8ed0dcc 100644 --- a/gcc/fortran/data.h +++ b/gcc/fortran/data.h @@ -1,5 +1,5 @@ /* Header for functions resolving DATA statements. - Copyright (C) 2007-2021 Free Software Foundation, Inc. + Copyright (C) 2007-2022 Free Software Foundation, Inc. This file is part of GCC. diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.cc index ce61e53..bd586e7 100644 --- a/gcc/fortran/decl.c +++ b/gcc/fortran/decl.cc @@ -1,5 +1,5 @@ /* Declaration statement matcher - Copyright (C) 2002-2021 Free Software Foundation, Inc. + Copyright (C) 2002-2022 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. @@ -791,7 +791,7 @@ match_clist_expr (gfc_expr **result, gfc_typespec *ts, gfc_array_spec *as) gcc_assert (ts); /* We have already matched '/' - now look for a constant list, as with - top_val_list from decl.c, but append the result to an array. */ + top_val_list from decl.cc, but append the result to an array. */ if (gfc_match ("/") == MATCH_YES) { gfc_error ("Empty old style initializer list at %C"); @@ -1277,7 +1277,7 @@ get_proc_name (const char *name, gfc_symbol **result, bool module_fcn_entry) /* Module functions have to be left in their own namespace because they have potentially (almost certainly!) already been referenced. In this sense, they are rather like external functions. This is - fixed up in resolve.c(resolve_entries), where the symbol name- + fixed up in resolve.cc(resolve_entries), where the symbol name- space is set to point to the master function, so that the fake result mechanism can work. */ if (module_fcn_entry) @@ -1494,7 +1494,7 @@ gfc_verify_c_interop_param (gfc_symbol *sym) int is_c_interop = 0; bool retval = true; - /* We check implicitly typed variables in symbol.c:gfc_set_default_type(). + /* We check implicitly typed variables in symbol.cc:gfc_set_default_type(). Don't repeat the checks here. */ if (sym->attr.implicit_type) return true; @@ -2105,6 +2105,14 @@ add_init_expr_to_sym (const char *name, gfc_expr **initp, locus *var_locus) } } + if (sym->attr.flavor == FL_PARAMETER && sym->attr.dimension && sym->as + && sym->as->rank && init->rank && init->rank != sym->as->rank) + { + gfc_error ("Rank mismatch of array at %L and its initializer " + "(%d/%d)", &sym->declared_at, sym->as->rank, init->rank); + return false; + } + /* If sym is implied-shape, set its upper bounds from init. */ if (sym->attr.flavor == FL_PARAMETER && sym->attr.dimension && sym->as->type == AS_IMPLIED_SHAPE) @@ -3128,7 +3136,7 @@ cleanup: This assumes that the byte size is equal to the kind number for non-COMPLEX types, and equal to twice the kind number for COMPLEX. */ -match +static match gfc_match_old_kind_spec (gfc_typespec *ts) { match m; @@ -3601,7 +3609,9 @@ done: gfc_current_ns = gfc_get_namespace (NULL, 0); e = gfc_copy_expr (len); + gfc_push_suppress_errors (); gfc_reduce_init_expr (e); + gfc_pop_suppress_errors (); if (e->expr_type == EXPR_CONSTANT) { gfc_replace_expr (len, e); @@ -3713,7 +3723,7 @@ insert_parameter_exprs (gfc_expr* e, gfc_symbol* sym ATTRIBUTE_UNUSED, } -bool +static bool gfc_insert_kind_parameter_exprs (gfc_expr *e) { return gfc_traverse_expr (e, NULL, &insert_parameter_exprs, 0); @@ -3725,9 +3735,9 @@ gfc_insert_parameter_exprs (gfc_expr *e, gfc_actual_arglist *param_list) { gfc_actual_arglist *old_param_spec_list = type_param_spec_list; type_param_spec_list = param_list; - return gfc_traverse_expr (e, NULL, &insert_parameter_exprs, 1); - type_param_spec_list = NULL; + bool res = gfc_traverse_expr (e, NULL, &insert_parameter_exprs, 1); type_param_spec_list = old_param_spec_list; + return res; } /* Determines the instance of a parameterized derived type to be used by @@ -3798,7 +3808,7 @@ gfc_get_pdt_instance (gfc_actual_arglist *param_list, gfc_symbol **sym, continue; c1 = gfc_find_component (pdt, param->name, false, true, NULL); - /* An error should already have been thrown in resolve.c + /* An error should already have been thrown in resolve.cc (resolve_fl_derived0). */ if (!pdt->attr.use_assoc && !c1) goto error_return; @@ -4689,7 +4699,7 @@ get_kind: /* Match an IMPLICIT NONE statement. Actually, this statement is - already matched in parse.c, or we would not end up here in the + already matched in parse.cc, or we would not end up here in the first place. So the only thing we need to check, is if there is trailing garbage. If not, the match is successful. */ @@ -4715,7 +4725,7 @@ gfc_match_implicit_none (void) if (c == '(') { (void) gfc_next_ascii_char (); - if (!gfc_notify_std (GFC_STD_F2018, "IMPORT NONE with spec list at %C")) + if (!gfc_notify_std (GFC_STD_F2018, "IMPLICIT NONE with spec list at %C")) return MATCH_ERROR; gfc_gobble_whitespace (); @@ -5851,7 +5861,7 @@ set_binding_label (const char **dest_label, const char *sym_name, /* Set the status of the given common block as being BIND(C) or not, depending on the given parameter, is_bind_c. */ -void +static void set_com_block_bind_c (gfc_common_head *com_block, int is_bind_c) { com_block->is_bind_c = is_bind_c; @@ -6039,7 +6049,7 @@ verify_bind_c_sym (gfc_symbol *tmp_sym, gfc_typespec *ts, the type is C interoperable. Errors are reported by the functions used to set/test these fields. */ -bool +static bool set_verify_bind_c_sym (gfc_symbol *tmp_sym, int num_idents) { bool retval = true; @@ -6059,7 +6069,7 @@ set_verify_bind_c_sym (gfc_symbol *tmp_sym, int num_idents) /* Set the fields marking the given common block as BIND(C), including a binding label, and report any errors encountered. */ -bool +static bool set_verify_bind_c_com_block (gfc_common_head *com_block, int num_idents) { bool retval = true; @@ -6079,7 +6089,7 @@ set_verify_bind_c_com_block (gfc_common_head *com_block, int num_idents) /* Retrieve the list of one or more identifiers that the given bind(c) attribute applies to. */ -bool +static bool get_bind_c_idents (void) { char name[GFC_MAX_SYMBOL_LEN + 1]; @@ -6558,7 +6568,7 @@ gfc_match_formal_arglist (gfc_symbol *progname, int st_flag, matching for the new declaration can be done. The numbers and names of the arguments are checked here. The interface formal arguments are retained in formal_arglist and the characteristics - are compared in resolve.c(resolve_fl_procedure). See the remark + are compared in resolve.cc(resolve_fl_procedure). See the remark in get_proc_name about the eventual need to copy the formal_arglist and populate the formal namespace of the interface symbol. */ if (progname->attr.module_procedure @@ -6701,7 +6711,7 @@ ok: /* gfc_error_now used in following and return with MATCH_YES because doing otherwise results in a cascade of extraneous errors and in - some cases an ICE in symbol.c(gfc_release_symbol). */ + some cases an ICE in symbol.cc(gfc_release_symbol). */ if (progname->attr.module_procedure && progname->attr.host_assoc) { bool arg_count_mismatch = false; @@ -6788,7 +6798,7 @@ match_result (gfc_symbol *function, gfc_symbol **result) clause and BIND(C), either one, or neither. The draft does not require them to come in a specific order. */ -match +static match gfc_match_suffix (gfc_symbol *sym, gfc_symbol **result) { match is_bind_c; /* Found bind(c). */ @@ -7563,7 +7573,7 @@ cleanup: } -/* This is mostly a copy of parse.c(add_global_procedure) but modified to +/* This is mostly a copy of parse.cc(add_global_procedure) but modified to pass the name of the entry, rather than the gfc_current_block name, and to return false upon finding an existing global entry. */ @@ -10100,7 +10110,7 @@ check_extended_derived_type (char *name) not a handled attribute, and MATCH_YES otherwise. TODO: More error checking on attribute conflicts needs to be done. */ -match +static match gfc_get_type_attr_spec (symbol_attribute *attr, char *name) { /* See if the derived type is marked as private. */ @@ -10137,7 +10147,7 @@ gfc_get_type_attr_spec (symbol_attribute *attr, char *name) if (!gfc_add_is_bind_c (attr, NULL, &gfc_current_locus, 0)) return MATCH_ERROR; - /* TODO: attr conflicts need to be checked, probably in symbol.c. */ + /* TODO: attr conflicts need to be checked, probably in symbol.cc. */ } else if (gfc_match (" , abstract") == MATCH_YES) { @@ -11688,7 +11698,7 @@ const ext_attr_t ext_attr_list[] = { __attributes(( attribute-list )) matches then !GCC$ ATTRIBUTES attribute-list :: - Cf. c-parser.c's c_parser_attributes; the data can then directly be + Cf. c-parser.cc's c_parser_attributes; the data can then directly be saved into a TREE. As there is absolutely no risk of confusion, we should never return @@ -11778,6 +11788,7 @@ gfc_match_gcc_unroll (void) { int value; + /* FIXME: use gfc_match_small_literal_int instead, delete small_int */ if (gfc_match_small_int (&value) == MATCH_YES) { if (value < 0 || value > USHRT_MAX) diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.cc index e1336e1..ab3bd36 100644 --- a/gcc/fortran/dependency.c +++ b/gcc/fortran/dependency.cc @@ -1,5 +1,5 @@ /* Dependency analysis - Copyright (C) 2000-2021 Free Software Foundation, Inc. + Copyright (C) 2000-2022 Free Software Foundation, Inc. Contributed by Paul Brook <paul@nowt.org> This file is part of GCC. @@ -18,7 +18,7 @@ You should have received a copy of the GNU General Public License along with GCC; see the file COPYING3. If not see <http://www.gnu.org/licenses/>. */ -/* dependency.c -- Expression dependency analysis code. */ +/* dependency.cc -- Expression dependency analysis code. */ /* There's probably quite a bit of duplication in this file. We currently have different dependency checking functions for different types if dependencies. Ideally these would probably be merged. */ diff --git a/gcc/fortran/dependency.h b/gcc/fortran/dependency.h index 2a2d478..339be76 100644 --- a/gcc/fortran/dependency.h +++ b/gcc/fortran/dependency.h @@ -1,5 +1,5 @@ /* Header for dependency analysis - Copyright (C) 2000-2021 Free Software Foundation, Inc. + Copyright (C) 2000-2022 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of GCC. diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.cc index 14a3078..2a2f990 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.cc @@ -1,5 +1,5 @@ /* Parse tree dumper - Copyright (C) 2003-2021 Free Software Foundation, Inc. + Copyright (C) 2003-2022 Free Software Foundation, Inc. Contributed by Steven Bosscher This file is part of GCC. @@ -1302,10 +1302,10 @@ show_code (int level, gfc_code *c) static void show_iterator (gfc_namespace *ns) { - for (gfc_symbol *sym = ns->proc_name; sym; sym = sym->tlink) + for (gfc_symbol *sym = ns->omp_affinity_iterators; sym; sym = sym->tlink) { gfc_constructor *c; - if (sym != ns->proc_name) + if (sym != ns->omp_affinity_iterators) fputc (',', dumpfile); fputs (sym->name, dumpfile); fputc ('=', dumpfile); @@ -1683,8 +1683,10 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) case OMP_LIST_CACHE: type = "CACHE"; break; case OMP_LIST_IS_DEVICE_PTR: type = "IS_DEVICE_PTR"; break; case OMP_LIST_USE_DEVICE_PTR: type = "USE_DEVICE_PTR"; break; + case OMP_LIST_HAS_DEVICE_ADDR: type = "HAS_DEVICE_ADDR"; break; case OMP_LIST_USE_DEVICE_ADDR: type = "USE_DEVICE_ADDR"; break; case OMP_LIST_NONTEMPORAL: type = "NONTEMPORAL"; break; + case OMP_LIST_ALLOCATE: type = "ALLOCATE"; break; case OMP_LIST_SCAN_IN: type = "INCLUSIVE"; break; case OMP_LIST_SCAN_EX: type = "EXCLUSIVE"; break; default: @@ -1741,10 +1743,15 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) } fprintf (dumpfile, " BIND(%s)", type); } - if (omp_clauses->num_teams) + if (omp_clauses->num_teams_upper) { fputs (" NUM_TEAMS(", dumpfile); - show_expr (omp_clauses->num_teams); + if (omp_clauses->num_teams_lower) + { + show_expr (omp_clauses->num_teams_lower); + fputc (':', dumpfile); + } + show_expr (omp_clauses->num_teams_upper); fputc (')', dumpfile); } if (omp_clauses->device) @@ -1805,6 +1812,10 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) } fputc (')', dumpfile); } + if (omp_clauses->weak) + fputs (" WEAK", dumpfile); + if (omp_clauses->compare) + fputs (" COMPARE", dumpfile); if (omp_clauses->nogroup) fputs (" NOGROUP", dumpfile); if (omp_clauses->simd) @@ -1921,6 +1932,20 @@ show_omp_clauses (gfc_omp_clauses *omp_clauses) fputc (' ', dumpfile); fputs (memorder, dumpfile); } + if (omp_clauses->fail != OMP_MEMORDER_UNSET) + { + const char *memorder; + switch (omp_clauses->fail) + { + case OMP_MEMORDER_ACQUIRE: memorder = "AQUIRE"; break; + case OMP_MEMORDER_RELAXED: memorder = "RELAXED"; break; + case OMP_MEMORDER_SEQ_CST: memorder = "SEQ_CST"; break; + default: gcc_unreachable (); + } + fputs (" FAIL(", dumpfile); + fputs (memorder, dumpfile); + putc (')', dumpfile); + } if (omp_clauses->at != OMP_AT_UNSET) { if (omp_clauses->at != OMP_AT_COMPILATION) diff --git a/gcc/fortran/error.c b/gcc/fortran/error.cc index 5e6e873..c9d6edb 100644 --- a/gcc/fortran/error.c +++ b/gcc/fortran/error.cc @@ -1,5 +1,5 @@ /* Handle errors. - Copyright (C) 2000-2021 Free Software Foundation, Inc. + Copyright (C) 2000-2022 Free Software Foundation, Inc. Contributed by Andy Vaught & Niels Kristian Bech Jensen This file is part of GCC. @@ -83,6 +83,15 @@ gfc_pop_suppress_errors (void) } +/* Query whether errors are suppressed. */ + +bool +gfc_query_suppress_errors (void) +{ + return suppress_errors > 0; +} + + /* Determine terminal width (for trimming source lines in output). */ static int @@ -1087,7 +1096,7 @@ gfc_format_decoder (pretty_printer *pp, text_info *text, const char *spec, return true; } default: - /* Fall through info the middle-end decoder, as e.g. stor-layout.c + /* Fall through info the middle-end decoder, as e.g. stor-layout.cc etc. diagnostics can use the FE printer while the FE is still active. */ return default_tree_printer (pp, text, spec, precision, wide, diff --git a/gcc/fortran/expr.c b/gcc/fortran/expr.cc index b19d3a2..ed82a94 100644 --- a/gcc/fortran/expr.c +++ b/gcc/fortran/expr.cc @@ -1,5 +1,5 @@ /* Routines for manipulation of expression nodes. - Copyright (C) 2000-2021 Free Software Foundation, Inc. + Copyright (C) 2000-2022 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. @@ -35,8 +35,8 @@ along with GCC; see the file COPYING3. If not see There are two functions available elsewhere that provide slightly different flavours of variables. Namely: - expr.c (gfc_get_variable_expr) - symbol.c (gfc_lval_expr_from_sym) + expr.cc (gfc_get_variable_expr) + symbol.cc (gfc_lval_expr_from_sym) TODO: Merge these functions, if possible. */ /* Get a new expression node. */ @@ -312,7 +312,8 @@ gfc_copy_expr (gfc_expr *p) break; case BT_CHARACTER: - if (p->representation.string) + if (p->representation.string + && p->ts.kind == gfc_default_character_kind) q->value.character.string = gfc_char_to_widechar (q->representation.string); else @@ -543,7 +544,7 @@ gfc_free_actual_arglist (gfc_actual_arglist *a1) { a2 = a1->next; if (a1->expr) - gfc_free_expr (a1->expr); + gfc_free_expr (a1->expr); free (a1); a1 = a2; } @@ -2128,6 +2129,8 @@ simplify_parameter_variable (gfc_expr *p, int type) if (e == NULL) return false; + gfc_free_shape (&e->shape, e->rank); + e->shape = gfc_copy_shape (p->shape, p->rank); e->rank = p->rank; if (e->ts.type == BT_CHARACTER && p->ts.u.cl) @@ -2217,10 +2220,9 @@ gfc_simplify_expr (gfc_expr *p, int type) && gfc_intrinsic_func_interface (p, 1) == MATCH_ERROR) return false; - if (p->expr_type == EXPR_FUNCTION) + if (p->symtree && (p->value.function.isym || p->ts.type == BT_UNKNOWN)) { - if (p->symtree) - isym = gfc_find_function (p->symtree->n.sym->name); + isym = gfc_find_function (p->symtree->n.sym->name); if (isym && isym->elemental) scalarize_intrinsic_call (p, false); } @@ -2329,6 +2331,31 @@ gfc_simplify_expr (gfc_expr *p, int type) } +/* Try simplification of an expression via gfc_simplify_expr. + When an error occurs (arithmetic or otherwise), roll back. */ + +bool +gfc_try_simplify_expr (gfc_expr *e, int type) +{ + gfc_expr *n; + bool t, saved_div0; + + if (e == NULL || e->expr_type == EXPR_CONSTANT) + return true; + + saved_div0 = gfc_seen_div0; + gfc_seen_div0 = false; + n = gfc_copy_expr (e); + t = gfc_simplify_expr (n, type) && !gfc_seen_div0; + if (t) + gfc_replace_expr (e, n); + else + gfc_free_expr (n); + gfc_seen_div0 = saved_div0; + return t; +} + + /* Returns the type of an expression with the exception that iterator variables are automatically integers no matter what else they may be declared as. */ @@ -3438,7 +3465,7 @@ check_restricted (gfc_expr *e) break; /* gfc_is_formal_arg broadcasts that a formal argument list is being - processed in resolve.c(resolve_formal_arglist). This is done so + processed in resolve.cc(resolve_formal_arglist). This is done so that host associated dummy array indices are accepted (PR23446). This mechanism also does the same for the specification expressions of array-valued functions. */ @@ -4316,6 +4343,7 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue, { gfc_symbol *sym; bool target; + gfc_ref *ref; if (gfc_is_size_zero_array (rvalue)) { @@ -4345,6 +4373,39 @@ gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue, &rvalue->where); return false; } + + for (ref = rvalue->ref; ref; ref = ref->next) + { + switch (ref->type) + { + case REF_ARRAY: + for (int n = 0; n < ref->u.ar.dimen; n++) + if (!gfc_is_constant_expr (ref->u.ar.start[n]) + || !gfc_is_constant_expr (ref->u.ar.end[n]) + || !gfc_is_constant_expr (ref->u.ar.stride[n])) + { + gfc_error ("Every subscript of target specification " + "at %L must be a constant expression", + &ref->u.ar.where); + return false; + } + break; + + case REF_SUBSTRING: + if (!gfc_is_constant_expr (ref->u.ss.start) + || !gfc_is_constant_expr (ref->u.ss.end)) + { + gfc_error ("Substring starting and ending points of target " + "specification at %L must be constant expressions", + &ref->u.ss.start->where); + return false; + } + break; + + default: + break; + } + } } else { @@ -4587,21 +4648,12 @@ gfc_check_assign_symbol (gfc_symbol *sym, gfc_component *comp, gfc_expr *rvalue) return true; } -/* Invoke gfc_build_init_expr to create an initializer expression, but do not - * require that an expression be built. */ - -gfc_expr * -gfc_build_default_init_expr (gfc_typespec *ts, locus *where) -{ - return gfc_build_init_expr (ts, where, false); -} - /* Build an initializer for a local integer, real, complex, logical, or character variable, based on the command line flags finit-local-zero, finit-integer=, finit-real=, finit-logical=, and finit-character=. With force, an initializer is ALWAYS generated. */ -gfc_expr * +static gfc_expr * gfc_build_init_expr (gfc_typespec *ts, locus *where, bool force) { gfc_expr *init_expr; @@ -4758,8 +4810,17 @@ gfc_build_init_expr (gfc_typespec *ts, locus *where, bool force) return init_expr; } +/* Invoke gfc_build_init_expr to create an initializer expression, but do not + * require that an expression be built. */ + +gfc_expr * +gfc_build_default_init_expr (gfc_typespec *ts, locus *where) +{ + return gfc_build_init_expr (ts, where, false); +} + /* Apply an initialization expression to a typespec. Can be used for symbols or - components. Similar to add_init_expr_to_sym in decl.c; could probably be + components. Similar to add_init_expr_to_sym in decl.cc; could probably be combined with some effort. */ void @@ -4817,7 +4878,7 @@ gfc_apply_init (gfc_typespec *ts, symbol_attribute *attr, gfc_expr *init) /* Check whether an expression is a structure constructor and whether it has other values than NULL. */ -bool +static bool is_non_empty_structure_constructor (gfc_expr * e) { if (e->expr_type != EXPR_STRUCTURE) @@ -5139,7 +5200,8 @@ gfc_get_variable_expr (gfc_symtree *var) if (var->n.sym->attr.flavor != FL_PROCEDURE && ((var->n.sym->as != NULL && var->n.sym->ts.type != BT_CLASS) - || (var->n.sym->ts.type == BT_CLASS && CLASS_DATA (var->n.sym) + || (var->n.sym->ts.type == BT_CLASS && var->n.sym->ts.u.derived + && CLASS_DATA (var->n.sym) && CLASS_DATA (var->n.sym)->as))) { e->rank = var->n.sym->ts.type == BT_CLASS @@ -5855,8 +5917,16 @@ gfc_is_simply_contiguous (gfc_expr *expr, bool strict, bool permit_element) if (expr->expr_type == EXPR_FUNCTION) { - if (expr->value.function.esym) - return expr->value.function.esym->result->attr.contiguous; + if (expr->value.function.isym) + /* TRANSPOSE is the only intrinsic that may return a + non-contiguous array. It's treated as a special case in + gfc_conv_expr_descriptor too. */ + return (expr->value.function.isym->id != GFC_ISYM_TRANSPOSE); + else if (expr->value.function.esym) + /* Only a pointer to an array without the contiguous attribute + can be non-contiguous as a result value. */ + return (expr->value.function.esym->result->attr.contiguous + || !expr->value.function.esym->result->attr.pointer); else { /* Type-bound procedures. */ @@ -6227,10 +6297,13 @@ gfc_check_vardef_context (gfc_expr* e, bool pointer, bool alloc_obj, { if (ptr_component && ref->type == REF_COMPONENT) check_intentin = false; - if (ref->type == REF_COMPONENT && ref->u.c.component->attr.pointer) + if (ref->type == REF_COMPONENT) { - ptr_component = true; - if (!pointer) + gfc_component *comp = ref->u.c.component; + ptr_component = (comp->ts.type == BT_CLASS && comp->attr.class_ok) + ? CLASS_DATA (comp)->attr.class_pointer + : comp->attr.pointer; + if (ptr_component && !pointer) check_intentin = false; } if (ref->type == REF_INQUIRY diff --git a/gcc/fortran/f95-lang.c b/gcc/fortran/f95-lang.cc index 58dcaf0..1a895a2 100644 --- a/gcc/fortran/f95-lang.c +++ b/gcc/fortran/f95-lang.cc @@ -1,5 +1,5 @@ /* gfortran backend interface - Copyright (C) 2000-2021 Free Software Foundation, Inc. + Copyright (C) 2000-2022 Free Software Foundation, Inc. Contributed by Paul Brook. This file is part of GCC. @@ -18,7 +18,7 @@ You should have received a copy of the GNU General Public License along with GCC; see the file COPYING3. If not see <http://www.gnu.org/licenses/>. */ -/* f95-lang.c-- GCC backend interface stuff */ +/* f95-lang.cc-- GCC backend interface stuff */ /* declare required prototypes: */ diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.cc index 145bff5..22f1bb5 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.cc @@ -1,5 +1,5 @@ /* Pass manager for Fortran front end. - Copyright (C) 2010-2021 Free Software Foundation, Inc. + Copyright (C) 2010-2022 Free Software Foundation, Inc. Contributed by Thomas König. This file is part of GCC. @@ -2390,7 +2390,7 @@ doloop_contained_procedure_code (gfc_code **c, switch (co->op) { case EXEC_ASSIGN: - if (co->expr1->symtree->n.sym == do_var) + if (co->expr1->symtree && co->expr1->symtree->n.sym == do_var) gfc_error_now (errmsg, do_var->name, &co->loc, info->procedure->name, &info->where_do); break; @@ -2411,14 +2411,14 @@ doloop_contained_procedure_code (gfc_code **c, break; case EXEC_OPEN: - if (co->ext.open->iostat + if (co->ext.open && co->ext.open->iostat && co->ext.open->iostat->symtree->n.sym == do_var) gfc_error_now (errmsg, do_var->name, &co->ext.open->iostat->where, info->procedure->name, &info->where_do); break; case EXEC_CLOSE: - if (co->ext.close->iostat + if (co->ext.close && co->ext.close->iostat && co->ext.close->iostat->symtree->n.sym == do_var) gfc_error_now (errmsg, do_var->name, &co->ext.close->iostat->where, info->procedure->name, &info->where_do); @@ -2429,7 +2429,8 @@ doloop_contained_procedure_code (gfc_code **c, { case EXEC_INQUIRE: -#define CHECK_INQ(a) do { if (co->ext.inquire->a && \ +#define CHECK_INQ(a) do { if (co->ext.inquire && \ + co->ext.inquire->a && \ co->ext.inquire->a->symtree->n.sym == do_var) \ gfc_error_now (errmsg, do_var->name, \ &co->ext.inquire->a->where, \ @@ -2448,21 +2449,23 @@ doloop_contained_procedure_code (gfc_code **c, #undef CHECK_INQ case EXEC_READ: - if (co->expr1 && co->expr1->symtree->n.sym == do_var) + if (co->expr1 && co->expr1->symtree + && co->expr1->symtree->n.sym == do_var) gfc_error_now (errmsg, do_var->name, &co->expr1->where, info->procedure->name, &info->where_do); /* Fallthrough. */ case EXEC_WRITE: - if (co->ext.dt->iostat + if (co->ext.dt && co->ext.dt->iostat && co->ext.dt->iostat->symtree && co->ext.dt->iostat->symtree->n.sym == do_var) gfc_error_now (errmsg, do_var->name, &co->ext.dt->iostat->where, info->procedure->name, &info->where_do); break; case EXEC_IOLENGTH: - if (co->expr1 && co->expr1->symtree->n.sym == do_var) + if (co->expr1 && co->expr1->symtree + && co->expr1->symtree->n.sym == do_var) gfc_error_now (errmsg, do_var->name, &co->expr1->where, info->procedure->name, &info->where_do); break; @@ -2650,7 +2653,7 @@ doloop_code (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED, do_sym = cl->ext.iterator->var->symtree->n.sym; - if (a->expr && a->expr->symtree + if (a->expr && a->expr->symtree && f->sym && a->expr->symtree->n.sym == do_sym) { if (f->sym->attr.intent == INTENT_OUT) @@ -2914,6 +2917,7 @@ do_subscript (gfc_expr **e) { if (ar->as->lower[i] && ar->as->lower[i]->expr_type == EXPR_CONSTANT + && ar->as->lower[i]->ts.type == BT_INTEGER && mpz_cmp (val, ar->as->lower[i]->value.integer) < 0) gfc_warning (warn, "Array reference at %L out of bounds " "(%ld < %ld) in loop beginning at %L", @@ -2923,6 +2927,7 @@ do_subscript (gfc_expr **e) if (ar->as->upper[i] && ar->as->upper[i]->expr_type == EXPR_CONSTANT + && ar->as->upper[i]->ts.type == BT_INTEGER && mpz_cmp (val, ar->as->upper[i]->value.integer) > 0) gfc_warning (warn, "Array reference at %L out of bounds " "(%ld > %ld) in loop beginning at %L", @@ -2938,6 +2943,7 @@ do_subscript (gfc_expr **e) { if (ar->as->lower[i] && ar->as->lower[i]->expr_type == EXPR_CONSTANT + && ar->as->lower[i]->ts.type == BT_INTEGER && mpz_cmp (val, ar->as->lower[i]->value.integer) < 0) gfc_warning (warn, "Array reference at %L out of bounds " "(%ld < %ld) in loop beginning at %L", @@ -2947,6 +2953,7 @@ do_subscript (gfc_expr **e) if (ar->as->upper[i] && ar->as->upper[i]->expr_type == EXPR_CONSTANT + && ar->as->upper[i]->ts.type == BT_INTEGER && mpz_cmp (val, ar->as->upper[i]->value.integer) > 0) gfc_warning (warn, "Array reference at %L out of bounds " "(%ld > %ld) in loop beginning at %L", @@ -5229,7 +5236,7 @@ gfc_expr_walker (gfc_expr **e, walk_expr_fn_t exprfn, void *data) case EXPR_OP: WALK_SUBEXPR ((*e)->value.op.op1); WALK_SUBEXPR_TAIL ((*e)->value.op.op2); - break; + /* No fallthru because of the tail recursion above. */ case EXPR_FUNCTION: for (a = (*e)->value.function.actual; a; a = a->next) WALK_SUBEXPR (a->expr); @@ -5634,7 +5641,8 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn, WALK_SUBEXPR (co->ext.omp_clauses->chunk_size); WALK_SUBEXPR (co->ext.omp_clauses->safelen_expr); WALK_SUBEXPR (co->ext.omp_clauses->simdlen_expr); - WALK_SUBEXPR (co->ext.omp_clauses->num_teams); + WALK_SUBEXPR (co->ext.omp_clauses->num_teams_lower); + WALK_SUBEXPR (co->ext.omp_clauses->num_teams_upper); WALK_SUBEXPR (co->ext.omp_clauses->device); WALK_SUBEXPR (co->ext.omp_clauses->thread_limit); WALK_SUBEXPR (co->ext.omp_clauses->dist_chunk_size); diff --git a/gcc/fortran/gfc-diagnostic.def b/gcc/fortran/gfc-diagnostic.def index 91e33a0..9c0e1be 100644 --- a/gcc/fortran/gfc-diagnostic.def +++ b/gcc/fortran/gfc-diagnostic.def @@ -1,4 +1,4 @@ -/* Copyright (C) 2001-2021 Free Software Foundation, Inc. +/* Copyright (C) 2001-2022 Free Software Foundation, Inc. This file is part of GCC. diff --git a/gcc/fortran/gfc-internals.texi b/gcc/fortran/gfc-internals.texi index 8644900..1409e28 100644 --- a/gcc/fortran/gfc-internals.texi +++ b/gcc/fortran/gfc-internals.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @c %**start of header @setfilename gfc-internals.info -@set copyrights-gfortran 2007-2021 +@set copyrights-gfortran 2007-2022 @include gcc-common.texi @@ -187,7 +187,7 @@ machinery to create the code that enables @command{gfortran} and call the relevant handler function. This generated code calls the @code{gfc_handle_option} code in -@file{options.c} with an enumerator variable indicating which option is +@file{options.cc} with an enumerator variable indicating which option is to be processed, and the relevant integer or string values associated with that option flag. Typically, @code{gfc_handle_option} uses these arguments to set global flags which record the option states. @@ -195,7 +195,7 @@ arguments to set global flags which record the option states. The global flags that record the option states are stored in the @code{gfc_option_t} struct, which is defined in @file{gfortran.h}. Before the options are processed, initial values for these flags are set -in @code{gfc_init_option} in @file{options.c}; these become the default +in @code{gfc_init_option} in @file{options.cc}; these become the default values for the options. @@ -232,7 +232,7 @@ variable, this will be parsed as an assignment statement, and the error discarded. However, when @code{IF} is not a valid variable, this buffered error message will be reported to the user. -The error handling code is implemented in @file{error.c}. Errors are +The error handling code is implemented in @file{error.cc}. Errors are normally entered into the buffer with the @code{gfc_error} function. Warnings go through a similar buffering process, and are entered into the buffer with @code{gfc_warning}. There is also a special-purpose @@ -269,7 +269,7 @@ The syntax for the strings used to produce the error/warning message in the various error and warning functions is similar to the @code{printf} syntax, with @samp{%}-escapes to insert variable values. The details, and the allowable codes, are documented in the @code{error_print} -function in @file{error.c}. +function in @file{error.cc}. @c --------------------------------------------------------------------- @c Frontend Data Structures @@ -281,7 +281,7 @@ function in @file{error.c}. This chapter should describe the details necessary to understand how the various @code{gfc_*} data are used and interact. In general it is -advisable to read the code in @file{dump-parse-tree.c} as its routines +advisable to read the code in @file{dump-parse-tree.cc} as its routines should exhaust all possible valid combinations of content for these structures. @@ -831,7 +831,7 @@ needs to be executed before and after evaluation of the expression. When using a local @code{gfc_se} to convert some expression, it is often necessary to add the generated @code{pre} and @code{post} blocks to the @code{pre} or @code{post} blocks of the outer @code{gfc_se}. -Code like this (lifted from @file{trans-expr.c}) is fairly common: +Code like this (lifted from @file{trans-expr.cc}) is fairly common: @smallexample gfc_se cont_se; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 66192c0..cb136f8 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1,5 +1,5 @@ /* gfortran header file - Copyright (C) 2000-2021 Free Software Foundation, Inc. + Copyright (C) 2000-2022 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. @@ -170,7 +170,7 @@ enum notification enum match { MATCH_NO = 1, MATCH_YES, MATCH_ERROR }; -/* Used for different Fortran source forms in places like scanner.c. */ +/* Used for different Fortran source forms in places like scanner.cc. */ enum gfc_source_form { FORM_FREE, FORM_FIXED, FORM_UNKNOWN }; @@ -344,7 +344,7 @@ enum procedure_type }; /* Intent types. Note that these values are also used in another enum in - decl.c (match_attr_spec). */ + decl.cc (match_attr_spec). */ enum sym_intent { INTENT_UNKNOWN = 0, INTENT_IN, INTENT_OUT, INTENT_INOUT }; @@ -380,7 +380,7 @@ enum oacc_routine_lop /* Strings for all symbol attributes. We use these for dumping the parse tree, in error messages, and also when reading and writing - modules. In symbol.c. */ + modules. In symbol.cc. */ extern const mstring flavors[]; extern const mstring procedures[]; extern const mstring intents[]; @@ -388,7 +388,7 @@ extern const mstring access_types[]; extern const mstring ifsrc_types[]; extern const mstring save_status[]; -/* Strings for DTIO procedure names. In symbol.c. */ +/* Strings for DTIO procedure names. In symbol.cc. */ extern const mstring dtio_procs[]; enum dtio_codes @@ -799,7 +799,7 @@ CInteropKind_t; /* Array of structs, where the structs represent the C interop kinds. The list will be implemented based on a hash of the kind name since these could be accessed multiple times. - Declared in trans-types.c as a global, since it's in that file + Declared in trans-types.cc as a global, since it's in that file that the list is initialized. */ extern CInteropKind_t c_interop_kinds_table[]; @@ -1083,6 +1083,7 @@ typedef struct void gfc_push_suppress_errors (void); void gfc_pop_suppress_errors (void); +bool gfc_query_suppress_errors (void); /* Character length structures hold the expression that gives the @@ -1199,6 +1200,9 @@ gfc_formal_arglist; #define gfc_get_formal_arglist() XCNEW (gfc_formal_arglist) +struct gfc_dummy_arg; + + /* The gfc_actual_arglist structure is for actual arguments and for type parameter specification lists. */ typedef struct gfc_actual_arglist @@ -1207,14 +1211,14 @@ typedef struct gfc_actual_arglist /* Alternate return label when the expr member is null. */ struct gfc_st_label *label; - /* This is set to the type of an eventual omitted optional - argument. This is used to determine if a hidden string length - argument has to be added to a function call. */ - bt missing_arg_type; - gfc_param_spec_type spec_type; struct gfc_expr *expr; + + /* The dummy arg this actual arg is associated with, if the interface + is explicit. NULL otherwise. */ + gfc_dummy_arg *associated_dummy; + struct gfc_actual_arglist *next; } gfc_actual_arglist; @@ -1388,7 +1392,9 @@ enum OMP_LIST_USE_DEVICE_PTR, OMP_LIST_USE_DEVICE_ADDR, OMP_LIST_NONTEMPORAL, - OMP_LIST_NUM + OMP_LIST_ALLOCATE, + OMP_LIST_HAS_DEVICE_ADDR, + OMP_LIST_NUM /* Must be the last. */ }; /* Because a symbol can belong to multiple namelists, they must be @@ -1502,7 +1508,8 @@ typedef struct gfc_omp_clauses struct gfc_expr *chunk_size; struct gfc_expr *safelen_expr; struct gfc_expr *simdlen_expr; - struct gfc_expr *num_teams; + struct gfc_expr *num_teams_lower; + struct gfc_expr *num_teams_upper; struct gfc_expr *device; struct gfc_expr *thread_limit; struct gfc_expr *grainsize; @@ -1525,10 +1532,11 @@ typedef struct gfc_omp_clauses unsigned sched_simd:1, sched_monotonic:1, sched_nonmonotonic:1; unsigned simd:1, threads:1, depend_source:1, destroy:1, order_concurrent:1; unsigned order_unconstrained:1, order_reproducible:1, capture:1; - unsigned grainsize_strict:1, num_tasks_strict:1; + unsigned grainsize_strict:1, num_tasks_strict:1, compare:1, weak:1; ENUM_BITFIELD (gfc_omp_sched_kind) sched_kind:3; ENUM_BITFIELD (gfc_omp_device_type) device_type:2; ENUM_BITFIELD (gfc_omp_memorder) memorder:3; + ENUM_BITFIELD (gfc_omp_memorder) fail:3; ENUM_BITFIELD (gfc_omp_cancel_kind) cancel:3; ENUM_BITFIELD (gfc_omp_proc_bind_kind) proc_bind:3; ENUM_BITFIELD (gfc_omp_depend_op) depobj_update:3; @@ -1817,7 +1825,7 @@ typedef struct gfc_symbol /* Defined only for Cray pointees; points to their pointer. */ struct gfc_symbol *cp_pointer; - int entry_id; /* Used in resolve.c for entries. */ + int entry_id; /* Used in resolve.cc for entries. */ /* CLASS hashed name for declared and dynamic types in the class. */ int hash_value; @@ -1842,7 +1850,7 @@ typedef struct gfc_symbol current statement have the mark member nonzero. Of these symbols, symbols with old_symbol equal to NULL are symbols created within the current statement. Otherwise, old_symbol points to a copy of - the old symbol. gfc_new is used in symbol.c to flag new symbols. + the old symbol. gfc_new is used in symbol.cc to flag new symbols. comp_mark is used to indicate variables which have component accesses in OpenMP/OpenACC directive clauses. */ struct gfc_symbol *old_symbol; @@ -2100,6 +2108,9 @@ typedef struct gfc_namespace /* !$ACC ROUTINE clauses. */ gfc_omp_clauses *oacc_routine_clauses; + /* !$ACC TASK AFFINITY iterator symbols. */ + gfc_symbol *omp_affinity_iterators; + /* !$ACC ROUTINE names. */ gfc_oacc_routine_name *oacc_routine_names; @@ -2298,14 +2309,38 @@ typedef struct gfc_intrinsic_arg gfc_typespec ts; unsigned optional:1, value:1; ENUM_BITFIELD (sym_intent) intent:2; - gfc_actual_arglist *actual; struct gfc_intrinsic_arg *next; - } gfc_intrinsic_arg; +typedef enum { + GFC_UNDEFINED_DUMMY_ARG = 0, + GFC_INTRINSIC_DUMMY_ARG, + GFC_NON_INTRINSIC_DUMMY_ARG +} +gfc_dummy_arg_intrinsicness; + +/* dummy arg of either an intrinsic or a user-defined procedure. */ +struct gfc_dummy_arg +{ + gfc_dummy_arg_intrinsicness intrinsicness; + + union { + gfc_intrinsic_arg *intrinsic; + gfc_formal_arglist *non_intrinsic; + } u; +}; + +#define gfc_get_dummy_arg() XCNEW (gfc_dummy_arg) + + +const char * gfc_dummy_arg_get_name (gfc_dummy_arg &); +const gfc_typespec & gfc_dummy_arg_get_typespec (gfc_dummy_arg &); +bool gfc_dummy_arg_is_optional (gfc_dummy_arg &); + + /* Specifies the various kinds of check functions used to verify the argument lists of intrinsic functions. fX with X an integer refer to check functions of intrinsics with X arguments. f1m is used for @@ -2457,7 +2492,7 @@ typedef struct gfc_expr unsigned int error : 1; /* Mark an expression where a user operator has been substituted by - a function call in interface.c(gfc_extend_expr). */ + a function call in interface.cc(gfc_extend_expr). */ unsigned int user_operator : 1; /* Mark an expression as being a MOLD argument of ALLOCATE. */ @@ -2615,7 +2650,7 @@ extern gfc_logical_info gfc_logical_kinds[]; typedef struct { mpfr_t epsilon, huge, tiny, subnormal; - int kind, radix, digits, min_exponent, max_exponent; + int kind, abi_kind, radix, digits, min_exponent, max_exponent; int range, precision; /* The precision of the type as reported by GET_MODE_PRECISION. */ @@ -3086,7 +3121,7 @@ gfc_finalizer; /************************ Function prototypes *************************/ -/* decl.c */ +/* decl.cc */ bool gfc_in_match_data (void); match gfc_match_char_spec (gfc_typespec *); extern int directive_unroll; @@ -3116,7 +3151,6 @@ struct gfc_vect_builtin_tuple extern hash_map<nofree_string_hash, int> *gfc_vectorized_builtins; /* Handling Parameterized Derived Types */ -bool gfc_insert_kind_parameter_exprs (gfc_expr *); bool gfc_insert_parameter_exprs (gfc_expr *, gfc_actual_arglist *); match gfc_get_pdt_instance (gfc_actual_arglist *, gfc_symbol **, gfc_actual_arglist **); @@ -3128,7 +3162,7 @@ match gfc_get_pdt_instance (gfc_actual_arglist *, gfc_symbol **, && gfc_state_stack->previous->previous->state == COMP_SUBMODULE \ && attr->module_procedure) -/* scanner.c */ +/* scanner.cc */ void gfc_scanner_done_1 (void); void gfc_scanner_init_1 (void); @@ -3177,7 +3211,7 @@ extern locus gfc_current_locus; void gfc_start_source_files (void); void gfc_end_source_files (void); -/* misc.c */ +/* misc.cc */ void gfc_clear_ts (gfc_typespec *); FILE *gfc_open_file (const char *); const char *gfc_basic_typename (bt); @@ -3210,7 +3244,7 @@ vec_push (char **&optr, size_t &osz, const char *elt) HOST_WIDE_INT gfc_mpz_get_hwi (mpz_t); void gfc_mpz_set_hwi (mpz_t, const HOST_WIDE_INT); -/* options.c */ +/* options.cc */ unsigned int gfc_option_lang_mask (void); void gfc_init_options_struct (struct gcc_options *); void gfc_init_options (unsigned int, @@ -3220,14 +3254,14 @@ bool gfc_handle_option (size_t, const char *, HOST_WIDE_INT, int, location_t, bool gfc_post_options (const char **); char *gfc_get_option_string (void); -/* f95-lang.c */ +/* f95-lang.cc */ void gfc_maybe_initialize_eh (void); -/* iresolve.c */ +/* iresolve.cc */ const char * gfc_get_string (const char *, ...) ATTRIBUTE_PRINTF_1; bool gfc_find_sym_in_expr (gfc_symbol *, gfc_expr *); -/* error.c */ +/* error.cc */ void gfc_error_init_1 (void); void gfc_diagnostics_init (void); void gfc_diagnostics_finish (void); @@ -3275,7 +3309,7 @@ void gfc_free_error (gfc_error_buffer *); void gfc_get_errors (int *, int *); void gfc_errors_to_warnings (bool); -/* arith.c */ +/* arith.cc */ void gfc_arith_init_1 (void); void gfc_arith_done_1 (void); arith gfc_check_integer_range (mpz_t p, int kind); @@ -3283,8 +3317,7 @@ bool gfc_check_character_range (gfc_char_t, int); extern bool gfc_seen_div0; -/* trans-types.c */ -bool gfc_check_any_c_kind (gfc_typespec *); +/* trans-types.cc */ int gfc_validate_kind (bt, int, bool); int gfc_get_int_kind_from_width_isofortranenv (int size); int gfc_get_real_kind_from_width_isofortranenv (int size); @@ -3312,7 +3345,7 @@ extern int gfc_character_storage_size; #define gfc_integer_4_kind 4 #define gfc_real_4_kind 4 -/* symbol.c */ +/* symbol.cc */ void gfc_clear_new_implicit (void); bool gfc_add_new_implicit_range (int, int); bool gfc_merge_new_implicit (gfc_typespec *); @@ -3349,11 +3382,9 @@ bool gfc_add_threadprivate (symbol_attribute *, const char *, locus *); bool gfc_add_omp_declare_target (symbol_attribute *, const char *, locus *); bool gfc_add_omp_declare_target_link (symbol_attribute *, const char *, locus *); -bool gfc_add_saved_common (symbol_attribute *, locus *); bool gfc_add_target (symbol_attribute *, locus *); bool gfc_add_dummy (symbol_attribute *, const char *, locus *); bool gfc_add_generic (symbol_attribute *, const char *, locus *); -bool gfc_add_common (symbol_attribute *, locus *); bool gfc_add_in_common (symbol_attribute *, const char *, locus *); bool gfc_add_in_equivalence (symbol_attribute *, const char *, locus *); bool gfc_add_data (symbol_attribute *, const char *, locus *); @@ -3388,7 +3419,6 @@ bool gfc_copy_attr (symbol_attribute *, symbol_attribute *, locus *); int gfc_copy_dummy_sym (gfc_symbol **, gfc_symbol *, int); bool gfc_add_component (gfc_symbol *, const char *, gfc_component **); gfc_symbol *gfc_use_derived (gfc_symbol *); -gfc_symtree *gfc_use_derived_tree (gfc_symtree *); gfc_component *gfc_find_component (gfc_symbol *, const char *, bool, bool, gfc_ref **); @@ -3404,8 +3434,8 @@ void gfc_delete_symtree (gfc_symtree **, const char *); gfc_symtree *gfc_get_unique_symtree (gfc_namespace *); gfc_user_op *gfc_get_uop (const char *); gfc_user_op *gfc_find_uop (const char *, gfc_namespace *); -void gfc_free_symbol (gfc_symbol *); -void gfc_release_symbol (gfc_symbol *); +void gfc_free_symbol (gfc_symbol *&); +void gfc_release_symbol (gfc_symbol *&); gfc_symbol *gfc_new_symbol (const char *, gfc_namespace *); gfc_symtree* gfc_find_symtree_in_proc (const char *, gfc_namespace *); int gfc_find_symbol (const char *, gfc_namespace *, int, gfc_symbol **); @@ -3429,8 +3459,7 @@ void gfc_undo_symbols (void); void gfc_commit_symbols (void); void gfc_commit_symbol (gfc_symbol *); gfc_charlen *gfc_new_charlen (gfc_namespace *, gfc_charlen *); -void gfc_free_charlen (gfc_charlen *, gfc_charlen *); -void gfc_free_namespace (gfc_namespace *); +void gfc_free_namespace (gfc_namespace *&); void gfc_symbol_init_2 (void); void gfc_symbol_done_2 (void); @@ -3449,14 +3478,13 @@ void gfc_traverse_gsymbol (gfc_gsymbol *, void (*)(gfc_gsymbol *, void *), void gfc_typebound_proc* gfc_get_typebound_proc (gfc_typebound_proc*); gfc_symbol* gfc_get_derived_super_type (gfc_symbol*); -gfc_symbol* gfc_get_ultimate_derived_super_type (gfc_symbol*); bool gfc_type_is_extension_of (gfc_symbol *, gfc_symbol *); bool gfc_type_compatible (gfc_typespec *, gfc_typespec *); void gfc_copy_formal_args_intr (gfc_symbol *, gfc_intrinsic_sym *, gfc_actual_arglist *, bool copy_type = false); -void gfc_free_finalizer (gfc_finalizer *el); /* Needed in resolve.c, too */ +void gfc_free_finalizer (gfc_finalizer *el); /* Needed in resolve.cc, too */ bool gfc_check_symbol_typed (gfc_symbol*, gfc_namespace*, bool, locus); gfc_namespace* gfc_find_proc_namespace (gfc_namespace*); @@ -3465,7 +3493,7 @@ bool gfc_is_associate_pointer (gfc_symbol*); gfc_symbol * gfc_find_dt_in_generic (gfc_symbol *); gfc_formal_arglist *gfc_sym_get_dummy_args (gfc_symbol *); -/* intrinsic.c -- true if working in an init-expr, false otherwise. */ +/* intrinsic.cc -- true if working in an init-expr, false otherwise. */ extern bool gfc_init_expr_flag; /* Given a symbol that we have decided is intrinsic, mark it as such @@ -3478,6 +3506,12 @@ void gfc_intrinsic_init_1 (void); void gfc_intrinsic_done_1 (void); char gfc_type_letter (bt, bool logical_equals_int = false); +int gfc_type_abi_kind (bt, int); +static inline int +gfc_type_abi_kind (gfc_typespec *ts) +{ + return gfc_type_abi_kind (ts->type, ts->kind); +} gfc_symbol * gfc_get_intrinsic_sub_symbol (const char *); gfc_symbol *gfc_get_intrinsic_function_symbol (gfc_expr *); gfc_symbol *gfc_find_intrinsic_symbol (gfc_expr *); @@ -3504,7 +3538,7 @@ void gfc_warn_intrinsic_shadow (const gfc_symbol*, bool, bool); bool gfc_check_intrinsic_standard (const gfc_intrinsic_sym*, const char**, bool, locus); -/* match.c -- FIXME */ +/* match.cc -- FIXME */ void gfc_free_iterator (gfc_iterator *, int); void gfc_free_forall_iterator (gfc_forall_iterator *); void gfc_free_alloc_list (gfc_alloc *); @@ -3516,10 +3550,10 @@ void gfc_free_data (gfc_data *); void gfc_reject_data (gfc_namespace *); void gfc_free_case_list (gfc_case *); -/* matchexp.c -- FIXME too? */ +/* matchexp.cc -- FIXME too? */ gfc_expr *gfc_get_parentheses (gfc_expr *); -/* openmp.c */ +/* openmp.cc */ struct gfc_omp_saved_state { void *ptrs[2]; int ints[1]; }; bool gfc_omp_requires_add_clause (gfc_omp_requires_kind, const char *, locus *, const char *); @@ -3543,11 +3577,10 @@ void gfc_omp_restore_state (struct gfc_omp_saved_state *); void gfc_free_expr_list (gfc_expr_list *); void gfc_resolve_oacc_directive (gfc_code *, gfc_namespace *); void gfc_resolve_oacc_declare (gfc_namespace *); -void gfc_resolve_oacc_parallel_loop_blocks (gfc_code *, gfc_namespace *); void gfc_resolve_oacc_blocks (gfc_code *, gfc_namespace *); void gfc_resolve_oacc_routines (gfc_namespace *); -/* expr.c */ +/* expr.cc */ void gfc_free_actual_arglist (gfc_actual_arglist *); gfc_actual_arglist *gfc_copy_actual_arglist (gfc_actual_arglist *); @@ -3565,6 +3598,7 @@ void gfc_free_ref_list (gfc_ref *); void gfc_type_convert_binary (gfc_expr *, int); bool gfc_is_constant_expr (gfc_expr *); bool gfc_simplify_expr (gfc_expr *, int); +bool gfc_try_simplify_expr (gfc_expr *, int); int gfc_has_vector_index (gfc_expr *); gfc_expr *gfc_get_expr (void); @@ -3600,7 +3634,6 @@ bool gfc_check_pointer_assign (gfc_expr *lvalue, gfc_expr *rvalue, bool gfc_check_assign_symbol (gfc_symbol *, gfc_component *, gfc_expr *); gfc_expr *gfc_build_default_init_expr (gfc_typespec *, locus *); -gfc_expr *gfc_build_init_expr (gfc_typespec *, locus *, bool); void gfc_apply_init (gfc_typespec *, symbol_attribute *, gfc_expr *); bool gfc_has_default_initializer (gfc_symbol *); gfc_expr *gfc_default_initializer (gfc_typespec *); @@ -3636,7 +3669,7 @@ gfc_expr* gfc_build_intrinsic_call (gfc_namespace *, gfc_isym_id, const char*, bool gfc_check_vardef_context (gfc_expr*, bool, bool, bool, const char*); -/* st.c */ +/* st.cc */ extern gfc_code new_st; void gfc_clear_new_st (void); @@ -3646,7 +3679,7 @@ void gfc_free_statement (gfc_code *); void gfc_free_statements (gfc_code *); void gfc_free_association_list (gfc_association_list *); -/* resolve.c */ +/* resolve.cc */ void gfc_expression_rank (gfc_expr *); bool gfc_resolve_ref (gfc_expr *); bool gfc_resolve_expr (gfc_expr *); @@ -3666,7 +3699,6 @@ bool gfc_resolve_dim_arg (gfc_expr *); bool gfc_is_formal_arg (void); bool gfc_resolve_substring (gfc_ref *, bool *); void gfc_resolve_substring_charlen (gfc_expr *); -match gfc_iso_c_sub_interface(gfc_code *, gfc_symbol *); gfc_expr *gfc_expr_to_initialize (gfc_expr *); bool gfc_type_is_extensible (gfc_symbol *); bool gfc_resolve_intrinsic (gfc_symbol *, locus *); @@ -3677,7 +3709,7 @@ int gfc_pure_function (gfc_expr *e, const char **name); int gfc_implicit_pure_function (gfc_expr *e); -/* array.c */ +/* array.cc */ gfc_iterator *gfc_copy_iterator (gfc_iterator *); void gfc_free_array_spec (gfc_array_spec *); @@ -3709,7 +3741,7 @@ bool gfc_is_compile_time_shape (gfc_array_spec *); bool gfc_ref_dimen_size (gfc_array_ref *, int dimen, mpz_t *, mpz_t *); -/* interface.c -- FIXME: some of these should be in symbol.c */ +/* interface.cc -- FIXME: some of these should be in symbol.cc */ void gfc_free_interface (gfc_interface *); bool gfc_compare_derived_types (gfc_symbol *, gfc_symbol *); bool gfc_compare_types (gfc_typespec *, gfc_typespec *); @@ -3746,7 +3778,7 @@ bool gfc_compare_actual_formal (gfc_actual_arglist **, gfc_formal_arglist *, int, int, bool, locus *); -/* io.c */ +/* io.cc */ extern gfc_st_label format_asterisk; void gfc_free_open (gfc_open *); @@ -3762,7 +3794,7 @@ bool gfc_resolve_dt (gfc_code *, gfc_dt *, locus *); void gfc_free_wait (gfc_wait *); bool gfc_resolve_wait (gfc_wait *); -/* module.c */ +/* module.cc */ void gfc_module_init_2 (void); void gfc_module_done_2 (void); void gfc_dump_module (const char *, int); @@ -3771,7 +3803,7 @@ void gfc_free_use_stmts (gfc_use_list *); const char *gfc_dt_lower_string (const char *); const char *gfc_dt_upper_string (const char *); -/* primary.c */ +/* primary.cc */ symbol_attribute gfc_variable_attr (gfc_expr *, gfc_typespec *); symbol_attribute gfc_expr_attr (gfc_expr *); symbol_attribute gfc_caf_attr (gfc_expr *, bool i = false, bool *r = NULL); @@ -3783,19 +3815,19 @@ bool gfc_convert_to_structure_constructor (gfc_expr *, gfc_symbol *, gfc_expr **, gfc_actual_arglist **, bool); -/* trans.c */ +/* trans.cc */ void gfc_generate_code (gfc_namespace *); void gfc_generate_module_code (gfc_namespace *); -/* trans-intrinsic.c */ +/* trans-intrinsic.cc */ bool gfc_inline_intrinsic_function_p (gfc_expr *); -/* bbt.c */ +/* bbt.cc */ typedef int (*compare_fn) (void *, void *); void gfc_insert_bbt (void *, void *, compare_fn); void gfc_delete_bbt (void *, void *, compare_fn); -/* dump-parse-tree.c */ +/* dump-parse-tree.cc */ void gfc_dump_parse_tree (gfc_namespace *, FILE *); void gfc_dump_c_prototypes (gfc_namespace *, FILE *); void gfc_dump_external_c_prototypes (FILE *); @@ -3803,17 +3835,17 @@ void gfc_dump_global_symbols (FILE *); void debug (gfc_symbol *); void debug (gfc_expr *); -/* parse.c */ +/* parse.cc */ bool gfc_parse_file (void); void gfc_global_used (gfc_gsymbol *, locus *); gfc_namespace* gfc_build_block_ns (gfc_namespace *); -/* dependency.c */ +/* dependency.cc */ int gfc_dep_compare_functions (gfc_expr *, gfc_expr *, bool); int gfc_dep_compare_expr (gfc_expr *, gfc_expr *); bool gfc_dep_difference (gfc_expr *, gfc_expr *, mpz_t *); -/* check.c */ +/* check.cc */ bool gfc_check_same_strlen (const gfc_expr*, const gfc_expr*, const char*); bool gfc_calculate_transfer_sizes (gfc_expr*, gfc_expr*, gfc_expr*, size_t*, size_t*, size_t*); @@ -3823,7 +3855,7 @@ bool gfc_invalid_boz (const char *, locus *); bool gfc_invalid_null_arg (gfc_expr *); -/* class.c */ +/* class.cc */ void gfc_fix_class_refs (gfc_expr *e); void gfc_add_component_ref (gfc_expr *, const char *); void gfc_add_class_array_ref (gfc_expr *); @@ -3866,7 +3898,7 @@ bool gfc_is_finalizable (gfc_symbol *, gfc_expr **); && CLASS_DATA (sym)->attr.dimension \ && !CLASS_DATA (sym)->attr.class_pointer) -/* frontend-passes.c */ +/* frontend-passes.cc */ void gfc_run_passes (gfc_namespace *); @@ -3880,17 +3912,17 @@ bool gfc_has_dimen_vector_ref (gfc_expr *e); void gfc_check_externals (gfc_namespace *); bool gfc_fix_implicit_pure (gfc_namespace *); -/* simplify.c */ +/* simplify.cc */ void gfc_convert_mpz_to_signed (mpz_t, int); gfc_expr *gfc_simplify_ieee_functions (gfc_expr *); bool gfc_is_size_zero_array (gfc_expr *); -/* trans-array.c */ +/* trans-array.cc */ bool gfc_is_reallocatable_lhs (gfc_expr *); -/* trans-decl.c */ +/* trans-decl.cc */ void finish_oacc_declare (gfc_namespace *, gfc_symbol *, bool); void gfc_adjust_builtins (void); diff --git a/gcc/fortran/gfortran.texi b/gcc/fortran/gfortran.texi index a54153b..2a55676 100644 --- a/gcc/fortran/gfortran.texi +++ b/gcc/fortran/gfortran.texi @@ -1,7 +1,7 @@ \input texinfo @c -*-texinfo-*- @c %**start of header @setfilename gfortran.info -@set copyrights-gfortran 1999-2021 +@set copyrights-gfortran 1999-2022 @include gcc-common.texi @@ -180,7 +180,6 @@ Part I: Invoking GNU Fortran * Runtime:: Influencing runtime behavior with environment variables. Part II: Language Reference -* Fortran standards status:: Fortran 2003, 2008 and 2018 features supported by GNU Fortran. * Compiler Characteristics:: User-visible implementation details. * Extensions:: Language extensions implemented by GNU Fortran. * Mixed-Language Programming:: Interoperability with C @@ -220,17 +219,9 @@ compiler. @end ifset @end iftex -The GNU Fortran compiler front end was -designed initially as a free replacement for, -or alternative to, the Unix @command{f95} command; -@command{gfortran} is the command you will use to invoke the compiler. - @menu * About GNU Fortran:: What you should know about the GNU Fortran compiler. * GNU Fortran and GCC:: You can compile Fortran, C, or other programs. -* Preprocessing and conditional compilation:: The Fortran preprocessor -* GNU Fortran and G77:: Why we chose to start from scratch. -* Project Status:: Status of GNU Fortran, roadmap, proposed extensions. * Standards:: Standards supported by GNU Fortran. @end menu @@ -242,46 +233,67 @@ or alternative to, the Unix @command{f95} command; @node About GNU Fortran @section About GNU Fortran -The GNU Fortran compiler supports the Fortran 77, 90 and 95 standards -completely, parts of the Fortran 2003, 2008 and 2018 standards, and -several vendor extensions. The development goal is to provide the -following features: +The GNU Fortran compiler is the successor to @command{g77}, the +Fortran 77 front end included in GCC prior to version 4 (released in +2005). While it is backward-compatible with most @command{g77} +extensions and command-line options, @command{gfortran} is a completely new +implemention designed to support more modern dialects of Fortran. +GNU Fortran implements the Fortran 77, 90 and 95 standards +completely, most of the Fortran 2003 and 2008 standards, and some +features from the 2018 standard. It also implements several extensions +including OpenMP and OpenACC support for parallel programming. + +The GNU Fortran compiler passes the +@uref{http://www.fortran-2000.com/ArnaudRecipes/fcvs21_f95.html, +NIST Fortran 77 Test Suite}, and produces acceptable results on the +@uref{https://www.netlib.org/lapack/faq.html#1.21, LAPACK Test Suite}. +It also provides respectable performance on +the @uref{https://polyhedron.com/?page_id=175, +Polyhedron Fortran compiler benchmarks} and the +@uref{https://www.netlib.org/benchmark/livermore, +Livermore Fortran Kernels test}. It has been used to compile a number of +large real-world programs, including +@uref{http://hirlam.org/, the HARMONIE and HIRLAM weather forecasting code} and +@uref{https://github.com/dylan-jayatilaka/tonto, +the Tonto quantum chemistry package}; see +@url{https://gcc.gnu.org/@/wiki/@/GfortranApps} for an extended list. + +GNU Fortran provides the following functionality: @itemize @bullet @item -Read a user's program, stored in a file and containing instructions -written in Fortran 77, Fortran 90, Fortran 95, Fortran 2003, Fortran -2008 or Fortran 2018. This file contains @dfn{source code}. +Read a program, stored in a file and containing @dfn{source code} +instructions written in Fortran 77. @item -Translate the user's program into instructions a computer +Translate the program into instructions a computer can carry out more quickly than it takes to translate the -instructions in the first -place. The result after compilation of a program is +original Fortran instructions. +The result after compilation of a program is @dfn{machine code}, -code designed to be efficiently translated and processed +which is efficiently translated and processed by a machine such as your computer. Humans usually are not as good writing machine code as they are at writing Fortran (or C++, Ada, or Java), because it is easy to make tiny mistakes writing machine code. @item -Provide the user with information about the reasons why -the compiler is unable to create a binary from the source code. -Usually this will be the case if the source code is flawed. -The Fortran 90 standard requires that the compiler can point out -mistakes to the user. +Provide information about the reasons why +the compiler may be unable to create a binary from the source code, +for example if the source code is flawed. +The Fortran language standards require that the compiler can point out +mistakes in your code. An incorrect usage of the language causes an @dfn{error message}. -The compiler will also attempt to diagnose cases where the -user's program contains a correct usage of the language, +The compiler also attempts to diagnose cases where your +program contains a correct usage of the language, but instructs the computer to do something questionable. -This kind of diagnostics message is called a @dfn{warning message}. +This kind of diagnostic message is called a @dfn{warning message}. @item Provide optional information about the translation passes from the source code to machine code. -This can help a user of the compiler to find the cause of +This can help you to find the cause of certain bugs which may not be obvious in the source code, but may be more easily found at a lower level compiler output. It also helps developers to find bugs in the compiler itself. @@ -293,7 +305,7 @@ called a @dfn{debugger}, such as the GNU Debugger @command{gdb}). @item Locate and gather machine code already generated to -perform actions requested by statements in the user's program. +perform actions requested by statements in the program. This machine code is organized into @dfn{modules} and is located and @dfn{linked} to the user program. @end itemize @@ -317,8 +329,9 @@ which also might be installed as the system's @command{f95} command. @command{gfortran} is just another driver program, but specifically for the Fortran compiler only. -The difference with @command{gcc} is that @command{gfortran} -will automatically link the correct libraries to your program. +The primary difference between the @command{gcc} and @command{gfortran} +commands is that the latter automatically links the correct libraries +to your program. @item A collection of run-time libraries. @@ -339,7 +352,7 @@ linked to and interfaced with the GCC backend library. assembler code. You would typically not use this program directly; instead, the @command{gcc} or @command{gfortran} driver -programs will call it for you. +programs call it for you. @end itemize @@ -365,10 +378,10 @@ which provides the command-line interface for the compiler. It calls the relevant compiler front-end program (e.g., @command{f951} for Fortran) for each file in the source code, and then calls the assembler and linker as appropriate to produce the compiled output. In a copy of -GCC which has been compiled with Fortran language support enabled, -@command{gcc} will recognize files with @file{.f}, @file{.for}, @file{.ftn}, +GCC that has been compiled with Fortran language support enabled, +@command{gcc} recognizes files with @file{.f}, @file{.for}, @file{.ftn}, @file{.f90}, @file{.f95}, @file{.f03} and @file{.f08} extensions as -Fortran source code, and compile it accordingly. A @command{gfortran} +Fortran source code, and compiles it accordingly. A @command{gfortran} driver program is also provided, which is identical to @command{gcc} except that it automatically links the Fortran runtime libraries into the compiled program. @@ -383,138 +396,12 @@ extension are also run through preprocessing. This manual specifically documents the Fortran front end, which handles the programming language's syntax and semantics. The aspects of GCC -which relate to the optimization passes and the back-end code generation +that relate to the optimization passes and the back-end code generation are documented in the GCC manual; see @ref{Top,,Introduction,gcc,Using the GNU Compiler Collection (GCC)}. The two manuals together provide a complete reference for the GNU Fortran compiler. - -@c --------------------------------------------------------------------- -@c Preprocessing and conditional compilation -@c --------------------------------------------------------------------- - -@node Preprocessing and conditional compilation -@section Preprocessing and conditional compilation -@cindex CPP -@cindex FPP -@cindex Conditional compilation -@cindex Preprocessing -@cindex preprocessor, include file handling - -Many Fortran compilers including GNU Fortran allow passing the source code -through a C preprocessor (CPP; sometimes also called the Fortran preprocessor, -FPP) to allow for conditional compilation. In the case of GNU Fortran, -this is the GNU C Preprocessor in the traditional mode. On systems with -case-preserving file names, the preprocessor is automatically invoked if the -filename extension is @file{.F}, @file{.FOR}, @file{.FTN}, @file{.fpp}, -@file{.FPP}, @file{.F90}, @file{.F95}, @file{.F03} or @file{.F08}. To manually -invoke the preprocessor on any file, use @option{-cpp}, to disable -preprocessing on files where the preprocessor is run automatically, use -@option{-nocpp}. - -If a preprocessed file includes another file with the Fortran @code{INCLUDE} -statement, the included file is not preprocessed. To preprocess included -files, use the equivalent preprocessor statement @code{#include}. - -If GNU Fortran invokes the preprocessor, @code{__GFORTRAN__} -is defined. The macros @code{__GNUC__}, @code{__GNUC_MINOR__} and -@code{__GNUC_PATCHLEVEL__} can be used to determine the version of the -compiler. See @ref{Top,,Overview,cpp,The C Preprocessor} for details. - -GNU Fortran supports a number of @code{INTEGER} and @code{REAL} kind types -in additional to the kind types required by the Fortran standard. -The availability of any given kind type is architecture dependent. The -following pre-defined preprocessor macros can be used to conditionally -include code for these additional kind types: @code{__GFC_INT_1__}, -@code{__GFC_INT_2__}, @code{__GFC_INT_8__}, @code{__GFC_INT_16__}, -@code{__GFC_REAL_10__}, and @code{__GFC_REAL_16__}. - -While CPP is the de-facto standard for preprocessing Fortran code, -Part 3 of the Fortran 95 standard (ISO/IEC 1539-3:1998) defines -Conditional Compilation, which is not widely used and not directly -supported by the GNU Fortran compiler. You can use the program coco -to preprocess such files (@uref{http://www.daniellnagle.com/coco.html}). - - -@c --------------------------------------------------------------------- -@c GNU Fortran and G77 -@c --------------------------------------------------------------------- - -@node GNU Fortran and G77 -@section GNU Fortran and G77 -@cindex Fortran 77 -@cindex @command{g77} - -The GNU Fortran compiler is the successor to @command{g77}, the Fortran -77 front end included in GCC prior to version 4. It is an entirely new -program that has been designed to provide Fortran 95 support and -extensibility for future Fortran language standards, as well as providing -backwards compatibility for Fortran 77 and nearly all of the GNU language -extensions supported by @command{g77}. - - -@c --------------------------------------------------------------------- -@c Project Status -@c --------------------------------------------------------------------- - -@node Project Status -@section Project Status - -@quotation -As soon as @command{gfortran} can parse all of the statements correctly, -it will be in the ``larva'' state. -When we generate code, the ``puppa'' state. -When @command{gfortran} is done, -we'll see if it will be a beautiful butterfly, -or just a big bug.... - ---Andy Vaught, April 2000 -@end quotation - -The start of the GNU Fortran 95 project was announced on -the GCC homepage in March 18, 2000 -(even though Andy had already been working on it for a while, -of course). - -The GNU Fortran compiler is able to compile nearly all -standard-compliant Fortran 95, Fortran 90, and Fortran 77 programs, -including a number of standard and non-standard extensions, and can be -used on real-world programs. In particular, the supported extensions -include OpenMP, Cray-style pointers, some old vendor extensions, and several -Fortran 2003 and Fortran 2008 features, including TR 15581. However, it is -still under development and has a few remaining rough edges. -There also is initial support for OpenACC. - -At present, the GNU Fortran compiler passes the -@uref{http://www.fortran-2000.com/ArnaudRecipes/fcvs21_f95.html, -NIST Fortran 77 Test Suite}, and produces acceptable results on the -@uref{http://www.netlib.org/lapack/faq.html#1.21, LAPACK Test Suite}. -It also provides respectable performance on -the @uref{http://www.polyhedron.com/fortran-compiler-comparisons/polyhedron-benchmark-suite, -Polyhedron Fortran -compiler benchmarks} and the -@uref{http://www.netlib.org/benchmark/livermore, -Livermore Fortran Kernels test}. It has been used to compile a number of -large real-world programs, including -@uref{http://hirlam.org/, the HARMONIE and HIRLAM weather forecasting code} and -@uref{http://physical-chemistry.scb.uwa.edu.au/tonto/wiki/index.php/Main_Page, -the Tonto quantum chemistry package}; see -@url{https://gcc.gnu.org/@/wiki/@/GfortranApps} for an extended list. - -Among other things, the GNU Fortran compiler is intended as a replacement -for G77. At this point, nearly all programs that could be compiled with -G77 can be compiled with GNU Fortran, although there are a few minor known -regressions. - -The primary work remaining to be done on GNU Fortran falls into three -categories: bug fixing (primarily regarding the treatment of invalid -code and providing useful error messages), improving the compiler -optimizations and the performance of compiled code, and extending the -compiler to support future standards---in particular, Fortran 2003, -Fortran 2008 and Fortran 2018. - - @c --------------------------------------------------------------------- @c Standards @c --------------------------------------------------------------------- @@ -524,40 +411,52 @@ Fortran 2008 and Fortran 2018. @cindex Standards @menu -* Varying Length Character Strings:: +* Fortran 95 status:: +* Fortran 2003 status:: +* Fortran 2008 status:: +* Fortran 2018 status:: @end menu -The GNU Fortran compiler implements -ISO/IEC 1539:1997 (Fortran 95). As such, it can also compile essentially all -standard-compliant Fortran 90 and Fortran 77 programs. It also supports -the ISO/IEC TR-15581 enhancements to allocatable arrays. - -GNU Fortran also have a partial support for ISO/IEC 1539-1:2004 -(Fortran 2003), ISO/IEC 1539-1:2010 (Fortran 2008), the Technical -Specification @code{Further Interoperability of Fortran with C} -(ISO/IEC TS 29113:2012). Full support of those standards and future -Fortran standards is planned. The current status of the support is -can be found in the @ref{Fortran 2003 status}, @ref{Fortran 2008 -status} and @ref{Fortran 2018 status} sections of the documentation. +Fortran is developed by the Working Group 5 of Sub-Committee 22 of the +Joint Technical Committee 1 of the International Organization for +Standardization and the International Electrotechnical Commission (IEC). +This group is known as @uref{http://www.nag.co.uk/sc22wg5/, WG5}. +Official Fortran standard documents are available for purchase +from ISO; a collection of free documents (typically final drafts) are +also available on the @uref{https://gcc.gnu.org/wiki/GFortranStandards, wiki}. + +The GNU Fortran compiler implements ISO/IEC 1539:1997 (Fortran 95). +As such, it can also compile essentially all standard-compliant +Fortran 90 and Fortran 77 programs. It also supports the ISO/IEC +TR-15581 enhancements to allocatable arrays. + +GNU Fortran also supports almost all of ISO/IEC 1539-1:2004 +(Fortran 2003) and ISO/IEC 1539-1:2010 (Fortran 2008). +It has partial support for features introduced in ISO/IEC +1539:2018 (Fortran 2018), the most recent version of the Fortran +language standard, including full support for the Technical Specification +@code{Further Interoperability of Fortran with C} (ISO/IEC TS 29113:2012). +More details on support for these standards can be +found in the following sections of the documentation. Additionally, the GNU Fortran compilers supports the OpenMP specification (version 4.5 and partial support of the features of the 5.0 version, -@url{http://openmp.org/@/openmp-specifications/}). +@url{https://openmp.org/@/openmp-specifications/}). There also is support for the OpenACC specification (targeting -version 2.6, @uref{http://www.openacc.org/}). See +version 2.6, @uref{https://www.openacc.org/}). See @uref{https://gcc.gnu.org/wiki/OpenACC} for more information. -@node Varying Length Character Strings -@subsection Varying Length Character Strings -@cindex Varying length character strings +@node Fortran 95 status +@subsection Fortran 95 status @cindex Varying length strings @cindex strings, varying length +@cindex conditional compilation The Fortran 95 standard specifies in Part 2 (ISO/IEC 1539-2:2000) varying length character strings. While GNU Fortran currently does not support such strings directly, there exist two Fortran implementations for them, which work with GNU Fortran. They can be found at -@uref{http://www.fortran.com/@/iso_varying_string.f95} and at +@uref{https://www.fortran.com/@/iso_varying_string.f95} and at @uref{ftp://ftp.nag.co.uk/@/sc22wg5/@/ISO_VARYING_STRING/}. Deferred-length character strings of Fortran 2003 supports part of @@ -565,6 +464,92 @@ the features of @code{ISO_VARYING_STRING} and should be considered as replacement. (Namely, allocatable or pointers of the type @code{character(len=:)}.) +Part 3 of the Fortran 95 standard (ISO/IEC 1539-3:1998) defines +Conditional Compilation, which is not widely used and not directly +supported by the GNU Fortran compiler. You can use the program coco +to preprocess such files (@uref{http://www.daniellnagle.com/coco.html}). + +@node Fortran 2003 status +@subsection Fortran 2003 status + +GNU Fortran implements the Fortran 2003 (ISO/IEC 1539-1:2004) standard +except for finalization support, which is incomplete. +See the +@uref{https://gcc.gnu.org/wiki/Fortran2003, wiki page} for a full list +of new features introduced by Fortran 2003 and their implementation status. + +@node Fortran 2008 status +@subsection Fortran 2008 status + +The GNU Fortran compiler supports almost all features of Fortran 2008; +the @uref{https://gcc.gnu.org/wiki/Fortran2008Status, wiki} +has some information about the current implementation status. +In particular, the following are not yet supported: + +@itemize @bullet +@item +@code{DO CONCURRENT} and @code{FORALL} do not recognize a +type-spec in the loop header. + +@item +The change to permit any constant expression in subscripts and +nested implied-do limits in a @code{DATA} statement has not been implemented. +@end itemize + + +@node Fortran 2018 status +@subsection Fortran 2018 status + +Fortran 2018 (ISO/IEC 1539:2018) is the most recent version +of the Fortran language standard. GNU Fortran implements some of the +new features of this standard: + +@itemize @bullet +@item +All Fortran 2018 features derived from ISO/IEC TS 29113:2012, +``Further Interoperability of Fortran with C'', are supported by GNU Fortran. +This includes assumed-type and assumed-rank objects and +the @code{SELECT RANK} construct as well as the parts relating to +@code{BIND(C)} functions. +See also @ref{Further Interoperability of Fortran with C}. + +@item +GNU Fortran supports a subset of features derived from ISO/IEC TS 18508:2015, +``Additional Parallel Features in Fortran'': + +@itemize @bullet +@item +The new atomic ADD, CAS, FETCH and ADD/OR/XOR, OR and XOR intrinsics. + +@item +The @code{CO_MIN} and @code{CO_MAX} and @code{SUM} reduction intrinsics, +and the @code{CO_BROADCAST} and @code{CO_REDUCE} intrinsic, except that those +do not support polymorphic types or types with allocatable, pointer or +polymorphic components. + +@item +Events (@code{EVENT POST}, @code{EVENT WAIT}, @code{EVENT_QUERY}). + +@item +Failed images (@code{FAIL IMAGE}, @code{IMAGE_STATUS}, +@code{FAILED_IMAGES}, @code{STOPPED_IMAGES}). + +@end itemize + +@item +An @code{ERROR STOP} statement is permitted in a @code{PURE} +procedure. + +@item +GNU Fortran supports the @code{IMPLICIT NONE} statement with an +@code{implicit-none-spec-list}. + +@item +The behavior of the @code{INQUIRE} statement with the @code{RECL=} +specifier now conforms to Fortran 2018. + +@end itemize + @c ===================================================================== @c PART I: INVOCATION REFERENCE @@ -801,386 +786,6 @@ The default value is 131072. \part{II}{Language Reference} @end tex -@c --------------------------------------------------------------------- -@c Fortran standards status -@c --------------------------------------------------------------------- - -@node Fortran standards status -@chapter Fortran standards status - -@menu -* Fortran 2003 status:: -* Fortran 2008 status:: -* Fortran 2018 status:: -@end menu - -@node Fortran 2003 status -@section Fortran 2003 status - -GNU Fortran supports several Fortran 2003 features; an incomplete -list can be found below. See also the -@uref{https://gcc.gnu.org/wiki/Fortran2003, wiki page} about Fortran 2003. - -@itemize -@item Procedure pointers including procedure-pointer components with -@code{PASS} attribute. - -@item Procedures which are bound to a derived type (type-bound procedures) -including @code{PASS}, @code{PROCEDURE} and @code{GENERIC}, and -operators bound to a type. - -@item Abstract interfaces and type extension with the possibility to -override type-bound procedures or to have deferred binding. - -@item Polymorphic entities (``@code{CLASS}'') for derived types and unlimited -polymorphism (``@code{CLASS(*)}'') -- including @code{SAME_TYPE_AS}, -@code{EXTENDS_TYPE_OF} and @code{SELECT TYPE} for scalars and arrays and -finalization. - -@item Generic interface names, which have the same name as derived types, -are now supported. This allows one to write constructor functions. Note -that Fortran does not support static constructor functions. For static -variables, only default initialization or structure-constructor -initialization are available. - -@item The @code{ASSOCIATE} construct. - -@item Interoperability with C including enumerations, - -@item In structure constructors the components with default values may be -omitted. - -@item Extensions to the @code{ALLOCATE} statement, allowing for a -type-specification with type parameter and for allocation and initialization -from a @code{SOURCE=} expression; @code{ALLOCATE} and @code{DEALLOCATE} -optionally return an error message string via @code{ERRMSG=}. - -@item Reallocation on assignment: If an intrinsic assignment is -used, an allocatable variable on the left-hand side is automatically allocated -(if unallocated) or reallocated (if the shape is different). Currently, scalar -deferred character length left-hand sides are correctly handled but arrays -are not yet fully implemented. - -@item Deferred-length character variables and scalar deferred-length character -components of derived types are supported. (Note that array-valued components -are not yet implemented.) - -@item Transferring of allocations via @code{MOVE_ALLOC}. - -@item The @code{PRIVATE} and @code{PUBLIC} attributes may be given individually -to derived-type components. - -@item In pointer assignments, the lower bound may be specified and -the remapping of elements is supported. - -@item For pointers an @code{INTENT} may be specified which affect the -association status not the value of the pointer target. - -@item Intrinsics @code{command_argument_count}, @code{get_command}, -@code{get_command_argument}, and @code{get_environment_variable}. - -@item Support for Unicode characters (ISO 10646) and UTF-8, including -the @code{SELECTED_CHAR_KIND} and @code{NEW_LINE} intrinsic functions. - -@item Support for binary, octal and hexadecimal (BOZ) constants in the -intrinsic functions @code{INT}, @code{REAL}, @code{CMPLX} and @code{DBLE}. - -@item Support for namelist variables with allocatable and pointer -attribute and nonconstant length type parameter. - -@item -@cindex array, constructors -@cindex @code{[...]} -Array constructors using square brackets. That is, @code{[...]} rather -than @code{(/.../)}. Type-specification for array constructors like -@code{(/ some-type :: ... /)}. - -@item Extensions to the specification and initialization expressions, -including the support for intrinsics with real and complex arguments. - -@item Support for the asynchronous input/output. - -@item -@cindex @code{FLUSH} statement -@cindex statement, @code{FLUSH} -@code{FLUSH} statement. - -@item -@cindex @code{IOMSG=} specifier -@code{IOMSG=} specifier for I/O statements. - -@item -@cindex @code{ENUM} statement -@cindex @code{ENUMERATOR} statement -@cindex statement, @code{ENUM} -@cindex statement, @code{ENUMERATOR} -@opindex @code{fshort-enums} -Support for the declaration of enumeration constants via the -@code{ENUM} and @code{ENUMERATOR} statements. Interoperability with -@command{gcc} is guaranteed also for the case where the -@command{-fshort-enums} command line option is given. - -@item -@cindex TR 15581 -TR 15581: -@itemize -@item -@cindex @code{ALLOCATABLE} dummy arguments -@code{ALLOCATABLE} dummy arguments. -@item -@cindex @code{ALLOCATABLE} function results -@code{ALLOCATABLE} function results -@item -@cindex @code{ALLOCATABLE} components of derived types -@code{ALLOCATABLE} components of derived types -@end itemize - -@item -@cindex @code{STREAM} I/O -@cindex @code{ACCESS='STREAM'} I/O -The @code{OPEN} statement supports the @code{ACCESS='STREAM'} specifier, -allowing I/O without any record structure. - -@item -Namelist input/output for internal files. - -@item Minor I/O features: Rounding during formatted output, using of -a decimal comma instead of a decimal point, setting whether a plus sign -should appear for positive numbers. On systems where @code{strtod} honours -the rounding mode, the rounding mode is also supported for input. - -@item -@cindex @code{PROTECTED} statement -@cindex statement, @code{PROTECTED} -The @code{PROTECTED} statement and attribute. - -@item -@cindex @code{VALUE} statement -@cindex statement, @code{VALUE} -The @code{VALUE} statement and attribute. - -@item -@cindex @code{VOLATILE} statement -@cindex statement, @code{VOLATILE} -The @code{VOLATILE} statement and attribute. - -@item -@cindex @code{IMPORT} statement -@cindex statement, @code{IMPORT} -The @code{IMPORT} statement, allowing to import -host-associated derived types. - -@item The intrinsic modules @code{ISO_FORTRAN_ENVIRONMENT} is supported, -which contains parameters of the I/O units, storage sizes. Additionally, -procedures for C interoperability are available in the @code{ISO_C_BINDING} -module. - -@item -@cindex @code{USE, INTRINSIC} statement -@cindex statement, @code{USE, INTRINSIC} -@cindex @code{ISO_FORTRAN_ENV} statement -@cindex statement, @code{ISO_FORTRAN_ENV} -@code{USE} statement with @code{INTRINSIC} and @code{NON_INTRINSIC} -attribute; supported intrinsic modules: @code{ISO_FORTRAN_ENV}, -@code{ISO_C_BINDING}, @code{OMP_LIB} and @code{OMP_LIB_KINDS}, -and @code{OPENACC}. - -@item -Renaming of operators in the @code{USE} statement. - -@end itemize - - -@node Fortran 2008 status -@section Fortran 2008 status - -The latest version of the Fortran standard is ISO/IEC 1539-1:2010, informally -known as Fortran 2008. The official version is available from International -Organization for Standardization (ISO) or its national member organizations. -The the final draft (FDIS) can be downloaded free of charge from -@url{http://www.nag.co.uk/@/sc22wg5/@/links.html}. Fortran is developed by the -Working Group 5 of Sub-Committee 22 of the Joint Technical Committee 1 of the -International Organization for Standardization and the International -Electrotechnical Commission (IEC). This group is known as -@uref{http://www.nag.co.uk/sc22wg5/, WG5}. - -The GNU Fortran compiler supports several of the new features of Fortran 2008; -the @uref{https://gcc.gnu.org/wiki/Fortran2008Status, wiki} has some information -about the current Fortran 2008 implementation status. In particular, the -following is implemented. - -@itemize -@item The @option{-std=f2008} option and support for the file extensions -@file{.f08} and @file{.F08}. - -@item The @code{OPEN} statement now supports the @code{NEWUNIT=} option, -which returns a unique file unit, thus preventing inadvertent use of the -same unit in different parts of the program. - -@item The @code{g0} format descriptor and unlimited format items. - -@item The mathematical intrinsics @code{ASINH}, @code{ACOSH}, @code{ATANH}, -@code{ERF}, @code{ERFC}, @code{GAMMA}, @code{LOG_GAMMA}, @code{BESSEL_J0}, -@code{BESSEL_J1}, @code{BESSEL_JN}, @code{BESSEL_Y0}, @code{BESSEL_Y1}, -@code{BESSEL_YN}, @code{HYPOT}, @code{NORM2}, and @code{ERFC_SCALED}. - -@item Using complex arguments with @code{TAN}, @code{SINH}, @code{COSH}, -@code{TANH}, @code{ASIN}, @code{ACOS}, and @code{ATAN} is now possible; -@code{ATAN}(@var{Y},@var{X}) is now an alias for @code{ATAN2}(@var{Y},@var{X}). - -@item Support of the @code{PARITY} intrinsic functions. - -@item The following bit intrinsics: @code{LEADZ} and @code{TRAILZ} for -counting the number of leading and trailing zero bits, @code{POPCNT} and -@code{POPPAR} for counting the number of one bits and returning the parity; -@code{BGE}, @code{BGT}, @code{BLE}, and @code{BLT} for bitwise comparisons; -@code{DSHIFTL} and @code{DSHIFTR} for combined left and right shifts, -@code{MASKL} and @code{MASKR} for simple left and right justified masks, -@code{MERGE_BITS} for a bitwise merge using a mask, @code{SHIFTA}, -@code{SHIFTL} and @code{SHIFTR} for shift operations, and the -transformational bit intrinsics @code{IALL}, @code{IANY} and @code{IPARITY}. - -@item Support of the @code{EXECUTE_COMMAND_LINE} intrinsic subroutine. - -@item Support for the @code{STORAGE_SIZE} intrinsic inquiry function. - -@item The @code{INT@{8,16,32@}} and @code{REAL@{32,64,128@}} kind type -parameters and the array-valued named constants @code{INTEGER_KINDS}, -@code{LOGICAL_KINDS}, @code{REAL_KINDS} and @code{CHARACTER_KINDS} of -the intrinsic module @code{ISO_FORTRAN_ENV}. - -@item The module procedures @code{C_SIZEOF} of the intrinsic module -@code{ISO_C_BINDINGS} and @code{COMPILER_VERSION} and @code{COMPILER_OPTIONS} -of @code{ISO_FORTRAN_ENV}. - -@item Coarray support for serial programs with @option{-fcoarray=single} flag -and experimental support for multiple images with the @option{-fcoarray=lib} -flag. - -@item Submodules are supported. It should noted that @code{MODULEs} do not -produce the smod file needed by the descendent @code{SUBMODULEs} unless they -contain at least one @code{MODULE PROCEDURE} interface. The reason for this is -that @code{SUBMODULEs} are useless without @code{MODULE PROCEDUREs}. See -http://j3-fortran.org/doc/meeting/207/15-209.txt for a discussion and a draft -interpretation. Adopting this interpretation has the advantage that code that -does not use submodules does not generate smod files. - -@item The @code{DO CONCURRENT} construct is supported. - -@item The @code{BLOCK} construct is supported. - -@item The @code{STOP} and the new @code{ERROR STOP} statements now -support all constant expressions. Both show the signals which were signaling -at termination. - -@item Support for the @code{CONTIGUOUS} attribute. - -@item Support for @code{ALLOCATE} with @code{MOLD}. - -@item Support for the @code{IMPURE} attribute for procedures, which -allows for @code{ELEMENTAL} procedures without the restrictions of -@code{PURE}. - -@item Null pointers (including @code{NULL()}) and not-allocated variables -can be used as actual argument to optional non-pointer, non-allocatable -dummy arguments, denoting an absent argument. - -@item Non-pointer variables with @code{TARGET} attribute can be used as -actual argument to @code{POINTER} dummies with @code{INTENT(IN)}. - -@item Pointers including procedure pointers and those in a derived -type (pointer components) can now be initialized by a target instead -of only by @code{NULL}. - -@item The @code{EXIT} statement (with construct-name) can be now be -used to leave not only the @code{DO} but also the @code{ASSOCIATE}, -@code{BLOCK}, @code{IF}, @code{SELECT CASE} and @code{SELECT TYPE} -constructs. - -@item Internal procedures can now be used as actual argument. - -@item Minor features: obsolesce diagnostics for @code{ENTRY} with -@option{-std=f2008}; a line may start with a semicolon; for internal -and module procedures @code{END} can be used instead of -@code{END SUBROUTINE} and @code{END FUNCTION}; @code{SELECTED_REAL_KIND} -now also takes a @code{RADIX} argument; intrinsic types are supported -for @code{TYPE}(@var{intrinsic-type-spec}); multiple type-bound procedures -can be declared in a single @code{PROCEDURE} statement; implied-shape -arrays are supported for named constants (@code{PARAMETER}). -@end itemize - - - -@node Fortran 2018 status -@section Status of Fortran 2018 support - -@itemize -@item ERROR STOP in a PURE procedure -An @code{ERROR STOP} statement is permitted in a @code{PURE} -procedure. - -@item IMPLICIT NONE with a spec-list -Support the @code{IMPLICIT NONE} statement with an -@code{implicit-none-spec-list}. - -@item Behavior of INQUIRE with the RECL= specifier - -The behavior of the @code{INQUIRE} statement with the @code{RECL=} -specifier now conforms to Fortran 2018. - -@end itemize - - -@subsection TS 29113 Status (Further Interoperability with C) - -GNU Fortran supports some of the new features of the Technical -Specification (TS) 29113 on Further Interoperability of Fortran with C. -The @uref{https://gcc.gnu.org/wiki/TS29113Status, wiki} has some information -about the current TS 29113 implementation status. In particular, the -following is implemented. - -See also @ref{Further Interoperability of Fortran with C}. - -@itemize -@item The @code{OPTIONAL} attribute is allowed for dummy arguments -of @code{BIND(C) procedures.} - -@item The @code{RANK} intrinsic is supported. - -@item GNU Fortran's implementation for variables with @code{ASYNCHRONOUS} -attribute is compatible with TS 29113. - -@item Assumed types (@code{TYPE(*)}). - -@item Assumed-rank (@code{DIMENSION(..)}). - -@item ISO_Fortran_binding (now in Fortran 2018 18.4) is implemented such that -conversion of the array descriptor for assumed type or assumed rank arrays is -done in the library. The include file ISO_Fortran_binding.h is can be found in -@code{~prefix/lib/gcc/$target/$version}. -@end itemize - - - -@subsection TS 18508 Status (Additional Parallel Features) - -GNU Fortran supports the following new features of the Technical -Specification 18508 on Additional Parallel Features in Fortran: - -@itemize -@item The new atomic ADD, CAS, FETCH and ADD/OR/XOR, OR and XOR intrinsics. - -@item The @code{CO_MIN} and @code{CO_MAX} and @code{SUM} reduction intrinsics. -And the @code{CO_BROADCAST} and @code{CO_REDUCE} intrinsic, except that those -do not support polymorphic types or types with allocatable, pointer or -polymorphic components. - -@item Events (@code{EVENT POST}, @code{EVENT WAIT}, @code{EVENT_QUERY}) - -@item Failed images (@code{FAIL IMAGE}, @code{IMAGE_STATUS}, -@code{FAILED_IMAGES}, @code{STOPPED_IMAGES}) - -@end itemize @c --------------------------------------------------------------------- @@ -2181,7 +1786,7 @@ It consists of a set of compiler directives, library routines, and environment variables that influence run-time behavior. GNU Fortran strives to be compatible to the -@uref{http://openmp.org/wp/openmp-specifications/, +@uref{https://openmp.org/wp/openmp-specifications/, OpenMP Application Program Interface v4.5}. To enable the processing of the OpenMP directive @code{!$omp} in @@ -2239,7 +1844,7 @@ compiler directives, library routines, and environment variables that influence run-time behavior. GNU Fortran strives to be compatible to the -@uref{http://www.openacc.org/, OpenACC Application Programming +@uref{https://www.openacc.org/, OpenACC Application Programming Interface v2.6}. To enable the processing of the OpenACC directive @code{!$acc} in @@ -3113,28 +2718,42 @@ reading from the position marked previously. * Naming and argument-passing conventions:: @end menu -This chapter is about mixed-language interoperability, but also applies -if one links Fortran code compiled by different compilers. In most cases, -use of the C Binding features of the Fortran 2003 standard is sufficient, -and their use is highly recommended. +This chapter is about mixed-language interoperability, but also +applies if you link Fortran code compiled by different compilers. In +most cases, use of the C Binding features of the Fortran 2003 and +later standards is sufficient. +For example, it is possible to mix Fortran code with C++ code as well +as C, if you declare the interface functions as @code{extern "C"} on +the C++ side and @code{BIND(C)} on the Fortran side, and follow the +rules for interoperability with C. Note that you cannot manipulate +C++ class objects in Fortran or vice versa except as opaque pointers. + +You can use the @command{gfortran} command to link both Fortran and +non-Fortran code into the same program, or you can use @command{gcc} +or @command{g++} if you also add an explicit @option{-lgfortran} option +to link with the Fortran library. If your main program is written in +C or some other language instead of Fortran, see +@ref{Non-Fortran Main Program}, below. @node Interoperability with C @section Interoperability with C +@cindex interoperability with C +@cindex C interoperability @menu * Intrinsic Types:: * Derived Types and struct:: * Interoperable Global Variables:: * Interoperable Subroutines and Functions:: -* Working with Pointers:: +* Working with C Pointers:: * Further Interoperability of Fortran with C:: @end menu Since Fortran 2003 (ISO/IEC 1539-1:2004(E)) there is a standardized way to generate procedure and derived-type -declarations and global variables which are interoperable with C -(ISO/IEC 9899:1999). The @code{bind(C)} attribute has been added +declarations and global variables that are interoperable with C +(ISO/IEC 9899:1999). The @code{BIND(C)} attribute has been added to inform the compiler that a symbol shall be interoperable with C; also, some constraints are added. Note, however, that not all C features have a Fortran equivalent or vice versa. For instance, @@ -3150,12 +2769,16 @@ assuming @math{i < n}) in memory is @code{A(i+1,j)} (C: @code{A[j-1][i]}). @node Intrinsic Types @subsection Intrinsic Types +@cindex C intrinsic type interoperability +@cindex intrinsic type interoperability with C +@cindex interoperability, intrinsic type In order to ensure that exactly the same variable type and kind is used -in C and Fortran, the named constants shall be used which are defined in the -@code{ISO_C_BINDING} intrinsic module. That module contains named constants -for kind parameters and character named constants for the escape sequences -in C. For a list of the constants, see @ref{ISO_C_BINDING}. +in C and Fortran, you should use the named constants for kind parameters +that are defined in the @code{ISO_C_BINDING} intrinsic module. +That module contains named constants of character type representing +the escaped special characters in C, such as newline. +For a list of the constants, see @ref{ISO_C_BINDING}. For logical types, please note that the Fortran standard only guarantees interoperability between C99's @code{_Bool} and Fortran's @code{C_Bool}-kind @@ -3165,12 +2788,13 @@ the value 0. Using any other integer value with GNU Fortran's @code{LOGICAL} values than 0 and 1 to GCC's @code{_Bool} is also undefined, unless the integer is explicitly or implicitly casted to @code{_Bool}.) - - @node Derived Types and struct @subsection Derived Types and struct +@cindex C derived type and struct interoperability +@cindex derived type interoperability with C +@cindex interoperability, derived type and struct -For compatibility of derived types with @code{struct}, one needs to use +For compatibility of derived types with @code{struct}, use the @code{BIND(C)} attribute in the type declaration. For instance, the following type declaration @@ -3185,6 +2809,7 @@ following type declaration END TYPE @end smallexample +@noindent matches the following @code{struct} declaration in C @smallexample @@ -3209,6 +2834,9 @@ with bit field or variable-length array members are interoperable. @node Interoperable Global Variables @subsection Interoperable Global Variables +@cindex C variable interoperability +@cindex variable interoperability with C +@cindex interoperability, variable Variables can be made accessible from C using the C binding attribute, optionally together with specifying a binding name. Those variables @@ -3236,17 +2864,18 @@ a macro. Use the @code{IERRNO} intrinsic (GNU extension) instead. @node Interoperable Subroutines and Functions @subsection Interoperable Subroutines and Functions +@cindex C procedure interoperability +@cindex procedure interoperability with C +@cindex function interoperability with C +@cindex subroutine interoperability with C +@cindex interoperability, subroutine and function Subroutines and functions have to have the @code{BIND(C)} attribute to be compatible with C. The dummy argument declaration is relatively straightforward. However, one needs to be careful because C uses call-by-value by default while Fortran behaves usually similar to call-by-reference. Furthermore, strings and pointers are handled -differently. Note that in Fortran 2003 and 2008 only explicit size -and assumed-size arrays are supported but not assumed-shape or -deferred-shape (i.e. allocatable or pointer) arrays. However, those -are allowed since the Technical Specification 29113, see -@ref{Further Interoperability of Fortran with C} +differently. To pass a variable by value, use the @code{VALUE} attribute. Thus, the following C prototype @@ -3255,6 +2884,7 @@ Thus, the following C prototype @code{int func(int i, int *j)} @end smallexample +@noindent matches the Fortran declaration @smallexample @@ -3265,12 +2895,12 @@ matches the Fortran declaration @end smallexample Note that pointer arguments also frequently need the @code{VALUE} attribute, -see @ref{Working with Pointers}. +see @ref{Working with C Pointers}. Strings are handled quite differently in C and Fortran. In C a string is a @code{NUL}-terminated array of characters while in Fortran each string has a length associated with it and is thus not terminated (by e.g. -@code{NUL}). For example, if one wants to use the following C function, +@code{NUL}). For example, if you want to use the following C function, @smallexample #include <stdio.h> @@ -3280,7 +2910,8 @@ has a length associated with it and is thus not terminated (by e.g. @} @end smallexample -to print ``Hello World'' from Fortran, one can call it using +@noindent +to print ``Hello World'' from Fortran, you can call it using @smallexample use iso_c_binding, only: C_CHAR, C_NULL_CHAR @@ -3293,7 +2924,7 @@ to print ``Hello World'' from Fortran, one can call it using call print_c(C_CHAR_"Hello World"//C_NULL_CHAR) @end smallexample -As the example shows, one needs to ensure that the +As the example shows, you need to ensure that the string is @code{NUL} terminated. Additionally, the dummy argument @var{string} of @code{print_C} is a length-one assumed-size array; using @code{character(len=*)} is not allowed. The example @@ -3309,6 +2940,7 @@ function @code{strncpy}, whose prototype is char *strncpy(char *restrict s1, const char *restrict s2, size_t n); @end smallexample +@noindent The function @code{strncpy} copies at most @var{n} characters from string @var{s2} to @var{s1} and returns @var{s1}. In the following example, we ignore the return value: @@ -3336,18 +2968,21 @@ example, we ignore the return value: The intrinsic procedures are described in @ref{Intrinsic Procedures}. -@node Working with Pointers -@subsection Working with Pointers +@node Working with C Pointers +@subsection Working with C Pointers +@cindex C pointers +@cindex pointers, C -C pointers are represented in Fortran via the special opaque derived type -@code{type(c_ptr)} (with private components). Thus one needs to +C pointers are represented in Fortran via the special opaque derived +type @code{type(c_ptr)} (with private components). C pointers are distinct +from Fortran objects with the @code{POINTER} attribute. Thus one needs to use intrinsic conversion procedures to convert from or to C pointers. +For some applications, using an assumed type (@code{TYPE(*)}) can be +an alternative to a C pointer, and you can also use library routines +to access Fortran pointers from C. See @ref{Further Interoperability +of Fortran with C}. -For some applications, using an assumed type (@code{TYPE(*)}) can be an -alternative to a C pointer; see -@ref{Further Interoperability of Fortran with C}. - -For example, +Here is an example of using C pointers in Fortran: @smallexample use iso_c_binding @@ -3365,7 +3000,7 @@ For example, When converting C to Fortran arrays, the one-dimensional @code{SHAPE} argument has to be passed. -If a pointer is a dummy-argument of an interoperable procedure, it usually +If a pointer is a dummy argument of an interoperable procedure, it usually has to be declared using the @code{VALUE} attribute. @code{void*} matches @code{TYPE(C_PTR), VALUE}, while @code{TYPE(C_PTR)} alone matches @code{void**}. @@ -3491,81 +3126,31 @@ END MODULE m @node Further Interoperability of Fortran with C @subsection Further Interoperability of Fortran with C - -The Technical Specification ISO/IEC TS 29113:2012 on further -interoperability of Fortran with C extends the interoperability support -of Fortran 2003 and Fortran 2008. Besides removing some restrictions -and constraints, it adds assumed-type (@code{TYPE(*)}) and assumed-rank -(@code{dimension}) variables and allows for interoperability of -assumed-shape, assumed-rank and deferred-shape arrays, including -allocatables and pointers. +@cindex Further Interoperability of Fortran with C +@cindex TS 29113 +@cindex array descriptor +@cindex dope vector +@cindex assumed-type +@cindex assumed-rank + +GNU Fortran implements the Technical Specification ISO/IEC TS +29113:2012, which extends the interoperability support of Fortran 2003 +and Fortran 2008 and is now part of the 2018 Fortran standard. +Besides removing some restrictions and constraints, the Technical +Specification adds assumed-type (@code{TYPE(*)}) and assumed-rank +(@code{DIMENSION(..)}) variables and allows for interoperability of +assumed-shape, assumed-rank, and deferred-shape arrays, as well as +allocatables and pointers. Objects of these types are passed to +@code{BIND(C)} functions as descriptors with a standard interface, +declared in the header file @code{<ISO_Fortran_binding.h>}. Note: Currently, GNU Fortran does not use internally the array descriptor (dope vector) as specified in the Technical Specification, but uses -an array descriptor with different fields. Assumed type and assumed rank -formal arguments are converted in the library to the specified form. The -ISO_Fortran_binding API functions (also Fortran 2018 18.4) are implemented -in libgfortran. Alternatively, the Chasm Language Interoperability Tools, -@url{http://chasm-interop.sourceforge.net/}, provide an interface to GNU -Fortran's array descriptor. - -The Technical Specification adds the following new features, which -are supported by GNU Fortran: - -@itemize @bullet - -@item The @code{ASYNCHRONOUS} attribute has been clarified and -extended to allow its use with asynchronous communication in -user-provided libraries such as in implementations of the -Message Passing Interface specification. - -@item Many constraints have been relaxed, in particular for -the @code{C_LOC} and @code{C_F_POINTER} intrinsics. - -@item The @code{OPTIONAL} attribute is now allowed for dummy -arguments; an absent argument matches a @code{NULL} pointer. - -@item Assumed types (@code{TYPE(*)}) have been added, which may -only be used for dummy arguments. They are unlimited polymorphic -but contrary to @code{CLASS(*)} they do not contain any type -information, similar to C's @code{void *} pointers. Expressions -of any type and kind can be passed; thus, it can be used as -replacement for @code{TYPE(C_PTR)}, avoiding the use of -@code{C_LOC} in the caller. - -Note, however, that @code{TYPE(*)} only accepts scalar arguments, -unless the @code{DIMENSION} is explicitly specified. As -@code{DIMENSION(*)} only supports array (including array elements) but -no scalars, it is not a full replacement for @code{C_LOC}. On the -other hand, assumed-type assumed-rank dummy arguments -(@code{TYPE(*), DIMENSION(..)}) allow for both scalars and arrays, but -require special code on the callee side to handle the array descriptor. - -@item Assumed-rank arrays (@code{DIMENSION(..)}) as dummy argument -allow that scalars and arrays of any rank can be passed as actual -argument. As the Technical Specification does not provide for direct -means to operate with them, they have to be used either from the C side -or be converted using @code{C_LOC} and @code{C_F_POINTER} to scalars -or arrays of a specific rank. The rank can be determined using the -@code{RANK} intrinisic. -@end itemize - - -Currently unimplemented: - -@itemize @bullet - -@item GNU Fortran always uses an array descriptor, which does not -match the one of the Technical Specification. The -@code{ISO_Fortran_binding.h} header file and the C functions it -specifies are not available. - -@item Using assumed-shape, assumed-rank and deferred-shape arrays in -@code{BIND(C)} procedures is not fully supported. In particular, -C interoperable strings of other length than one are not supported -as this requires the new array descriptor. -@end itemize - +an array descriptor with different fields in functions without the +@code{BIND(C)} attribute. Arguments to functions marked @code{BIND(C)} +are converted to the specified form. If you need to access GNU Fortran's +internal array descriptor, you can use the Chasm Language Interoperability +Tools, @url{http://chasm-interop.sourceforge.net/}. @node GNU Fortran Compiler Directives @section GNU Fortran Compiler Directives @@ -5824,7 +5409,6 @@ but they are also things doable by someone who is willing and able. @menu * Contributors:: * Projects:: -* Proposed Extensions:: @end menu @@ -5888,6 +5472,7 @@ GNU Fortran project: @item Dominique d'Humi@`eres @item Kate Hedstrom @item Erik Schnetter +@item Gerhard Steinmetz @item Joost VandeVondele @end itemize @@ -5917,91 +5502,14 @@ isolating them. Going through the bugzilla database at add more information (for example, for which version does the testcase work, for which versions does it fail?) is also very helpful. -@end table - - -@node Proposed Extensions -@section Proposed Extensions - -Here's a list of proposed extensions for the GNU Fortran compiler, in no particular -order. Most of these are necessary to be fully compatible with -existing Fortran compilers, but they are not part of the official -J3 Fortran 95 standard. - -@subsection Compiler extensions: -@itemize @bullet -@item -User-specified alignment rules for structures. - -@item -Automatically extend single precision constants to double. - -@item -Compile code that conserves memory by dynamically allocating common and -module storage either on stack or heap. - -@item -Compile flag to generate code for array conformance checking (suggest -CC). - -@item -User control of symbol names (underscores, etc). - -@item -Compile setting for maximum size of stack frame size before spilling -parts to static or heap. - -@item -Flag to force local variables into static space. - -@item -Flag to force local variables onto stack. -@end itemize - - -@subsection Environment Options -@itemize @bullet -@item -Pluggable library modules for random numbers, linear algebra. -LA should use BLAS calling conventions. - -@item -Environment variables controlling actions on arithmetic exceptions like -overflow, underflow, precision loss---Generate NaN, abort, default. -action. - -@item -Set precision for fp units that support it (i387). - -@item -Variable for setting fp rounding mode. +@item Missing features +For a larger project, consider working on the missing features required for +Fortran language standards compliance (@pxref{Standards}), or contributing +to the implementation of extensions such as OpenMP (@pxref{OpenMP}) or +OpenACC (@pxref{OpenACC}) that are under active development. Again, +contributing test cases for these features is useful too! -@item -Variable to fill uninitialized variables with a user-defined bit -pattern. - -@item -Environment variable controlling filename that is opened for that unit -number. - -@item -Environment variable to clear/trash memory being freed. - -@item -Environment variable to control tracing of allocations and frees. - -@item -Environment variable to display allocated memory at normal program end. - -@item -Environment variable for filename for * IO-unit. - -@item -Environment variable for temporary file directory. - -@item -Environment variable forcing standard output to be line buffered (Unix). - -@end itemize +@end table @c --------------------------------------------------------------------- diff --git a/gcc/fortran/gfortranspec.c b/gcc/fortran/gfortranspec.cc index 97db139..cf76bdc 100644 --- a/gcc/fortran/gfortranspec.c +++ b/gcc/fortran/gfortranspec.cc @@ -1,5 +1,5 @@ /* Specific flags and argument handling of the Fortran front-end. - Copyright (C) 1997-2021 Free Software Foundation, Inc. + Copyright (C) 1997-2022 Free Software Foundation, Inc. This file is part of GCC. @@ -37,7 +37,7 @@ along with GCC; see the file COPYING3. If not see the linking phase is present, or if `-xfoo' is in effect. Note that a lack of source files or -l options disables linking. - This program was originally made out of gcc/cp/g++spec.c, but the + This program was originally made out of gcc/cp/g++spec.cc, but the way it builds the new argument list was rewritten so it is much easier to maintain, improve the way it decides to add or not add extra arguments, etc. And several improvements were made in the @@ -278,7 +278,7 @@ lang_specific_driver (struct cl_decoded_option **in_decoded_options, case OPT__version: printf ("GNU Fortran %s%s\n", pkgversion_string, version_string); - printf ("Copyright %s 2021 Free Software Foundation, Inc.\n", + printf ("Copyright %s 2022 Free Software Foundation, Inc.\n", _("(C)")); fputs (_("This is free software; see the source for copying conditions. There is NO\n\ warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n\n"), @@ -287,7 +287,7 @@ warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n\n" break; case OPT__help: - /* Let gcc.c handle this, as it has a really + /* Let gcc.cc handle this, as it has a really cool facility for handling --help and --verbose --help. */ return; diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.cc index 24698be..000a530 100644 --- a/gcc/fortran/interface.c +++ b/gcc/fortran/interface.cc @@ -1,5 +1,5 @@ /* Deal with interfaces. - Copyright (C) 2000-2021 Free Software Foundation, Inc. + Copyright (C) 2000-2022 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. @@ -2237,7 +2237,11 @@ argument_rank_mismatch (const char *name, locus *where, } else { - gcc_assert (rank2 != -1); + if (rank2 == -1) + /* This is an assumed rank-actual passed to a function without + an explicit interface, which is already diagnosed in + gfc_procedure_use. */ + return; if (rank1 == 0) gfc_error_opt (0, "Rank mismatch between actual argument at %L " "and actual argument at %L (scalar and rank-%d)", @@ -3043,6 +3047,18 @@ lookup_arg_fuzzy (const char *arg, gfc_formal_arglist *arguments) } +static gfc_dummy_arg * +get_nonintrinsic_dummy_arg (gfc_formal_arglist *formal) +{ + gfc_dummy_arg * const dummy_arg = gfc_get_dummy_arg (); + + dummy_arg->intrinsicness = GFC_NON_INTRINSIC_DUMMY_ARG; + dummy_arg->u.non_intrinsic = formal; + + return dummy_arg; +} + + /* Given formal and actual argument lists, see if they are compatible. If they are compatible, the actual argument list is sorted to correspond with the formal list, and elements for missing optional @@ -3064,6 +3080,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, gfc_array_spec *fas, *aas; bool pointer_dummy, pointer_arg, allocatable_arg; + bool ok = true; + actual = *ap; if (actual == NULL && formal == NULL) @@ -3134,7 +3152,6 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, if (where) gfc_error ("More actual than formal arguments in procedure " "call at %L", where); - return false; } @@ -3150,6 +3167,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, "call at %L", where); return false; } + else + a->associated_dummy = get_nonintrinsic_dummy_arg (f); if (a->expr == NULL) { @@ -3192,13 +3211,16 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, else if (where) gfc_error ("Fortran 2008: Null pointer at %L to non-pointer " "dummy %qs", where, f->sym->name); - - return false; + ok = false; + goto match; } if (!compare_parameter (f->sym, a->expr, ranks_must_agree, is_elemental, where)) - return false; + { + ok = false; + goto match; + } /* TS 29113, 6.3p2; F2018 15.5.2.4. */ if (f->sym->ts.type == BT_ASSUMED @@ -3217,7 +3239,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, "has type parameters or is of " "derived type with type-bound or FINAL procedures", &a->expr->where); - return false; + ok = false; + goto match; } } @@ -3249,7 +3272,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, mpz_get_si (a->expr->ts.u.cl->length->value.integer), mpz_get_si (f->sym->ts.u.cl->length->value.integer), f->sym->name, &a->expr->where); - return false; + ok = false; + goto match; } if ((f->sym->attr.pointer || f->sym->attr.allocatable) @@ -3261,7 +3285,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, "pointer dummy argument %qs must have a deferred " "length type parameter if and only if the dummy has one", &a->expr->where, f->sym->name); - return false; + ok = false; + goto match; } if (f->sym->ts.type == BT_CLASS) @@ -3295,7 +3320,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, "at %L", f->sym->name, actual_size, formal_size, &a->expr->where); } - return false; + ok = false; + goto match; } skip_size_check: @@ -3312,7 +3338,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, if (where) gfc_error ("Expected a procedure pointer for argument %qs at %L", f->sym->name, &a->expr->where); - return false; + ok = false; + goto match; } /* Satisfy F03:12.4.1.3 by ensuring that a procedure actual argument is @@ -3328,7 +3355,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, if (where) gfc_error ("Expected a procedure for argument %qs at %L", f->sym->name, &a->expr->where); - return false; + ok = false; + goto match; } /* Class array variables and expressions store array info in a @@ -3392,7 +3420,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, if (where) gfc_error ("Actual argument for %qs cannot be an assumed-size" " array at %L", f->sym->name, where); - return false; + ok = false; + goto match; } /* Diagnose F2018 C839 (TS29113 C535c). Here the problem is @@ -3421,7 +3450,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, gfc_error ("Actual argument to assumed-rank INTENT(OUT) " "dummy %qs at %L cannot be of unknown size", f->sym->name, where); - return false; + ok = false; + goto match; } if (a->expr->expr_type != EXPR_NULL @@ -3430,7 +3460,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, if (where) gfc_error ("Actual argument for %qs must be a pointer at %L", f->sym->name, &a->expr->where); - return false; + ok = false; + goto match; } if (a->expr->expr_type != EXPR_NULL @@ -3440,7 +3471,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, if (where) gfc_error ("Fortran 2008: Non-pointer actual argument at %L to " "pointer dummy %qs", &a->expr->where,f->sym->name); - return false; + ok = false; + goto match; } @@ -3451,7 +3483,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, gfc_error ("Coindexed actual argument at %L to pointer " "dummy %qs", &a->expr->where, f->sym->name); - return false; + ok = false; + goto match; } /* Fortran 2008, 12.5.2.5 (no constraint). */ @@ -3464,7 +3497,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, gfc_error ("Coindexed actual argument at %L to allocatable " "dummy %qs requires INTENT(IN)", &a->expr->where, f->sym->name); - return false; + ok = false; + goto match; } /* Fortran 2008, C1237. */ @@ -3479,7 +3513,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, "%L requires that dummy %qs has neither " "ASYNCHRONOUS nor VOLATILE", &a->expr->where, f->sym->name); - return false; + ok = false; + goto match; } /* Fortran 2008, 12.5.2.4 (no constraint). */ @@ -3492,7 +3527,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, gfc_error ("Coindexed actual argument at %L with allocatable " "ultimate component to dummy %qs requires either VALUE " "or INTENT(IN)", &a->expr->where, f->sym->name); - return false; + ok = false; + goto match; } if (f->sym->ts.type == BT_CLASS @@ -3503,7 +3539,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, if (where) gfc_error ("Actual CLASS array argument for %qs must be a full " "array at %L", f->sym->name, &a->expr->where); - return false; + ok = false; + goto match; } @@ -3513,7 +3550,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, if (where) gfc_error ("Actual argument for %qs must be ALLOCATABLE at %L", f->sym->name, &a->expr->where); - return false; + ok = false; + goto match; } /* Check intent = OUT/INOUT for definable actual argument. */ @@ -3529,9 +3567,15 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, && CLASS_DATA (f->sym)->attr.class_pointer) || (f->sym->ts.type != BT_CLASS && f->sym->attr.pointer)) && !gfc_check_vardef_context (a->expr, true, false, false, context)) - return false; + { + ok = false; + goto match; + } if (!gfc_check_vardef_context (a->expr, false, false, false, context)) - return false; + { + ok = false; + goto match; + } } if ((f->sym->attr.intent == INTENT_OUT @@ -3546,7 +3590,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, "INTENT(INOUT), VOLATILE or ASYNCHRONOUS attribute " "of the dummy argument %qs", &a->expr->where, f->sym->name); - return false; + ok = false; + goto match; } /* C1232 (R1221) For an actual argument which is an array section or @@ -3564,7 +3609,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, "incompatible with the non-assumed-shape " "dummy argument %qs due to VOLATILE attribute", &a->expr->where,f->sym->name); - return false; + ok = false; + goto match; } /* Find the last array_ref. */ @@ -3581,7 +3627,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, "incompatible with the non-assumed-shape " "dummy argument %qs due to VOLATILE attribute", &a->expr->where, f->sym->name); - return false; + ok = false; + goto match; } /* C1233 (R1221) For an actual argument which is a pointer array, the @@ -3601,7 +3648,8 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, "an assumed-shape or pointer-array dummy " "argument %qs due to VOLATILE attribute", &a->expr->where,f->sym->name); - return false; + ok = false; + goto match; } match: @@ -3611,6 +3659,10 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, new_arg[i++] = a; } + /* Give up now if we saw any bad argument. */ + if (!ok) + return false; + /* Make sure missing actual arguments are optional. */ i = 0; for (f = formal; f; f = f->next, i++) @@ -3646,9 +3698,12 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, /* The argument lists are compatible. We now relink a new actual argument list with null arguments in the right places. The head of the list remains the head. */ - for (i = 0; i < n; i++) + for (f = formal, i = 0; f; f = f->next, i++) if (new_arg[i] == NULL) - new_arg[i] = gfc_get_actual_arglist (); + { + new_arg[i] = gfc_get_actual_arglist (); + new_arg[i]->associated_dummy = get_nonintrinsic_dummy_arg (f); + } if (na != 0) { @@ -3664,11 +3719,6 @@ gfc_compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal, if (*ap == NULL && n > 0) *ap = new_arg[0]; - /* Note the types of omitted optional arguments. */ - for (a = *ap, f = formal; a; a = a->next, f = f->next) - if (a->expr == NULL && a->label == NULL) - a->missing_arg_type = f->sym->ts.type; - return true; } @@ -3731,7 +3781,7 @@ compare_actual_expr (gfc_expr *e1, gfc_expr *e2) || e1->symtree->n.sym != e2->symtree->n.sym) return false; - /* TODO: improve comparison, see expr.c:show_ref(). */ + /* TODO: improve comparison, see expr.cc:show_ref(). */ for (r1 = e1->ref, r2 = e2->ref; r1 && r2; r1 = r1->next, r2 = r2->next) { if (r1->type != r2->type) @@ -5486,3 +5536,54 @@ gfc_get_formal_from_actual_arglist (gfc_symbol *sym, f = &((*f)->next); } } + + +const char * +gfc_dummy_arg_get_name (gfc_dummy_arg & dummy_arg) +{ + switch (dummy_arg.intrinsicness) + { + case GFC_INTRINSIC_DUMMY_ARG: + return dummy_arg.u.intrinsic->name; + + case GFC_NON_INTRINSIC_DUMMY_ARG: + return dummy_arg.u.non_intrinsic->sym->name; + + default: + gcc_unreachable (); + } +} + + +const gfc_typespec & +gfc_dummy_arg_get_typespec (gfc_dummy_arg & dummy_arg) +{ + switch (dummy_arg.intrinsicness) + { + case GFC_INTRINSIC_DUMMY_ARG: + return dummy_arg.u.intrinsic->ts; + + case GFC_NON_INTRINSIC_DUMMY_ARG: + return dummy_arg.u.non_intrinsic->sym->ts; + + default: + gcc_unreachable (); + } +} + + +bool +gfc_dummy_arg_is_optional (gfc_dummy_arg & dummy_arg) +{ + switch (dummy_arg.intrinsicness) + { + case GFC_INTRINSIC_DUMMY_ARG: + return dummy_arg.u.intrinsic->optional; + + case GFC_NON_INTRINSIC_DUMMY_ARG: + return dummy_arg.u.non_intrinsic->sym->attr.optional; + + default: + gcc_unreachable (); + } +} diff --git a/gcc/fortran/intrinsic.c b/gcc/fortran/intrinsic.cc index f5c88d9..52e5f4e 100644 --- a/gcc/fortran/intrinsic.c +++ b/gcc/fortran/intrinsic.cc @@ -1,6 +1,6 @@ /* Build up a list of intrinsic subroutines and functions for the name-resolution stage. - Copyright (C) 2000-2021 Free Software Foundation, Inc. + Copyright (C) 2000-2022 Free Software Foundation, Inc. Contributed by Andy Vaught & Katherine Holcomb This file is part of GCC. @@ -103,6 +103,27 @@ gfc_type_letter (bt type, bool logical_equals_int) } +/* Return kind that should be used for ABI purposes in libgfortran + APIs. Usually the same as ts->kind, except for BT_REAL/BT_COMPLEX + for IEEE 754 quad format kind 16 where it returns 17. */ + +int +gfc_type_abi_kind (bt type, int kind) +{ + switch (type) + { + case BT_REAL: + case BT_COMPLEX: + if (kind == 16) + for (int i = 0; gfc_real_kinds[i].kind != 0; i++) + if (gfc_real_kinds[i].kind == kind) + return gfc_real_kinds[i].abi_kind; + return kind; + default: + return kind; + } +} + /* Get a symbol for a resolved name. Note, if needed be, the elemental attribute has be added afterwards. */ @@ -167,8 +188,8 @@ static const char * conv_name (gfc_typespec *from, gfc_typespec *to) { return gfc_get_string ("__convert_%c%d_%c%d", - gfc_type_letter (from->type), from->kind, - gfc_type_letter (to->type), to->kind); + gfc_type_letter (from->type), gfc_type_abi_kind (from), + gfc_type_letter (to->type), gfc_type_abi_kind (to)); } @@ -223,6 +244,7 @@ static bool do_ts29113_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg) { gfc_actual_arglist *a; + bool ok = true; for (a = arg; a; a = a->next) { @@ -238,7 +260,7 @@ do_ts29113_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg) gfc_error ("Variable with NO_ARG_CHECK attribute at %L is only " "permitted as argument to the intrinsic functions " "C_LOC and PRESENT", &a->expr->where); - return false; + ok = false; } else if (a->expr->ts.type == BT_ASSUMED && specific->id != GFC_ISYM_LBOUND @@ -254,32 +276,32 @@ do_ts29113_check (gfc_intrinsic_sym *specific, gfc_actual_arglist *arg) gfc_error ("Assumed-type argument at %L is not permitted as actual" " argument to the intrinsic %s", &a->expr->where, gfc_current_intrinsic); - return false; + ok = false; } else if (a->expr->ts.type == BT_ASSUMED && a != arg) { gfc_error ("Assumed-type argument at %L is only permitted as " "first actual argument to the intrinsic %s", &a->expr->where, gfc_current_intrinsic); - return false; + ok = false; } - if (a->expr->rank == -1 && !specific->inquiry) + else if (a->expr->rank == -1 && !specific->inquiry) { gfc_error ("Assumed-rank argument at %L is only permitted as actual " "argument to intrinsic inquiry functions", &a->expr->where); - return false; + ok = false; } - if (a->expr->rank == -1 && arg != a) + else if (a->expr->rank == -1 && arg != a) { gfc_error ("Assumed-rank argument at %L is only permitted as first " "actual argument to the intrinsic inquiry function %s", &a->expr->where, gfc_current_intrinsic); - return false; + ok = false; } } - return true; + return ok; } @@ -888,39 +910,6 @@ add_sym_4 (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, bt ty (void *) 0); } -/* Add a symbol to the function list where the function takes 4 - arguments and resolution may need to change the number or - arrangement of arguments. This is the case for INDEX, which needs - its KIND argument removed. */ - -static void -add_sym_4ind (const char *name, gfc_isym_id id, enum klass cl, int actual_ok, - bt type, int kind, int standard, - bool (*check) (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *), - gfc_expr *(*simplify) (gfc_expr *, gfc_expr *, gfc_expr *, - gfc_expr *), - void (*resolve) (gfc_expr *, gfc_actual_arglist *), - const char *a1, bt type1, int kind1, int optional1, - const char *a2, bt type2, int kind2, int optional2, - const char *a3, bt type3, int kind3, int optional3, - const char *a4, bt type4, int kind4, int optional4 ) -{ - gfc_check_f cf; - gfc_simplify_f sf; - gfc_resolve_f rf; - - cf.f4 = check; - sf.f4 = simplify; - rf.f1m = resolve; - - add_sym (name, id, cl, actual_ok, type, kind, standard, cf, sf, rf, - a1, type1, kind1, optional1, INTENT_IN, - a2, type2, kind2, optional2, INTENT_IN, - a3, type3, kind3, optional3, INTENT_IN, - a4, type4, kind4, optional4, INTENT_IN, - (void *) 0); -} - /* Add a symbol to the subroutine list where the subroutine takes 4 arguments. */ @@ -1406,7 +1395,7 @@ add_functions (void) make_generic ("abs", GFC_ISYM_ABS, GFC_STD_F77); /* The checking function for ACCESS is called gfc_check_access_func - because the name gfc_check_access is already used in module.c. */ + because the name gfc_check_access is already used in module.cc. */ add_sym_2 ("access", GFC_ISYM_ACCESS, CLASS_IMPURE, ACTUAL_NO, BT_INTEGER, di, GFC_STD_GNU, gfc_check_access_func, NULL, gfc_resolve_access, nm, BT_CHARACTER, dc, REQUIRED, md, BT_CHARACTER, dc, REQUIRED); @@ -2222,12 +2211,12 @@ add_functions (void) BT_INTEGER, di, REQUIRED, team, BT_VOID, di, OPTIONAL); /* The resolution function for INDEX is called gfc_resolve_index_func - because the name gfc_resolve_index is already used in resolve.c. */ - add_sym_4ind ("index", GFC_ISYM_INDEX, CLASS_ELEMENTAL, ACTUAL_YES, - BT_INTEGER, di, GFC_STD_F77, - gfc_check_index, gfc_simplify_index, gfc_resolve_index_func, - stg, BT_CHARACTER, dc, REQUIRED, ssg, BT_CHARACTER, dc, REQUIRED, - bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL); + because the name gfc_resolve_index is already used in resolve.cc. */ + add_sym_4 ("index", GFC_ISYM_INDEX, CLASS_ELEMENTAL, ACTUAL_YES, + BT_INTEGER, di, GFC_STD_F77, + gfc_check_index, gfc_simplify_index, gfc_resolve_index_func, + stg, BT_CHARACTER, dc, REQUIRED, ssg, BT_CHARACTER, dc, REQUIRED, + bck, BT_LOGICAL, dl, OPTIONAL, kind, BT_INTEGER, di, OPTIONAL); make_generic ("index", GFC_ISYM_INDEX, GFC_STD_F77); @@ -3805,7 +3794,7 @@ add_subroutines (void) BT_UNKNOWN, 0, GFC_STD_F2018, gfc_check_co_reduce, NULL, NULL, a, BT_REAL, dr, REQUIRED, INTENT_INOUT, - "operator", BT_INTEGER, di, REQUIRED, INTENT_IN, + "operation", BT_INTEGER, di, REQUIRED, INTENT_IN, result_image, BT_INTEGER, di, OPTIONAL, INTENT_IN, stat, BT_INTEGER, di, OPTIONAL, INTENT_OUT, errmsg, BT_CHARACTER, dc, OPTIONAL, INTENT_INOUT); @@ -4269,6 +4258,18 @@ remove_nullargs (gfc_actual_arglist **ap) } +static gfc_dummy_arg * +get_intrinsic_dummy_arg (gfc_intrinsic_arg *intrinsic) +{ + gfc_dummy_arg * const dummy_arg = gfc_get_dummy_arg (); + + dummy_arg->intrinsicness = GFC_INTRINSIC_DUMMY_ARG; + dummy_arg->u.intrinsic = intrinsic; + + return dummy_arg; +} + + /* Given an actual arglist and a formal arglist, sort the actual arglist so that its arguments are in a one-to-one correspondence with the format arglist. Arguments that are not present are given @@ -4286,8 +4287,14 @@ sort_actual (const char *name, gfc_actual_arglist **ap, remove_nullargs (ap); actual = *ap; + auto_vec<gfc_intrinsic_arg *> dummy_args; + auto_vec<gfc_actual_arglist *> ordered_actual_args; + for (f = formal; f; f = f->next) - f->actual = NULL; + dummy_args.safe_push (f); + + ordered_actual_args.safe_grow_cleared (dummy_args.length (), + /* exact = */true); f = formal; a = actual; @@ -4339,7 +4346,7 @@ sort_actual (const char *name, gfc_actual_arglist **ap, } } - for (;;) + for (int i = 0;; i++) { /* Put the nonkeyword arguments in a 1:1 correspondence */ if (f == NULL) break; @@ -4349,7 +4356,7 @@ sort_actual (const char *name, gfc_actual_arglist **ap, if (a->name != NULL) goto keywords; - f->actual = a; + ordered_actual_args[i] = a; f = f->next; a = a->next; @@ -4367,7 +4374,8 @@ keywords: to be keyword arguments. */ for (; a; a = a->next) { - for (f = formal; f; f = f->next) + int idx; + FOR_EACH_VEC_ELT (dummy_args, idx, f) if (strcmp (a->name, f->name) == 0) break; @@ -4382,21 +4390,21 @@ keywords: return false; } - if (f->actual != NULL) + if (ordered_actual_args[idx] != NULL) { gfc_error ("Argument %qs appears twice in call to %qs at %L", f->name, name, where); return false; } - - f->actual = a; + ordered_actual_args[idx] = a; } optional: /* At this point, all unmatched formal args must be optional. */ - for (f = formal; f; f = f->next) + int idx; + FOR_EACH_VEC_ELT (dummy_args, idx, f) { - if (f->actual == NULL && f->optional == 0) + if (ordered_actual_args[idx] == NULL && f->optional == 0) { gfc_error ("Missing actual argument %qs in call to %qs at %L", f->name, name, where); @@ -4409,21 +4417,19 @@ do_sort: together in a way that corresponds with the formal list. */ actual = NULL; - for (f = formal; f; f = f->next) + FOR_EACH_VEC_ELT (dummy_args, idx, f) { - if (f->actual && f->actual->label != NULL && f->ts.type) + a = ordered_actual_args[idx]; + if (a && a->label != NULL) { gfc_error ("ALTERNATE RETURN not permitted at %L", where); return false; } - if (f->actual == NULL) - { - a = gfc_get_actual_arglist (); - a->missing_arg_type = f->ts.type; - } - else - a = f->actual; + if (a == NULL) + a = gfc_get_actual_arglist (); + + a->associated_dummy = get_intrinsic_dummy_arg (f); if (actual == NULL) *ap = a; @@ -4530,10 +4536,9 @@ resolve_intrinsic (gfc_intrinsic_sym *specific, gfc_expr *e) arg = e->value.function.actual; - /* Special case hacks for MIN, MAX and INDEX. */ + /* Special case hacks for MIN and MAX. */ if (specific->resolve.f1m == gfc_resolve_max - || specific->resolve.f1m == gfc_resolve_min - || specific->resolve.f1m == gfc_resolve_index_func) + || specific->resolve.f1m == gfc_resolve_min) { (*specific->resolve.f1m) (e, arg); return; diff --git a/gcc/fortran/intrinsic.h b/gcc/fortran/intrinsic.h index 2148f89..a5c7487 100644 --- a/gcc/fortran/intrinsic.h +++ b/gcc/fortran/intrinsic.h @@ -1,6 +1,6 @@ /* Header file for intrinsics check, resolve and simplify function prototypes. - Copyright (C) 2000-2021 Free Software Foundation, Inc. + Copyright (C) 2000-2022 Free Software Foundation, Inc. Contributed by Andy Vaught & Katherine Holcomb This file is part of GCC. @@ -168,7 +168,6 @@ bool gfc_check_spread (gfc_expr *, gfc_expr *, gfc_expr *); bool gfc_check_srand (gfc_expr *); bool gfc_check_stat (gfc_expr *, gfc_expr *); bool gfc_check_storage_size (gfc_expr *, gfc_expr *); -bool gfc_check_sum (gfc_expr *, gfc_expr *, gfc_expr *); bool gfc_check_symlnk (gfc_expr *, gfc_expr *); bool gfc_check_team_number (gfc_expr *); bool gfc_check_transf_bit_intrins (gfc_actual_arglist *); @@ -459,7 +458,6 @@ void gfc_resolve_asinh (gfc_expr *, gfc_expr *); void gfc_resolve_atan (gfc_expr *, gfc_expr *); void gfc_resolve_atanh (gfc_expr *, gfc_expr *); void gfc_resolve_atan2 (gfc_expr *, gfc_expr *, gfc_expr *); -void gfc_resolve_atan2d (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_atomic_def (gfc_code *); void gfc_resolve_atomic_ref (gfc_code *); void gfc_resolve_besn (gfc_expr *, gfc_expr *, gfc_expr *); @@ -521,7 +519,8 @@ void gfc_resolve_ibits (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_ibset (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_image_index (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_image_status (gfc_expr *, gfc_expr *, gfc_expr *); -void gfc_resolve_index_func (gfc_expr *, gfc_actual_arglist *); +void gfc_resolve_index_func (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *, + gfc_expr *); void gfc_resolve_ierrno (gfc_expr *); void gfc_resolve_ieor (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_ichar (gfc_expr *, gfc_expr *, gfc_expr *); @@ -542,7 +541,6 @@ void gfc_resolve_rshift (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_lshift (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_ishft (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_ishftc (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); -void gfc_resolve_kill (gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_lbound (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_lcobound (gfc_expr *, gfc_expr *, gfc_expr *, gfc_expr *); void gfc_resolve_len (gfc_expr *, gfc_expr *, gfc_expr *); @@ -658,7 +656,6 @@ void gfc_resolve_gmtime (gfc_code *); void gfc_resolve_hostnm_sub (gfc_code *); void gfc_resolve_idate (gfc_code *); void gfc_resolve_itime (gfc_code *); -void gfc_resolve_kill_sub (gfc_code *); void gfc_resolve_lstat_sub (gfc_code *); void gfc_resolve_ltime (gfc_code *); void gfc_resolve_mvbits (gfc_code *); diff --git a/gcc/fortran/intrinsic.texi b/gcc/fortran/intrinsic.texi index 1b9a89d..f182cac 100644 --- a/gcc/fortran/intrinsic.texi +++ b/gcc/fortran/intrinsic.texi @@ -1,5 +1,5 @@ @ignore -Copyright (C) 2005-2021 Free Software Foundation, Inc. +Copyright (C) 2005-2022 Free Software Foundation, Inc. This is part of the GNU Fortran manual. For copying conditions, see the file gfortran.texi. @@ -218,10 +218,9 @@ Some basic guidelines for editing this document: * @code{LNBLNK}: LNBLNK, Index of the last non-blank character in a string * @code{LOC}: LOC, Returns the address of a variable * @code{LOG}: LOG, Logarithm function -* @code{LOG10}: LOG10, Base 10 logarithm function +* @code{LOG10}: LOG10, Base 10 logarithm function * @code{LOG_GAMMA}: LOG_GAMMA, Logarithm of the Gamma function * @code{LOGICAL}: LOGICAL, Convert to logical type -* @code{LONG}: LONG, Convert to integer type * @code{LSHIFT}: LSHIFT, Left shift bits * @code{LSTAT}: LSTAT, Get file status * @code{LTIME}: LTIME, Convert time to local time info @@ -330,14 +329,11 @@ Some basic guidelines for editing this document: @node Introduction to Intrinsics @section Introduction to intrinsic procedures -The intrinsic procedures provided by GNU Fortran include all of the -intrinsic procedures required by the Fortran 95 standard, a set of -intrinsic procedures for backwards compatibility with G77, and a -selection of intrinsic procedures from the Fortran 2003 and Fortran 2008 -standards. Any conflict between a description here and a description in -either the Fortran 95 standard, the Fortran 2003 standard or the Fortran -2008 standard is unintentional, and the standard(s) should be considered -authoritative. +The intrinsic procedures provided by GNU Fortran include procedures required +by the Fortran 95 and later supported standards, and a set of intrinsic +procedures for backwards compatibility with G77. Any conflict between +a description here and a description in the Fortran standards is +unintentional, and the standard(s) should be considered authoritative. The enumeration of the @code{KIND} type parameter is processor defined in the Fortran 95 standard. GNU Fortran defines the default integer type and @@ -356,7 +352,7 @@ Many of the intrinsic procedures take one or more optional arguments. This document follows the convention used in the Fortran 95 standard, and denotes such arguments by square brackets. -GNU Fortran offers the @option{-std=f95} and @option{-std=gnu} options, +GNU Fortran offers the @option{-std=} command-line option, which can be used to restrict the set of intrinsic procedures to a given standard. By default, @command{gfortran} sets the @option{-std=gnu} option, and so all intrinsic procedures described here are accepted. There @@ -461,7 +457,7 @@ end program test_abs @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{ABS(A)} @tab @code{REAL(4) A} @tab @code{REAL(4)} @tab Fortran 77 and later @item @code{CABS(A)} @tab @code{COMPLEX(4) A} @tab @code{REAL(4)} @tab Fortran 77 and later @@ -626,7 +622,7 @@ end program test_acos @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{ACOS(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab Fortran 77 and later @item @code{DACOS(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab Fortran 77 and later @@ -685,7 +681,7 @@ end program test_acosd @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{ACOSD(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab GNU extension @item @code{DACOSD(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab GNU extension @@ -741,7 +737,7 @@ END PROGRAM @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{DACOSH(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab GNU extension @end multitable @@ -890,7 +886,7 @@ end program test_aimag @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{AIMAG(Z)} @tab @code{COMPLEX Z} @tab @code{REAL} @tab Fortran 77 and later @item @code{DIMAG(Z)} @tab @code{COMPLEX(8) Z} @tab @code{REAL(8)} @tab GNU extension @@ -950,7 +946,7 @@ end program test_aint @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{AINT(A)} @tab @code{REAL(4) A} @tab @code{REAL(4)} @tab Fortran 77 and later @item @code{DINT(A)} @tab @code{REAL(8) A} @tab @code{REAL(8)} @tab Fortran 77 and later @@ -1230,7 +1226,7 @@ end program test_anint @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{ANINT(A)} @tab @code{REAL(4) A} @tab @code{REAL(4)} @tab Fortran 77 and later @item @code{DNINT(A)} @tab @code{REAL(8) A} @tab @code{REAL(8)} @tab Fortran 77 and later @@ -1346,7 +1342,7 @@ end program test_asin @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{ASIN(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab Fortran 77 and later @item @code{DASIN(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab Fortran 77 and later @@ -1405,7 +1401,7 @@ end program test_asind @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{ASIND(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab GNU extension @item @code{DASIND(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab GNU extension @@ -1461,7 +1457,7 @@ END PROGRAM @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{DASINH(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab GNU extension. @end multitable @@ -1597,7 +1593,7 @@ end program test_atan @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{ATAN(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab Fortran 77 and later @item @code{DATAN(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab Fortran 77 and later @@ -1662,7 +1658,7 @@ end program test_atand @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .23 .23 .20 .30 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{ATAND(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab GNU extension @item @code{DATAND(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab GNU extension @@ -1727,7 +1723,7 @@ end program test_atan2 @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .22 .22 .20 .32 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{ATAN2(X, Y)} @tab @code{REAL(4) X, Y} @tab @code{REAL(4)} @tab Fortran 77 and later @item @code{DATAN2(X, Y)} @tab @code{REAL(8) X, Y} @tab @code{REAL(8)} @tab Fortran 77 and later @@ -1795,7 +1791,7 @@ end program test_atan2d @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .23 .23 .20 .30 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{ATAN2D(X, Y)} @tab @code{REAL(4) X, Y} @tab @code{REAL(4)} @tab GNU extension @item @code{DATAN2D(X, Y)} @tab @code{REAL(8) X, Y} @tab @code{REAL(8)} @tab GNU extension @@ -1851,7 +1847,7 @@ END PROGRAM @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{DATANH(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab GNU extension @end multitable @@ -2540,7 +2536,7 @@ end program test_besj0 @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .21 .22 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{DBESJ0(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab GNU extension @end multitable @@ -2589,7 +2585,7 @@ end program test_besj1 @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{DBESJ1(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab GNU extension @end multitable @@ -2654,7 +2650,7 @@ end program test_besjn @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .22 .22 .20 .32 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{DBESJN(N, X)} @tab @code{INTEGER N} @tab @code{REAL(8)} @tab GNU extension @item @tab @code{REAL(8) X} @tab @tab @@ -2702,7 +2698,7 @@ end program test_besy0 @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{DBESY0(X)}@tab @code{REAL(8) X} @tab @code{REAL(8)} @tab GNU extension @end multitable @@ -2749,7 +2745,7 @@ end program test_besy1 @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{DBESY1(X)}@tab @code{REAL(8) X} @tab @code{REAL(8)} @tab GNU extension @end multitable @@ -2814,10 +2810,10 @@ end program test_besyn @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{DBESYN(N,X)} @tab @code{INTEGER N} @tab @code{REAL(8)} @tab GNU extension -@item @tab @code{REAL(8) X} @tab @tab +@item @tab @code{REAL(8) X} @tab @tab @end multitable @end table @@ -3057,7 +3053,7 @@ end program test_btest @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .21 .28 .18 .30 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{BTEST(I,POS)} @tab @code{INTEGER I,POS} @tab @code{LOGICAL} @tab Fortran 95 and later @item @code{BBTEST(I,POS)} @tab @code{INTEGER(1) I,POS} @tab @code{LOGICAL(1)} @tab GNU extension @@ -3474,7 +3470,7 @@ end program test_char @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .18 .18 .24 .25 +@multitable @columnfractions .19 .19 .25 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{CHAR(I)} @tab @code{INTEGER I} @tab @code{CHARACTER(LEN=1)} @tab Fortran 77 and later @end multitable @@ -3845,7 +3841,7 @@ end program test @table @asis @item @emph{Description}: @code{CO_REDUCE} determines element-wise the reduction of the value of @var{A} -on all images of the current team. The pure function passed as @var{OPERATOR} +on all images of the current team. The pure function passed as @var{OPERATION} is used to pairwise reduce the values of @var{A} by passing either the value of @var{A} of different images or the result values of such a reduction as argument. If @var{A} is an array, the deduction is done element wise. If @@ -3864,7 +3860,7 @@ Technical Specification (TS) 18508 or later Collective subroutine @item @emph{Syntax}: -@code{CALL CO_REDUCE(A, OPERATOR, [, RESULT_IMAGE, STAT, ERRMSG])} +@code{CALL CO_REDUCE(A, OPERATION, [, RESULT_IMAGE, STAT, ERRMSG])} @item @emph{Arguments}: @multitable @columnfractions .20 .65 @@ -3873,12 +3869,12 @@ nonpolymorphic. If it is allocatable, it shall be allocated; if it is a pointer, it shall be associated. @var{A} shall have the same type and type parameters on all images of the team; if it is an array, it shall have the same shape on all images. -@item @var{OPERATOR} @tab pure function with two scalar nonallocatable +@item @var{OPERATION} @tab pure function with two scalar nonallocatable arguments, which shall be nonpolymorphic and have the same type and type parameters as @var{A}. The function shall return a nonallocatable scalar of the same type and type parameters as @var{A}. The function shall be the same on all images and with regards to the arguments mathematically commutative and -associative. Note that @var{OPERATOR} may not be an elemental function, unless +associative. Note that @var{OPERATION} may not be an elemental function, unless it is an intrisic function. @item @var{RESULT_IMAGE} @tab (optional) a scalar integer expression; if present, it shall have the same value on all images and refer to an @@ -3892,7 +3888,7 @@ image of the current team. program test integer :: val val = this_image () - call co_reduce (val, result_image=1, operator=myprod) + call co_reduce (val, result_image=1, operation=myprod) if (this_image() == 1) then write(*,*) "Product value", val ! prints num_images() factorial end if @@ -4203,7 +4199,7 @@ end program test_conjg @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{DCONJG(Z)} @tab @code{COMPLEX(8) Z} @tab @code{COMPLEX(8)} @tab GNU extension @end multitable @@ -4254,7 +4250,7 @@ end program test_cos @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{COS(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab Fortran 77 and later @item @code{DCOS(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab Fortran 77 and later @@ -4318,7 +4314,7 @@ end program test_cosd @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{COSD(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab GNU extension @item @code{DCOSD(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab GNU extension @@ -4377,7 +4373,7 @@ end program test_cosh @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{COSH(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab Fortran 77 and later @item @code{DCOSH(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab Fortran 77 and later @@ -4431,7 +4427,7 @@ end program test_cotan @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{COTAN(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab GNU extension @item @code{DCOTAN(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab GNU extension @@ -4487,7 +4483,7 @@ end program test_cotand @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{COTAND(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab GNU extension @item @code{DCOTAND(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab GNU extension @@ -5002,7 +4998,7 @@ end program test_dim @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .26 .20 .30 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{DIM(X,Y)} @tab @code{REAL(4) X, Y} @tab @code{REAL(4)} @tab Fortran 77 and later @item @code{IDIM(X,Y)} @tab @code{INTEGER(4) X, Y} @tab @code{INTEGER(4)} @tab Fortran 77 and later @@ -5105,7 +5101,7 @@ end program test_dprod @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{DPROD(X,Y)} @tab @code{REAL(4) X, Y} @tab @code{REAL(8)} @tab Fortran 77 and later @end multitable @@ -5474,7 +5470,7 @@ end program test_erf @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{DERF(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab GNU extension @end multitable @@ -5518,7 +5514,7 @@ end program test_erfc @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{DERFC(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab GNU extension @end multitable @@ -5862,7 +5858,7 @@ end program test_exp @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{EXP(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab Fortran 77 and later @item @code{DEXP(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab Fortran 77 and later @@ -6802,7 +6798,7 @@ end program test_gamma @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{DGAMMA(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab GNU extension @end multitable @@ -7691,7 +7687,7 @@ END PROGRAM @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{IAND(A)} @tab @code{INTEGER A} @tab @code{INTEGER} @tab Fortran 90 and later @item @code{BIAND(A)} @tab @code{INTEGER(1) A} @tab @code{INTEGER(1)} @tab GNU extension @@ -7854,7 +7850,7 @@ The return value is of type @code{INTEGER} and of the same kind as @var{I}. @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{IBCLR(A)} @tab @code{INTEGER A} @tab @code{INTEGER} @tab Fortran 90 and later @item @code{BBCLR(A)} @tab @code{INTEGER(1) A} @tab @code{INTEGER(1)} @tab GNU extension @@ -7913,7 +7909,7 @@ The return value is of type @code{INTEGER} and of the same kind as @var{I}. @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{IBITS(A)} @tab @code{INTEGER A} @tab @code{INTEGER} @tab Fortran 90 and later @item @code{BBITS(A)} @tab @code{INTEGER(1) A} @tab @code{INTEGER(1)} @tab GNU extension @@ -7967,7 +7963,7 @@ The return value is of type @code{INTEGER} and of the same kind as @var{I}. @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{IBSET(A)} @tab @code{INTEGER A} @tab @code{INTEGER} @tab Fortran 90 and later @item @code{BBSET(A)} @tab @code{INTEGER(1) A} @tab @code{INTEGER(1)} @tab GNU extension @@ -8028,7 +8024,7 @@ end program test_ichar @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{ICHAR(C)} @tab @code{CHARACTER C} @tab @code{INTEGER(4)} @tab Fortran 77 and later @end multitable @@ -8155,7 +8151,7 @@ A boz-literal-constant is converted to an @code{INTEGER} with the kind type parameter of the other argument as-if a call to @ref{INT} occurred. @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{IEOR(A)} @tab @code{INTEGER A} @tab @code{INTEGER} @tab Fortran 90 and later @item @code{BIEOR(A)} @tab @code{INTEGER(1) A} @tab @code{INTEGER(1)} @tab GNU extension @@ -8292,9 +8288,9 @@ The return value is of type @code{INTEGER} and of kind @var{KIND}. If @var{KIND} is absent, the return value is of default integer kind. @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .35 .15 .17 .30 @headitem Name @tab Argument @tab Return type @tab Standard -@item @code{INDEX(STRING, SUBSTRING)} @tab @code{CHARACTER} @tab @code{INTEGER(4)} @tab Fortran 77 and later +@item @code{INDEX(STRING,SUBSTRING)} @tab @code{CHARACTER} @tab @code{INTEGER(4)} @tab Fortran 77 and later @end multitable @item @emph{See also}: @@ -8359,7 +8355,7 @@ end program @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{INT(A)} @tab @code{REAL(4) A} @tab @code{INTEGER} @tab Fortran 77 and later @item @code{IFIX(A)} @tab @code{REAL(4) A} @tab @code{INTEGER} @tab Fortran 77 and later @@ -8372,7 +8368,6 @@ end program @node INT2 @section @code{INT2} --- Convert to 16-bit integer type @fnindex INT2 -@fnindex SHORT @cindex conversion, to integer @table @asis @@ -8381,8 +8376,6 @@ Convert to a @code{KIND=2} integer type. This is equivalent to the standard @code{INT} intrinsic with an optional argument of @code{KIND=2}, and is only included for backwards compatibility. -The @code{SHORT} intrinsic is equivalent to @code{INT2}. - @item @emph{Standard}: GNU extension @@ -8403,8 +8396,7 @@ The return value is a @code{INTEGER(2)} variable. @item @emph{See also}: @ref{INT}, @gol -@ref{INT8}, @gol -@ref{LONG} +@ref{INT8} @end table @@ -8440,8 +8432,7 @@ The return value is a @code{INTEGER(8)} variable. @item @emph{See also}: @ref{INT}, @gol -@ref{INT2}, @gol -@ref{LONG} +@ref{INT2} @end table @@ -8485,7 +8476,7 @@ A boz-literal-constant is converted to an @code{INTEGER} with the kind type parameter of the other argument as-if a call to @ref{INT} occurred. @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{IOR(A)} @tab @code{INTEGER A} @tab @code{INTEGER} @tab Fortran 90 and later @item @code{BIOR(A)} @tab @code{INTEGER(1) A} @tab @code{INTEGER(1)} @tab GNU extension @@ -8839,7 +8830,7 @@ The return value is of type @code{INTEGER} and of the same kind as @var{I}. @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{ISHFT(A)} @tab @code{INTEGER A} @tab @code{INTEGER} @tab Fortran 90 and later @item @code{BSHFT(A)} @tab @code{INTEGER(1) A} @tab @code{INTEGER(1)} @tab GNU extension @@ -8897,7 +8888,7 @@ The return value is of type @code{INTEGER} and of the same kind as @var{I}. @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{ISHFTC(A)} @tab @code{INTEGER A} @tab @code{INTEGER} @tab Fortran 90 and later @item @code{BSHFTC(A)} @tab @code{INTEGER(1) A} @tab @code{INTEGER(1)} @tab GNU extension @@ -9258,7 +9249,7 @@ The return value is of type @code{INTEGER} and of kind @var{KIND}. If @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{LEN(STRING)} @tab @code{CHARACTER} @tab @code{INTEGER} @tab Fortran 77 and later @end multitable @@ -9351,9 +9342,9 @@ Returns @code{.TRUE.} if @code{STRING_A >= STRING_B}, and @code{.FALSE.} otherwise, based on the ASCII ordering. @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .34 .16 .17 .30 @headitem Name @tab Argument @tab Return type @tab Standard -@item @code{LGE(STRING_A, STRING_B)} @tab @code{CHARACTER} @tab @code{LOGICAL} @tab Fortran 77 and later +@item @code{LGE(STRING_A,STRING_B)} @tab @code{CHARACTER} @tab @code{LOGICAL} @tab Fortran 77 and later @end multitable @item @emph{See also}: @@ -9405,9 +9396,9 @@ Returns @code{.TRUE.} if @code{STRING_A > STRING_B}, and @code{.FALSE.} otherwise, based on the ASCII ordering. @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .34 .16 .17 .30 @headitem Name @tab Argument @tab Return type @tab Standard -@item @code{LGT(STRING_A, STRING_B)} @tab @code{CHARACTER} @tab @code{LOGICAL} @tab Fortran 77 and later +@item @code{LGT(STRING_A,STRING_B)} @tab @code{CHARACTER} @tab @code{LOGICAL} @tab Fortran 77 and later @end multitable @item @emph{See also}: @@ -9503,9 +9494,9 @@ Returns @code{.TRUE.} if @code{STRING_A <= STRING_B}, and @code{.FALSE.} otherwise, based on the ASCII ordering. @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .34 .16 .17 .30 @headitem Name @tab Argument @tab Return type @tab Standard -@item @code{LLE(STRING_A, STRING_B)} @tab @code{CHARACTER} @tab @code{LOGICAL} @tab Fortran 77 and later +@item @code{LLE(STRING_A,STRING_B)} @tab @code{CHARACTER} @tab @code{LOGICAL} @tab Fortran 77 and later @end multitable @item @emph{See also}: @@ -9557,9 +9548,9 @@ Returns @code{.TRUE.} if @code{STRING_A < STRING_B}, and @code{.FALSE.} otherwise, based on the ASCII ordering. @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .34 .16 .17 .30 @headitem Name @tab Argument @tab Return type @tab Standard -@item @code{LLT(STRING_A, STRING_B)} @tab @code{CHARACTER} @tab @code{LOGICAL} @tab Fortran 77 and later +@item @code{LLT(STRING_A,STRING_B)} @tab @code{CHARACTER} @tab @code{LOGICAL} @tab Fortran 77 and later @end multitable @item @emph{See also}: @@ -9696,7 +9687,7 @@ end program test_log @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{ALOG(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab Fortran 77 or later @item @code{DLOG(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab Fortran 77 or later @@ -9748,7 +9739,7 @@ end program test_log10 @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{ALOG10(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab Fortran 77 and later @item @code{DLOG10(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab Fortran 77 and later @@ -9797,7 +9788,7 @@ end program test_log_gamma @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{LGAMMA(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab GNU extension @item @code{ALGAMA(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab GNU extension @@ -9849,44 +9840,6 @@ kind corresponding to @var{KIND}, or of the default logical kind if -@node LONG -@section @code{LONG} --- Convert to integer type -@fnindex LONG -@cindex conversion, to integer - -@table @asis -@item @emph{Description}: -Convert to a @code{KIND=4} integer type, which is the same size as a C -@code{long} integer. This is equivalent to the standard @code{INT} -intrinsic with an optional argument of @code{KIND=4}, and is only -included for backwards compatibility. - -@item @emph{Standard}: -GNU extension - -@item @emph{Class}: -Elemental function - -@item @emph{Syntax}: -@code{RESULT = LONG(A)} - -@item @emph{Arguments}: -@multitable @columnfractions .15 .70 -@item @var{A} @tab Shall be of type @code{INTEGER}, -@code{REAL}, or @code{COMPLEX}. -@end multitable - -@item @emph{Return value}: -The return value is a @code{INTEGER(4)} variable. - -@item @emph{See also}: -@ref{INT}, @gol -@ref{INT2}, @gol -@ref{INT8} -@end table - - - @node LSHIFT @section @code{LSHIFT} --- Left shift bits @fnindex LSHIFT @@ -10256,7 +10209,7 @@ The return value corresponds to the maximum value among the arguments, and has the same type and kind as the first argument. @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{MAX0(A1)} @tab @code{INTEGER(4) A1} @tab @code{INTEGER(4)} @tab Fortran 77 and later @item @code{AMAX0(A1)} @tab @code{INTEGER(4) A1} @tab @code{REAL(MAX(X))} @tab Fortran 77 and later @@ -10631,7 +10584,7 @@ The return value corresponds to the minimum value among the arguments, and has the same type and kind as the first argument. @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{MIN0(A1)} @tab @code{INTEGER(4) A1} @tab @code{INTEGER(4)} @tab Fortran 77 and later @item @code{AMIN0(A1)} @tab @code{INTEGER(4) A1} @tab @code{REAL(4)} @tab Fortran 77 and later @@ -10864,7 +10817,7 @@ end program test_mod @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .25 .20 .31 @headitem Name @tab Arguments @tab Return type @tab Standard @item @code{MOD(A,P)} @tab @code{INTEGER A,P} @tab @code{INTEGER} @tab Fortran 77 and later @item @code{AMOD(A,P)} @tab @code{REAL(4) A,P} @tab @code{REAL(4)} @tab Fortran 77 and later @@ -11029,7 +10982,7 @@ same kind as @var{FROM}. @end multitable @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{MVBITS(A)} @tab @code{INTEGER A} @tab @code{INTEGER} @tab Fortran 90 and later @item @code{BMVBITS(A)} @tab @code{INTEGER(1) A} @tab @code{INTEGER(1)} @tab GNU extension @@ -11179,7 +11132,7 @@ end program test_nint @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return Type @tab Standard @item @code{NINT(A)} @tab @code{REAL(4) A} @tab @code{INTEGER} @tab Fortran 77 and later @item @code{IDNINT(A)} @tab @code{REAL(8) A} @tab @code{INTEGER} @tab Fortran 77 and later @@ -11277,7 +11230,7 @@ The return type is @code{INTEGER}, of the same kind as the argument. @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{NOT(A)} @tab @code{INTEGER A} @tab @code{INTEGER} @tab Fortran 95 and later @item @code{BNOT(A)} @tab @code{INTEGER(1) A} @tab @code{INTEGER(1)} @tab GNU extension @@ -12293,14 +12246,14 @@ end program test_real @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard -@item @code{FLOAT(A)} @tab @code{INTEGER(4)} @tab @code{REAL(4)} @tab GNU extension +@item @code{FLOAT(A)} @tab @code{INTEGER(4)} @tab @code{REAL(4)} @tab Fortran 77 and later @item @code{DFLOAT(A)} @tab @code{INTEGER(4)} @tab @code{REAL(8)} @tab GNU extension -@item @code{FLOATI(A)} @tab @code{INTEGER(2)} @tab @code{REAL(4)} @tab GNU extension -@item @code{FLOATJ(A)} @tab @code{INTEGER(4)} @tab @code{REAL(4)} @tab GNU extension -@item @code{FLOATK(A)} @tab @code{INTEGER(8)} @tab @code{REAL(4)} @tab GNU extension -@item @code{SNGL(A)} @tab @code{INTEGER(8)} @tab @code{REAL(4)} @tab GNU extension +@item @code{FLOATI(A)} @tab @code{INTEGER(2)} @tab @code{REAL(4)} @tab GNU extension (-fdec) +@item @code{FLOATJ(A)} @tab @code{INTEGER(4)} @tab @code{REAL(4)} @tab GNU extension (-fdec) +@item @code{FLOATK(A)} @tab @code{INTEGER(8)} @tab @code{REAL(4)} @tab GNU extension (-fdec) +@item @code{SNGL(A)} @tab @code{REAL(8)} @tab @code{REAL(4)} @tab Fortran 77 and later @end multitable @@ -13180,7 +13133,7 @@ Elemental function @item @emph{Return value}: The kind of the return value is that of @var{A} and @var{B}. -If @math{B\ge 0} then the result is @code{ABS(A)}, else +If @math{B \ge 0} then the result is @code{ABS(A)}, else it is @code{-ABS(A)}. @item @emph{Example}: @@ -13197,7 +13150,7 @@ end program test_sign @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .26 .20 .30 @headitem Name @tab Arguments @tab Return type @tab Standard @item @code{SIGN(A,B)} @tab @code{REAL(4) A, B} @tab @code{REAL(4)} @tab Fortran 77 and later @item @code{ISIGN(A,B)} @tab @code{INTEGER(4) A, B} @tab @code{INTEGER(4)} @tab Fortran 77 and later @@ -13306,7 +13259,7 @@ end program test_sin @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{SIN(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab Fortran 77 and later @item @code{DSIN(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab Fortran 77 and later @@ -13368,7 +13321,7 @@ end program test_sind @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{SIND(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab GNU extension @item @code{DSIND(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab GNU extension @@ -13425,7 +13378,7 @@ end program test_sinh @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{DSINH(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab Fortran 90 and later @end multitable @@ -13710,7 +13663,7 @@ end program test_sqrt @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{SQRT(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab Fortran 77 and later @item @code{DSQRT(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab Fortran 77 and later @@ -14161,7 +14114,7 @@ end program test_tan @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{TAN(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab Fortran 77 and later @item @code{DTAN(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab Fortran 77 and later @@ -14216,7 +14169,7 @@ end program test_tand @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{TAND(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab GNU extension @item @code{DTAND(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab GNU extension @@ -14272,7 +14225,7 @@ end program test_tanh @end smallexample @item @emph{Specific names}: -@multitable @columnfractions .20 .20 .20 .25 +@multitable @columnfractions .20 .23 .20 .33 @headitem Name @tab Argument @tab Return type @tab Standard @item @code{TANH(X)} @tab @code{REAL(4) X} @tab @code{REAL(4)} @tab Fortran 77 and later @item @code{DTANH(X)} @tab @code{REAL(8) X} @tab @code{REAL(8)} @tab Fortran 77 and later @@ -15196,7 +15149,7 @@ C compiler: @code{C_INT128_T, C_INT_LEAST128_T, C_INT_FAST128_T}. Furthermore, if @code{_Float128} is supported in C, the named constants @code{C_FLOAT128} and @code{C_FLOAT128_COMPLEX} are defined. -@multitable @columnfractions .15 .35 .35 .35 +@multitable @columnfractions .19 .32 .34 .15 @headitem Fortran Type @tab Named constant @tab C type @tab Extension @item @code{INTEGER}@tab @code{C_INT} @tab @code{int} @item @code{INTEGER}@tab @code{C_SHORT} @tab @code{short int} @@ -15308,7 +15261,7 @@ the named constants defined in the modules are listed below. For details refer to the actual -@uref{http://www.openmp.org/wp-content/uploads/openmp-4.5.pdf, +@uref{https://www.openmp.org/wp-content/uploads/openmp-4.5.pdf, OpenMP Application Program Interface v4.5} and @uref{https://www.openmp.org/wp-content/uploads/OpenMP-API-Specification-5.0.pdf, OpenMP Application Program Interface v5.0}. @@ -15473,7 +15426,7 @@ Runtime Library} manual, the named constants defined in the modules are listed below. For details refer to the actual -@uref{http://www.openacc.org/, +@uref{https://www.openacc.org/, OpenACC Application Programming Interface v2.6}. @code{OPENACC} provides the scalar default-integer diff --git a/gcc/fortran/invoke.texi b/gcc/fortran/invoke.texi index 0fb7e1a..6435dc4 100644 --- a/gcc/fortran/invoke.texi +++ b/gcc/fortran/invoke.texi @@ -1,10 +1,10 @@ -@c Copyright (C) 2004-2021 Free Software Foundation, Inc. +@c Copyright (C) 2004-2022 Free Software Foundation, Inc. @c This is part of the GNU Fortran manual. @c For copying conditions, see the file gfortran.texi. @ignore @c man begin COPYRIGHT -Copyright @copyright{} 2004-2021 Free Software Foundation, Inc. +Copyright @copyright{} 2004-2022 Free Software Foundation, Inc. Permission is granted to copy, distribute and/or modify this document under the terms of the GNU Free Documentation License, Version 1.3 or @@ -227,7 +227,7 @@ form is determined by the file extension. @item -fall-intrinsics @opindex @code{fall-intrinsics} This option causes all intrinsic procedures (including the GNU-specific -extensions) to be accepted. This can be useful with @option{-std=f95} to +extensions) to be accepted. This can be useful with @option{-std=} to force standard-compliance but get access to the full range of intrinsics available with @command{gfortran}. As a consequence, @option{-Wintrinsics-std} will be ignored and no user-defined procedure with the same name as any @@ -397,7 +397,7 @@ lines in the source file. The default value is 132. @item -fmax-identifier-length=@var{n} @opindex @code{fmax-identifier-length=}@var{n} Specify the maximum allowed identifier length. Typical values are -31 (Fortran 95) and 63 (Fortran 2003 and Fortran 2008). +31 (Fortran 95) and 63 (Fortran 2003 and later). @item -fimplicit-none @opindex @code{fimplicit-none} @@ -570,10 +570,46 @@ Enhance test coverage by forcing most forall assignments to use temporary. @cindex preprocessor @cindex options, preprocessor @cindex CPP - -Preprocessor related options. See section -@ref{Preprocessing and conditional compilation} for more detailed -information on preprocessing in @command{gfortran}. +@cindex FPP +@cindex Conditional compilation +@cindex Preprocessing +@cindex preprocessor, include file handling + +Many Fortran compilers including GNU Fortran allow passing the source code +through a C preprocessor (CPP; sometimes also called the Fortran preprocessor, +FPP) to allow for conditional compilation. In the case of GNU Fortran, +this is the GNU C Preprocessor in the traditional mode. On systems with +case-preserving file names, the preprocessor is automatically invoked if the +filename extension is @file{.F}, @file{.FOR}, @file{.FTN}, @file{.fpp}, +@file{.FPP}, @file{.F90}, @file{.F95}, @file{.F03} or @file{.F08}. To manually +invoke the preprocessor on any file, use @option{-cpp}, to disable +preprocessing on files where the preprocessor is run automatically, use +@option{-nocpp}. + +If a preprocessed file includes another file with the Fortran @code{INCLUDE} +statement, the included file is not preprocessed. To preprocess included +files, use the equivalent preprocessor statement @code{#include}. + +If GNU Fortran invokes the preprocessor, @code{__GFORTRAN__} +is defined. The macros @code{__GNUC__}, @code{__GNUC_MINOR__} and +@code{__GNUC_PATCHLEVEL__} can be used to determine the version of the +compiler. See @ref{Top,,Overview,cpp,The C Preprocessor} for details. + +GNU Fortran supports a number of @code{INTEGER} and @code{REAL} kind types +in additional to the kind types required by the Fortran standard. +The availability of any given kind type is architecture dependent. The +following pre-defined preprocessor macros can be used to conditionally +include code for these additional kind types: @code{__GFC_INT_1__}, +@code{__GFC_INT_2__}, @code{__GFC_INT_8__}, @code{__GFC_INT_16__}, +@code{__GFC_REAL_10__}, and @code{__GFC_REAL_16__}. + +While CPP is the de-facto standard for preprocessing Fortran code, +Part 3 of the Fortran 95 standard (ISO/IEC 1539-3:1998) defines +Conditional Compilation, which is not widely used and not directly +supported by the GNU Fortran compiler. You can use the program coco +to preprocess such files (@uref{http://www.daniellnagle.com/coco.html}). + +The following options control preprocessing of Fortran code: @table @gcctabopt @item -cpp diff --git a/gcc/fortran/io.c b/gcc/fortran/io.cc index fc97df7..902aa19 100644 --- a/gcc/fortran/io.c +++ b/gcc/fortran/io.cc @@ -1,5 +1,5 @@ /* Deal with I/O statements & related stuff. - Copyright (C) 2000-2021 Free Software Foundation, Inc. + Copyright (C) 2000-2022 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. diff --git a/gcc/fortran/ioparm.def b/gcc/fortran/ioparm.def index f7e2282..35a5785 100644 --- a/gcc/fortran/ioparm.def +++ b/gcc/fortran/ioparm.def @@ -1,4 +1,4 @@ -/* Copyright (C) 2005-2021 Free Software Foundation, Inc. +/* Copyright (C) 2005-2022 Free Software Foundation, Inc. This file is part of GCC. diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.cc index e17fe45f..dea1935 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.cc @@ -1,5 +1,5 @@ /* Intrinsic function resolution. - Copyright (C) 2000-2021 Free Software Foundation, Inc. + Copyright (C) 2000-2022 Free Software Foundation, Inc. Contributed by Andy Vaught & Katherine Holcomb This file is part of GCC. @@ -191,7 +191,8 @@ resolve_transformational (const char *name, gfc_expr *f, gfc_expr *array, f->value.function.name = gfc_get_string (PREFIX ("%s%s_%c%d"), prefix, name, - gfc_type_letter (array->ts.type), array->ts.kind); + gfc_type_letter (array->ts.type), + gfc_type_abi_kind (&array->ts)); } @@ -206,7 +207,8 @@ gfc_resolve_abs (gfc_expr *f, gfc_expr *a) f->ts.type = BT_REAL; f->value.function.name - = gfc_get_string ("__abs_%c%d", gfc_type_letter (a->ts.type), a->ts.kind); + = gfc_get_string ("__abs_%c%d", gfc_type_letter (a->ts.type), + gfc_type_abi_kind (&a->ts)); } @@ -256,7 +258,8 @@ gfc_resolve_char_achar (gfc_expr *f, gfc_expr *x, gfc_expr *kind, f->value.function.name = gfc_get_string ("__%schar_%d_%c%d", is_achar ? "a" : "", f->ts.kind, - gfc_type_letter (x->ts.type), x->ts.kind); + gfc_type_letter (x->ts.type), + gfc_type_abi_kind (&x->ts)); } @@ -272,7 +275,8 @@ gfc_resolve_acos (gfc_expr *f, gfc_expr *x) { f->ts = x->ts; f->value.function.name - = gfc_get_string ("__acos_%c%d", gfc_type_letter (x->ts.type), x->ts.kind); + = gfc_get_string ("__acos_%c%d", gfc_type_letter (x->ts.type), + gfc_type_abi_kind (&x->ts)); } @@ -282,7 +286,7 @@ gfc_resolve_acosh (gfc_expr *f, gfc_expr *x) f->ts = x->ts; f->value.function.name = gfc_get_string ("__acosh_%c%d", gfc_type_letter (x->ts.type), - x->ts.kind); + gfc_type_abi_kind (&x->ts)); } @@ -293,7 +297,7 @@ gfc_resolve_aimag (gfc_expr *f, gfc_expr *x) f->ts.kind = x->ts.kind; f->value.function.name = gfc_get_string ("__aimag_%c%d", gfc_type_letter (x->ts.type), - x->ts.kind); + gfc_type_abi_kind (&x->ts)); } @@ -312,7 +316,8 @@ gfc_resolve_and (gfc_expr *f, gfc_expr *i, gfc_expr *j) } f->value.function.name - = gfc_get_string ("__and_%c%d", gfc_type_letter (i->ts.type), f->ts.kind); + = gfc_get_string ("__and_%c%d", gfc_type_letter (i->ts.type), + gfc_type_abi_kind (&f->ts)); } @@ -334,7 +339,8 @@ gfc_resolve_aint (gfc_expr *f, gfc_expr *a, gfc_expr *kind) /* The resolved name is only used for specific intrinsics where the return kind is the same as the arg kind. */ f->value.function.name - = gfc_get_string ("__aint_%c%d", gfc_type_letter (a->ts.type), a->ts.kind); + = gfc_get_string ("__aint_%c%d", gfc_type_letter (a->ts.type), + gfc_type_abi_kind (&a->ts)); } @@ -359,7 +365,7 @@ gfc_resolve_all (gfc_expr *f, gfc_expr *mask, gfc_expr *dim) f->value.function.name = gfc_get_string (PREFIX ("all_%c%d"), gfc_type_letter (mask->ts.type), - mask->ts.kind); + gfc_type_abi_kind (&mask->ts)); } @@ -383,7 +389,7 @@ gfc_resolve_anint (gfc_expr *f, gfc_expr *a, gfc_expr *kind) the return kind is the same as the arg kind. */ f->value.function.name = gfc_get_string ("__anint_%c%d", gfc_type_letter (a->ts.type), - a->ts.kind); + gfc_type_abi_kind (&a->ts)); } @@ -408,7 +414,7 @@ gfc_resolve_any (gfc_expr *f, gfc_expr *mask, gfc_expr *dim) f->value.function.name = gfc_get_string (PREFIX ("any_%c%d"), gfc_type_letter (mask->ts.type), - mask->ts.kind); + gfc_type_abi_kind (&mask->ts)); } @@ -417,7 +423,8 @@ gfc_resolve_asin (gfc_expr *f, gfc_expr *x) { f->ts = x->ts; f->value.function.name - = gfc_get_string ("__asin_%c%d", gfc_type_letter (x->ts.type), x->ts.kind); + = gfc_get_string ("__asin_%c%d", gfc_type_letter (x->ts.type), + gfc_type_abi_kind (&x->ts)); } void @@ -426,7 +433,7 @@ gfc_resolve_asinh (gfc_expr *f, gfc_expr *x) f->ts = x->ts; f->value.function.name = gfc_get_string ("__asinh_%c%d", gfc_type_letter (x->ts.type), - x->ts.kind); + gfc_type_abi_kind (&x->ts)); } void @@ -434,7 +441,8 @@ gfc_resolve_atan (gfc_expr *f, gfc_expr *x) { f->ts = x->ts; f->value.function.name - = gfc_get_string ("__atan_%c%d", gfc_type_letter (x->ts.type), x->ts.kind); + = gfc_get_string ("__atan_%c%d", gfc_type_letter (x->ts.type), + gfc_type_abi_kind (&x->ts)); } void @@ -443,7 +451,7 @@ gfc_resolve_atanh (gfc_expr *f, gfc_expr *x) f->ts = x->ts; f->value.function.name = gfc_get_string ("__atanh_%c%d", gfc_type_letter (x->ts.type), - x->ts.kind); + gfc_type_abi_kind (&x->ts)); } void @@ -452,7 +460,7 @@ gfc_resolve_atan2 (gfc_expr *f, gfc_expr *x, gfc_expr *y ATTRIBUTE_UNUSED) f->ts = x->ts; f->value.function.name = gfc_get_string ("__atan2_%c%d", gfc_type_letter (x->ts.type), - x->ts.kind); + gfc_type_abi_kind (&x->ts)); } @@ -507,10 +515,10 @@ gfc_resolve_bessel_n2 (gfc_expr *f, gfc_expr *n1, gfc_expr *n2, gfc_expr *x) if (f->value.function.isym->id == GFC_ISYM_JN2) f->value.function.name = gfc_get_string (PREFIX ("bessel_jn_r%d"), - f->ts.kind); + gfc_type_abi_kind (&f->ts)); else f->value.function.name = gfc_get_string (PREFIX ("bessel_yn_r%d"), - f->ts.kind); + gfc_type_abi_kind (&f->ts)); } @@ -546,7 +554,8 @@ gfc_resolve_ceiling (gfc_expr *f, gfc_expr *a, gfc_expr *kind) ? gfc_default_integer_kind : mpz_get_si (kind->value.integer); f->value.function.name = gfc_get_string ("__ceiling_%d_%c%d", f->ts.kind, - gfc_type_letter (a->ts.type), a->ts.kind); + gfc_type_letter (a->ts.type), + gfc_type_abi_kind (&a->ts)); } @@ -618,12 +627,15 @@ gfc_resolve_cmplx (gfc_expr *f, gfc_expr *x, gfc_expr *y, gfc_expr *kind) if (y == NULL) f->value.function.name = gfc_get_string ("__cmplx0_%d_%c%d", f->ts.kind, - gfc_type_letter (x->ts.type), x->ts.kind); + gfc_type_letter (x->ts.type), + gfc_type_abi_kind (&x->ts)); else f->value.function.name = gfc_get_string ("__cmplx1_%d_%c%d_%c%d", f->ts.kind, - gfc_type_letter (x->ts.type), x->ts.kind, - gfc_type_letter (y->ts.type), y->ts.kind); + gfc_type_letter (x->ts.type), + gfc_type_abi_kind (&x->ts), + gfc_type_letter (y->ts.type), + gfc_type_abi_kind (&y->ts)); } @@ -659,8 +671,10 @@ gfc_resolve_complex (gfc_expr *f, gfc_expr *x, gfc_expr *y) f->ts.kind = kind; f->value.function.name = gfc_get_string ("__cmplx1_%d_%c%d_%c%d", f->ts.kind, - gfc_type_letter (x->ts.type), x->ts.kind, - gfc_type_letter (y->ts.type), y->ts.kind); + gfc_type_letter (x->ts.type), + gfc_type_abi_kind (&x->ts), + gfc_type_letter (y->ts.type), + gfc_type_abi_kind (&y->ts)); } @@ -677,7 +691,8 @@ gfc_resolve_cos (gfc_expr *f, gfc_expr *x) { f->ts = x->ts; f->value.function.name - = gfc_get_string ("__cos_%c%d", gfc_type_letter (x->ts.type), x->ts.kind); + = gfc_get_string ("__cos_%c%d", gfc_type_letter (x->ts.type), + gfc_type_abi_kind (&x->ts)); } @@ -686,7 +701,8 @@ gfc_resolve_cosh (gfc_expr *f, gfc_expr *x) { f->ts = x->ts; f->value.function.name - = gfc_get_string ("__cosh_%c%d", gfc_type_letter (x->ts.type), x->ts.kind); + = gfc_get_string ("__cosh_%c%d", gfc_type_letter (x->ts.type), + gfc_type_abi_kind (&x->ts)); } @@ -709,7 +725,7 @@ gfc_resolve_count (gfc_expr *f, gfc_expr *mask, gfc_expr *dim, gfc_expr *kind) resolve_mask_arg (mask); f->value.function.name - = gfc_get_string (PREFIX ("count_%d_%c"), f->ts.kind, + = gfc_get_string (PREFIX ("count_%d_%c"), gfc_type_abi_kind (&f->ts), gfc_type_letter (mask->ts.type)); } @@ -810,7 +826,8 @@ gfc_resolve_dble (gfc_expr *f, gfc_expr *a) f->ts.type = BT_REAL; f->ts.kind = gfc_default_double_kind; f->value.function.name - = gfc_get_string ("__dble_%c%d", gfc_type_letter (a->ts.type), a->ts.kind); + = gfc_get_string ("__dble_%c%d", gfc_type_letter (a->ts.type), + gfc_type_abi_kind (&a->ts)); } @@ -832,7 +849,8 @@ gfc_resolve_dim (gfc_expr *f, gfc_expr *a, gfc_expr *p) } f->value.function.name - = gfc_get_string ("__dim_%c%d", gfc_type_letter (f->ts.type), f->ts.kind); + = gfc_get_string ("__dim_%c%d", gfc_type_letter (f->ts.type), + gfc_type_abi_kind (&f->ts)); } @@ -850,7 +868,8 @@ gfc_resolve_dot_product (gfc_expr *f, gfc_expr *a, gfc_expr *b) f->ts = temp.ts; f->value.function.name = gfc_get_string (PREFIX ("dot_product_%c%d"), - gfc_type_letter (f->ts.type), f->ts.kind); + gfc_type_letter (f->ts.type), + gfc_type_abi_kind (&f->ts)); } @@ -860,7 +879,8 @@ gfc_resolve_dprod (gfc_expr *f, gfc_expr *a ATTRIBUTE_UNUSED, { f->ts.kind = gfc_default_double_kind; f->ts.type = BT_REAL; - f->value.function.name = gfc_get_string ("__dprod_r%d", f->ts.kind); + f->value.function.name = gfc_get_string ("__dprod_r%d", + gfc_type_abi_kind (&f->ts)); } @@ -951,7 +971,8 @@ gfc_resolve_exp (gfc_expr *f, gfc_expr *x) { f->ts = x->ts; f->value.function.name - = gfc_get_string ("__exp_%c%d", gfc_type_letter (x->ts.type), x->ts.kind); + = gfc_get_string ("__exp_%c%d", gfc_type_letter (x->ts.type), + gfc_type_abi_kind (&x->ts)); } @@ -1044,7 +1065,8 @@ gfc_resolve_floor (gfc_expr *f, gfc_expr *a, gfc_expr *kind) ? gfc_default_integer_kind : mpz_get_si (kind->value.integer); f->value.function.name = gfc_get_string ("__floor%d_%c%d", f->ts.kind, - gfc_type_letter (a->ts.type), a->ts.kind); + gfc_type_letter (a->ts.type), + gfc_type_abi_kind (&a->ts)); } @@ -1135,7 +1157,8 @@ void gfc_resolve_hypot (gfc_expr *f, gfc_expr *x, gfc_expr *y ATTRIBUTE_UNUSED) { f->ts = x->ts; - f->value.function.name = gfc_get_string ("__hypot_r%d", x->ts.kind); + f->value.function.name = gfc_get_string ("__hypot_r%d", + gfc_type_abi_kind (&x->ts)); } @@ -1276,27 +1299,16 @@ gfc_resolve_ior (gfc_expr *f, gfc_expr *i, gfc_expr *j) void -gfc_resolve_index_func (gfc_expr *f, gfc_actual_arglist *a) +gfc_resolve_index_func (gfc_expr *f, gfc_expr *str, + gfc_expr *sub_str ATTRIBUTE_UNUSED, gfc_expr *back, + gfc_expr *kind) { gfc_typespec ts; gfc_clear_ts (&ts); - gfc_expr *str, *back, *kind; - gfc_actual_arglist *a_sub_str, *a_back, *a_kind; - - if (f->do_not_resolve_again) - return; - - a_sub_str = a->next; - a_back = a_sub_str->next; - a_kind = a_back->next; - - str = a->expr; - back = a_back->expr; - kind = a_kind->expr; f->ts.type = BT_INTEGER; if (kind) - f->ts.kind = mpz_get_si ((kind)->value.integer); + f->ts.kind = mpz_get_si (kind->value.integer); else f->ts.kind = gfc_default_integer_kind; @@ -1311,8 +1323,6 @@ gfc_resolve_index_func (gfc_expr *f, gfc_actual_arglist *a) f->value.function.name = gfc_get_string ("__index_%d_i%d", str->ts.kind, f->ts.kind); - - f->do_not_resolve_again = 1; } @@ -1324,7 +1334,8 @@ gfc_resolve_int (gfc_expr *f, gfc_expr *a, gfc_expr *kind) ? gfc_default_integer_kind : mpz_get_si (kind->value.integer); f->value.function.name = gfc_get_string ("__int_%d_%c%d", f->ts.kind, - gfc_type_letter (a->ts.type), a->ts.kind); + gfc_type_letter (a->ts.type), + gfc_type_abi_kind (&a->ts)); } @@ -1335,7 +1346,8 @@ gfc_resolve_int2 (gfc_expr *f, gfc_expr *a) f->ts.kind = 2; f->value.function.name = gfc_get_string ("__int_%d_%c%d", f->ts.kind, - gfc_type_letter (a->ts.type), a->ts.kind); + gfc_type_letter (a->ts.type), + gfc_type_abi_kind (&a->ts)); } @@ -1346,7 +1358,8 @@ gfc_resolve_int8 (gfc_expr *f, gfc_expr *a) f->ts.kind = 8; f->value.function.name = gfc_get_string ("__int_%d_%c%d", f->ts.kind, - gfc_type_letter (a->ts.type), a->ts.kind); + gfc_type_letter (a->ts.type), + gfc_type_abi_kind (&a->ts)); } @@ -1357,7 +1370,8 @@ gfc_resolve_long (gfc_expr *f, gfc_expr *a) f->ts.kind = 4; f->value.function.name = gfc_get_string ("__int_%d_%c%d", f->ts.kind, - gfc_type_letter (a->ts.type), a->ts.kind); + gfc_type_letter (a->ts.type), + gfc_type_abi_kind (&a->ts)); } @@ -1511,7 +1525,8 @@ gfc_resolve_log (gfc_expr *f, gfc_expr *x) { f->ts = x->ts; f->value.function.name - = gfc_get_string ("__log_%c%d", gfc_type_letter (x->ts.type), x->ts.kind); + = gfc_get_string ("__log_%c%d", gfc_type_letter (x->ts.type), + gfc_type_abi_kind (&x->ts)); } @@ -1521,7 +1536,7 @@ gfc_resolve_log10 (gfc_expr *f, gfc_expr *x) f->ts = x->ts; f->value.function.name = gfc_get_string ("__log10_%c%d", gfc_type_letter (x->ts.type), - x->ts.kind); + gfc_type_abi_kind (&x->ts)); } @@ -1535,7 +1550,8 @@ gfc_resolve_logical (gfc_expr *f, gfc_expr *a, gfc_expr *kind) f->value.function.name = gfc_get_string ("__logical_%d_%c%d", f->ts.kind, - gfc_type_letter (a->ts.type), a->ts.kind); + gfc_type_letter (a->ts.type), + gfc_type_abi_kind (&a->ts)); } @@ -1582,7 +1598,7 @@ gfc_resolve_matmul (gfc_expr *f, gfc_expr *a, gfc_expr *b) else { /* b->rank == 1 and a->rank == 2 here, all other cases have - been caught in check.c. */ + been caught in check.cc. */ if (a->shape) { f->shape = gfc_get_shape (f->rank); @@ -1592,7 +1608,7 @@ gfc_resolve_matmul (gfc_expr *f, gfc_expr *a, gfc_expr *b) f->value.function.name = gfc_get_string (PREFIX ("matmul_%c%d"), gfc_type_letter (f->ts.type), - f->ts.kind); + gfc_type_abi_kind (&f->ts)); } @@ -1618,7 +1634,8 @@ gfc_resolve_minmax (const char *name, gfc_expr *f, gfc_actual_arglist *args) } f->value.function.name - = gfc_get_string (name, gfc_type_letter (f->ts.type), f->ts.kind); + = gfc_get_string (name, gfc_type_letter (f->ts.type), + gfc_type_abi_kind (&f->ts)); } @@ -1702,7 +1719,8 @@ gfc_resolve_maxloc (gfc_expr *f, gfc_expr *array, gfc_expr *dim, f->value.function.name = gfc_get_string (PREFIX ("%s%d_%d_%c%d"), name, d_num, f->ts.kind, - gfc_type_letter (array->ts.type), array->ts.kind); + gfc_type_letter (array->ts.type), + gfc_type_abi_kind (&array->ts)); if (kind) fkind = mpz_get_si (kind->value.integer); @@ -1819,7 +1837,8 @@ gfc_resolve_findloc (gfc_expr *f, gfc_expr *array, gfc_expr *value, f->value.function.name = gfc_get_string (PREFIX ("%s%d_%c%d"), name, d_num, - gfc_type_letter (array->ts.type, true), array->ts.kind); + gfc_type_letter (array->ts.type, true), + gfc_type_abi_kind (&array->ts)); /* We only have a single library function, so we need to convert here. If the function is resolved from within a convert @@ -1881,11 +1900,13 @@ gfc_resolve_maxval (gfc_expr *f, gfc_expr *array, gfc_expr *dim, if (array->ts.type != BT_CHARACTER) f->value.function.name = gfc_get_string (PREFIX ("%s_%c%d"), name, - gfc_type_letter (array->ts.type), array->ts.kind); + gfc_type_letter (array->ts.type), + gfc_type_abi_kind (&array->ts)); else f->value.function.name = gfc_get_string (PREFIX ("%s%d_%c%d"), name, f->rank != 0, - gfc_type_letter (array->ts.type), array->ts.kind); + gfc_type_letter (array->ts.type), + gfc_type_abi_kind (&array->ts)); } @@ -1939,7 +1960,7 @@ gfc_resolve_merge (gfc_expr *f, gfc_expr *tsource, f->ts = tsource->ts; f->value.function.name = gfc_get_string ("__merge_%c%d", gfc_type_letter (tsource->ts.type), - tsource->ts.kind); + gfc_type_abi_kind (&tsource->ts)); } @@ -2030,7 +2051,8 @@ gfc_resolve_minloc (gfc_expr *f, gfc_expr *array, gfc_expr *dim, f->value.function.name = gfc_get_string (PREFIX ("%s%d_%d_%c%d"), name, d_num, f->ts.kind, - gfc_type_letter (array->ts.type), array->ts.kind); + gfc_type_letter (array->ts.type), + gfc_type_abi_kind (&array->ts)); if (fkind != f->ts.kind) { @@ -2095,11 +2117,13 @@ gfc_resolve_minval (gfc_expr *f, gfc_expr *array, gfc_expr *dim, if (array->ts.type != BT_CHARACTER) f->value.function.name = gfc_get_string (PREFIX ("%s_%c%d"), name, - gfc_type_letter (array->ts.type), array->ts.kind); + gfc_type_letter (array->ts.type), + gfc_type_abi_kind (&array->ts)); else f->value.function.name = gfc_get_string (PREFIX ("%s%d_%c%d"), name, f->rank != 0, - gfc_type_letter (array->ts.type), array->ts.kind); + gfc_type_letter (array->ts.type), + gfc_type_abi_kind (&array->ts)); } @@ -2121,7 +2145,8 @@ gfc_resolve_mod (gfc_expr *f, gfc_expr *a, gfc_expr *p) } f->value.function.name - = gfc_get_string ("__mod_%c%d", gfc_type_letter (f->ts.type), f->ts.kind); + = gfc_get_string ("__mod_%c%d", gfc_type_letter (f->ts.type), + gfc_type_abi_kind (&f->ts)); } @@ -2144,7 +2169,7 @@ gfc_resolve_modulo (gfc_expr *f, gfc_expr *a, gfc_expr *p) f->value.function.name = gfc_get_string ("__modulo_%c%d", gfc_type_letter (f->ts.type), - f->ts.kind); + gfc_type_abi_kind (&f->ts)); } void @@ -2156,7 +2181,7 @@ gfc_resolve_nearest (gfc_expr *f, gfc_expr *a, gfc_expr *p) f->ts = a->ts; f->value.function.name = gfc_get_string ("__nearest_%c%d", gfc_type_letter (a->ts.type), - a->ts.kind); + gfc_type_abi_kind (&a->ts)); } void @@ -2200,7 +2225,8 @@ gfc_resolve_or (gfc_expr *f, gfc_expr *i, gfc_expr *j) } f->value.function.name - = gfc_get_string ("__or_%c%d", gfc_type_letter (i->ts.type), f->ts.kind); + = gfc_get_string ("__or_%c%d", gfc_type_letter (i->ts.type), + gfc_type_abi_kind (&f->ts)); } @@ -2278,7 +2304,8 @@ gfc_resolve_real (gfc_expr *f, gfc_expr *a, gfc_expr *kind) f->value.function.name = gfc_get_string ("__real_%d_%c%d", f->ts.kind, - gfc_type_letter (a->ts.type), a->ts.kind); + gfc_type_letter (a->ts.type), + gfc_type_abi_kind (&a->ts)); } @@ -2289,7 +2316,8 @@ gfc_resolve_realpart (gfc_expr *f, gfc_expr *a) f->ts.kind = a->ts.kind; f->value.function.name = gfc_get_string ("__real_%d_%c%d", f->ts.kind, - gfc_type_letter (a->ts.type), a->ts.kind); + gfc_type_letter (a->ts.type), + gfc_type_abi_kind (&a->ts)); } @@ -2374,7 +2402,7 @@ gfc_resolve_reshape (gfc_expr *f, gfc_expr *source, gfc_expr *shape, f->value.function.name = gfc_get_string (PREFIX ("reshape_%c%d"), gfc_type_letter (source->ts.type), - source->ts.kind); + gfc_type_abi_kind (&source->ts)); else if (source->ts.type == BT_CHARACTER) f->value.function.name = gfc_get_string (PREFIX ("reshape_char%d"), kind); @@ -2519,7 +2547,8 @@ gfc_resolve_sign (gfc_expr *f, gfc_expr *a, gfc_expr *b ATTRIBUTE_UNUSED) { f->ts = a->ts; f->value.function.name - = gfc_get_string ("__sign_%c%d", gfc_type_letter (a->ts.type), a->ts.kind); + = gfc_get_string ("__sign_%c%d", gfc_type_letter (a->ts.type), + gfc_type_abi_kind (&a->ts)); } @@ -2549,7 +2578,8 @@ gfc_resolve_sin (gfc_expr *f, gfc_expr *x) { f->ts = x->ts; f->value.function.name - = gfc_get_string ("__sin_%c%d", gfc_type_letter (x->ts.type), x->ts.kind); + = gfc_get_string ("__sin_%c%d", gfc_type_letter (x->ts.type), + gfc_type_abi_kind (&x->ts)); } @@ -2558,7 +2588,8 @@ gfc_resolve_sinh (gfc_expr *f, gfc_expr *x) { f->ts = x->ts; f->value.function.name - = gfc_get_string ("__sinh_%c%d", gfc_type_letter (x->ts.type), x->ts.kind); + = gfc_get_string ("__sinh_%c%d", gfc_type_letter (x->ts.type), + gfc_type_abi_kind (&x->ts)); } @@ -2652,7 +2683,8 @@ gfc_resolve_sqrt (gfc_expr *f, gfc_expr *x) { f->ts = x->ts; f->value.function.name - = gfc_get_string ("__sqrt_%c%d", gfc_type_letter (x->ts.type), x->ts.kind); + = gfc_get_string ("__sqrt_%c%d", gfc_type_letter (x->ts.type), + gfc_type_abi_kind (&x->ts)); } @@ -2816,7 +2848,8 @@ gfc_resolve_tan (gfc_expr *f, gfc_expr *x) { f->ts = x->ts; f->value.function.name - = gfc_get_string ("__tan_%c%d", gfc_type_letter (x->ts.type), x->ts.kind); + = gfc_get_string ("__tan_%c%d", gfc_type_letter (x->ts.type), + gfc_type_abi_kind (&x->ts)); } @@ -2825,7 +2858,8 @@ gfc_resolve_tanh (gfc_expr *f, gfc_expr *x) { f->ts = x->ts; f->value.function.name - = gfc_get_string ("__tanh_%c%d", gfc_type_letter (x->ts.type), x->ts.kind); + = gfc_get_string ("__tanh_%c%d", gfc_type_letter (x->ts.type), + gfc_type_abi_kind (&x->ts)); } @@ -3025,7 +3059,7 @@ gfc_resolve_transpose (gfc_expr *f, gfc_expr *matrix) f->value.function.name = gfc_get_string (PREFIX ("transpose_%c%d"), gfc_type_letter (matrix->ts.type), - matrix->ts.kind); + gfc_type_abi_kind (&matrix->ts)); break; case BT_INTEGER: @@ -3073,7 +3107,8 @@ gfc_resolve_trigd (gfc_expr *f, gfc_expr *x) f->ts = x->ts; f->value.function.name = gfc_get_string (PREFIX ("%s_%c%d"), f->value.function.isym->name, - gfc_type_letter (x->ts.type), x->ts.kind); + gfc_type_letter (x->ts.type), + gfc_type_abi_kind (&x->ts)); } @@ -3201,7 +3236,8 @@ gfc_resolve_xor (gfc_expr *f, gfc_expr *i, gfc_expr *j) } f->value.function.name - = gfc_get_string ("__xor_%c%d", gfc_type_letter (i->ts.type), f->ts.kind); + = gfc_get_string ("__xor_%c%d", gfc_type_letter (i->ts.type), + gfc_type_abi_kind (&f->ts)); } @@ -3222,7 +3258,7 @@ gfc_resolve_alarm_sub (gfc_code *c) /* handler can be either BT_INTEGER or BT_PROCEDURE. In all cases, the status argument is of default integer kind - (enforced in check.c) so that the function suffix is fixed. */ + (enforced in check.cc) so that the function suffix is fixed. */ if (handler->ts.type == BT_INTEGER) { if (handler->ts.kind != gfc_c_int_kind) @@ -3339,7 +3375,7 @@ gfc_resolve_random_number (gfc_code *c) const char *name; int kind; - kind = c->ext.actual->expr->ts.kind; + kind = gfc_type_abi_kind (&c->ext.actual->expr->ts); if (c->ext.actual->expr->rank == 0) name = gfc_get_string (PREFIX ("random_r%d"), kind); else diff --git a/gcc/fortran/iso-c-binding.def b/gcc/fortran/iso-c-binding.def index 50256fe..27779fa 100644 --- a/gcc/fortran/iso-c-binding.def +++ b/gcc/fortran/iso-c-binding.def @@ -1,4 +1,4 @@ -/* Copyright (C) 2006-2021 Free Software Foundation, Inc. +/* Copyright (C) 2006-2022 Free Software Foundation, Inc. This file is part of GCC. @@ -50,7 +50,7 @@ along with GCC; see the file COPYING3. If not see /* The arguments to NAMED_*CST are: -- an internal name -- the symbol name in the module, as seen by Fortran code - -- the value it has, for use in trans-types.c + -- the value it has, for use in trans-types.cc -- the standard that supports this type */ NAMED_INTCST (ISOCBINDING_INT, "c_int", gfc_c_int_kind, GFC_STD_F2003) diff --git a/gcc/fortran/iso-fortran-env.def b/gcc/fortran/iso-fortran-env.def index 69560ab..d3f7ca5 100644 --- a/gcc/fortran/iso-fortran-env.def +++ b/gcc/fortran/iso-fortran-env.def @@ -1,4 +1,4 @@ -/* Copyright (C) 2006-2021 Free Software Foundation, Inc. +/* Copyright (C) 2006-2022 Free Software Foundation, Inc. This file is part of GCC. diff --git a/gcc/fortran/lang-specs.h b/gcc/fortran/lang-specs.h index 9948728..371ee63 100644 --- a/gcc/fortran/lang-specs.h +++ b/gcc/fortran/lang-specs.h @@ -1,6 +1,6 @@ /* Contribution to the specs for the GNU Compiler Collection from GNU Fortran 95 compiler. - Copyright (C) 2002-2021 Free Software Foundation, Inc. + Copyright (C) 2002-2022 Free Software Foundation, Inc. This file is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by @@ -16,10 +16,10 @@ along with GCC; see the file COPYING3. If not see <http://www.gnu.org/licenses/>. */ -/* This is the contribution to the `default_compilers' array in gcc.c +/* This is the contribution to the `default_compilers' array in gcc.cc for the f95 language. */ -/* Identical to gcc.c (cpp_options), but omitting %(cpp_unique_options) +/* Identical to gcc.cc (cpp_options), but omitting %(cpp_unique_options) and -fpch-preprocess on -save-temps. */ #define CPP_ONLY_OPTIONS "%1 %{m*} %{f*} %{g*:%{!g0:%{g*} \ %{!fno-working-directory:-fworking-directory}}} \ diff --git a/gcc/fortran/lang.opt b/gcc/fortran/lang.opt index 6db01c7..cf39712 100644 --- a/gcc/fortran/lang.opt +++ b/gcc/fortran/lang.opt @@ -1,5 +1,5 @@ ; Options for the Fortran front end. -; Copyright (C) 2003-2021 Free Software Foundation, Inc. +; Copyright (C) 2003-2022 Free Software Foundation, Inc. ; ; This file is part of GCC. ; @@ -413,28 +413,37 @@ fblas-matmul-limit= Fortran RejectNegative Joined UInteger Var(flag_blas_matmul_limit) Init(30) -fblas-matmul-limit=<n> Size of the smallest matrix for which matmul will use BLAS. +fbuilding-libgfortran +Fortran Undocumented Var(flag_building_libgfortran) + fcheck-array-temporaries Fortran Produce a warning at runtime if a array temporary has been created for a procedure argument. fconvert= -Fortran RejectNegative Joined Enum(gfc_convert) Var(flag_convert) Init(GFC_FLAG_CONVERT_NATIVE) --fconvert=<big-endian|little-endian|native|swap> The endianness used for unformatted files. +Fortran RejectNegative Joined Enum(gfc_convert) EnumSet Var(flag_convert) Init(GFC_FLAG_CONVERT_NATIVE) +-fconvert=<big-endian|little-endian|native|swap|r16_ieee|r16_ibm> The endianness used for unformatted files. Enum Name(gfc_convert) Type(enum gfc_convert) UnknownError(Unrecognized option to endianness value: %qs) EnumValue -Enum(gfc_convert) String(big-endian) Value(GFC_FLAG_CONVERT_BIG) +Enum(gfc_convert) String(big-endian) Value(GFC_FLAG_CONVERT_BIG) Set(1) + +EnumValue +Enum(gfc_convert) String(little-endian) Value(GFC_FLAG_CONVERT_LITTLE) Set(1) + +EnumValue +Enum(gfc_convert) String(native) Value(GFC_FLAG_CONVERT_NATIVE) Set(1) EnumValue -Enum(gfc_convert) String(little-endian) Value(GFC_FLAG_CONVERT_LITTLE) +Enum(gfc_convert) String(swap) Value(GFC_FLAG_CONVERT_SWAP) Set(1) EnumValue -Enum(gfc_convert) String(native) Value(GFC_FLAG_CONVERT_NATIVE) +Enum(gfc_convert) String(r16_ieee) Value(GFC_FLAG_CONVERT_R16_IEEE) Set(2) EnumValue -Enum(gfc_convert) String(swap) Value(GFC_FLAG_CONVERT_SWAP) +Enum(gfc_convert) String(r16_ibm) Value(GFC_FLAG_CONVERT_R16_IBM) Set(2) fcray-pointer Fortran Var(flag_cray_pointer) diff --git a/gcc/fortran/libgfortran.h b/gcc/fortran/libgfortran.h index 13cefdb..064795e 100644 --- a/gcc/fortran/libgfortran.h +++ b/gcc/fortran/libgfortran.h @@ -1,5 +1,5 @@ /* Header file to the Fortran front-end and runtime library - Copyright (C) 2007-2021 Free Software Foundation, Inc. + Copyright (C) 2007-2022 Free Software Foundation, Inc. This file is part of GCC. @@ -86,14 +86,22 @@ along with GCC; see the file COPYING3. If not see #define GFC_INVALID_UNIT -3 /* Possible values for the CONVERT I/O specifier. */ -/* Keep in sync with GFC_FLAG_CONVERT_* in gcc/flags.h. */ +/* Keep in sync with GFC_FLAG_CONVERT_* in gcc/flag-types.h. */ typedef enum { GFC_CONVERT_NONE = -1, GFC_CONVERT_NATIVE = 0, GFC_CONVERT_SWAP, GFC_CONVERT_BIG, - GFC_CONVERT_LITTLE + GFC_CONVERT_LITTLE, + GFC_CONVERT_R16_IEEE = 4, + GFC_CONVERT_R16_IEEE_SWAP, + GFC_CONVERT_R16_IEEE_BIG, + GFC_CONVERT_R16_IEEE_LITTLE, + GFC_CONVERT_R16_IBM = 8, + GFC_CONVERT_R16_IBM_SWAP, + GFC_CONVERT_R16_IBM_BIG, + GFC_CONVERT_R16_IBM_LITTLE, } unit_convert; @@ -161,7 +169,7 @@ typedef enum #define GFC_STDOUT_UNIT_NUMBER 6 #define GFC_STDERR_UNIT_NUMBER 0 -/* F2003 onward. For std < F2003, error caught in array.c(gfc_match_array_ref). */ +/* F2003 onward. For std < F2003, error caught in array.cc(gfc_match_array_ref). */ #define GFC_MAX_DIMENSIONS 15 #define GFC_DTYPE_RANK_MASK 0x0F diff --git a/gcc/fortran/match.c b/gcc/fortran/match.cc index 53a575e..8edfe4a 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.cc @@ -1,5 +1,5 @@ /* Matching subroutines in all sizes, shapes and colors. - Copyright (C) 2000-2021 Free Software Foundation, Inc. + Copyright (C) 2000-2022 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. @@ -530,32 +530,6 @@ gfc_match_small_int (int *value) } -/* This function is the same as the gfc_match_small_int, except that - we're keeping the pointer to the expr. This function could just be - removed and the previously mentioned one modified, though all calls - to it would have to be modified then (and there were a number of - them). Return MATCH_ERROR if fail to extract the int; otherwise, - return the result of gfc_match_expr(). The expr (if any) that was - matched is returned in the parameter expr. */ - -match -gfc_match_small_int_expr (int *value, gfc_expr **expr) -{ - match m; - int i; - - m = gfc_match_expr (expr); - if (m != MATCH_YES) - return m; - - if (gfc_extract_int (*expr, &i, 1)) - m = MATCH_ERROR; - - *value = i; - return m; -} - - /* Matches a statement label. Uses gfc_match_small_literal_int() to do most of the work. */ @@ -599,7 +573,7 @@ cleanup: it. We also make sure the symbol does not refer to another (active) block. A matched label is pointed to by gfc_new_block. */ -match +static match gfc_match_label (void) { char name[GFC_MAX_SYMBOL_LEN + 1]; @@ -633,7 +607,7 @@ gfc_match_label (void) /* See if the current input looks like a name of some sort. Modifies the passed buffer which must be GFC_MAX_SYMBOL_LEN+1 bytes long. - Note that options.c restricts max_identifier_length to not more + Note that options.cc restricts max_identifier_length to not more than GFC_MAX_SYMBOL_LEN. */ match @@ -736,7 +710,7 @@ gfc_match_symbol (gfc_symbol **matched_symbol, int host_assoc) /* Match an intrinsic operator. Returns an INTRINSIC enum. While matching, we always find INTRINSIC_PLUS before INTRINSIC_UPLUS. We work around this - in matchexp.c. */ + in matchexp.cc. */ match gfc_match_intrinsic_op (gfc_intrinsic_op *result) @@ -2106,7 +2080,7 @@ match_derived_type_spec (gfc_typespec *ts) /* Match a Fortran 2003 type-spec (F03:R401). This is similar to - gfc_match_decl_type_spec() from decl.c, with the following exceptions: + gfc_match_decl_type_spec() from decl.cc, with the following exceptions: It only includes the intrinsic types from the Fortran 2003 standard (thus, neither BYTE nor forms like REAL*4 are allowed). Additionally, the implicit_flag is not needed, so it was removed. Derived types are @@ -5314,6 +5288,13 @@ gfc_match_common (void) goto cleanup; } + if (as->corank) + { + gfc_error ("Symbol %qs in COMMON at %C cannot be a " + "coarray", sym->name); + goto cleanup; + } + if (!gfc_add_dimension (&sym->attr, sym->name, NULL)) goto cleanup; @@ -6094,10 +6075,32 @@ match_case_selector (gfc_case **cp) m = gfc_match_init_expr (&c->high); if (m == MATCH_ERROR) goto cleanup; + if (m == MATCH_YES + && c->high->ts.type != BT_LOGICAL + && c->high->ts.type != BT_INTEGER + && c->high->ts.type != BT_CHARACTER) + { + gfc_error ("Expression in CASE selector at %L cannot be %s", + &c->high->where, gfc_typename (c->high)); + goto cleanup; + } /* MATCH_NO is fine. It's OK if nothing is there! */ } } + if (c->low && c->low->rank != 0) + { + gfc_error ("Expression in CASE selector at %L must be scalar", + &c->low->where); + goto cleanup; + } + if (c->high && c->high->rank != 0) + { + gfc_error ("Expression in CASE selector at %L must be scalar", + &c->high->where); + goto cleanup; + } + *cp = c; return MATCH_YES; @@ -6200,7 +6203,7 @@ copy_ts_from_selector_to_associate (gfc_expr *associate, gfc_expr *selector) { /* Ensure that the array reference type is set. We cannot use gfc_resolve_expr at this point, so the usable parts of - resolve.c(resolve_array_ref) are employed to do it. */ + resolve.cc(resolve_array_ref) are employed to do it. */ if (ref->u.ar.type == AR_UNKNOWN) { ref->u.ar.type = AR_ELEMENT; @@ -6360,7 +6363,8 @@ select_type_set_tmp (gfc_typespec *ts) sym = tmp->n.sym; gfc_add_type (sym, ts, NULL); - if (selector->ts.type == BT_CLASS && selector->attr.class_ok) + if (selector->ts.type == BT_CLASS && selector->attr.class_ok + && selector->ts.u.derived && CLASS_DATA (selector)) { sym->attr.pointer = CLASS_DATA (selector)->attr.class_pointer; @@ -6834,7 +6838,7 @@ syntax: gfc_error ("Syntax error in CASE specification at %C"); cleanup: - gfc_free_case_list (head); /* new_st is cleaned up in parse.c. */ + gfc_free_case_list (head); /* new_st is cleaned up in parse.cc. */ return MATCH_ERROR; } @@ -6907,7 +6911,7 @@ syntax: cleanup: if (c != NULL) - gfc_free_case_list (c); /* new_st is cleaned up in parse.c. */ + gfc_free_case_list (c); /* new_st is cleaned up in parse.cc. */ return MATCH_ERROR; } @@ -6983,7 +6987,7 @@ syntax: cleanup: if (c != NULL) - gfc_free_case_list (c); /* new_st is cleaned up in parse.c. */ + gfc_free_case_list (c); /* new_st is cleaned up in parse.cc. */ return MATCH_ERROR; } @@ -7085,7 +7089,7 @@ syntax: cleanup: if (c != NULL) - gfc_free_case_list (c); /* new_st is cleaned up in parse.c. */ + gfc_free_case_list (c); /* new_st is cleaned up in parse.cc. */ return MATCH_ERROR; } diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h index 21e94f7..495c93e 100644 --- a/gcc/fortran/match.h +++ b/gcc/fortran/match.h @@ -1,5 +1,5 @@ /* All matcher functions. - Copyright (C) 2003-2021 Free Software Foundation, Inc. + Copyright (C) 2003-2022 Free Software Foundation, Inc. Contributed by Steven Bosscher This file is part of GCC. @@ -39,7 +39,7 @@ extern gfc_access gfc_typebound_default_access; /****************** All gfc_match* routines *****************/ -/* match.c. */ +/* match.cc. */ /* Generic match subroutines. */ match gfc_match_special_char (gfc_char_t *); @@ -47,11 +47,8 @@ match gfc_match_space (void); match gfc_match_eos (void); match gfc_match_small_literal_int (int *, int *); match gfc_match_st_label (gfc_st_label **); -match gfc_match_label (void); match gfc_match_small_int (int *); -match gfc_match_small_int_expr (int *, gfc_expr **); match gfc_match_name (char *); -match gfc_match_name_C (const char **buffer); match gfc_match_symbol (gfc_symbol **, int); match gfc_match_sym_tree (gfc_symtree **, int); match gfc_match_intrinsic_op (gfc_intrinsic_op *); @@ -103,7 +100,7 @@ match gfc_match_call (void); /* We want to use this function to check for a common-block-name that can exist in a bind statement, so removed the "static" - declaration of the function in match.c. */ + declaration of the function in match.cc. */ match gfc_match_common_name (char *name); @@ -129,7 +126,7 @@ match gfc_match_forall (gfc_statement *); gfc_common_head *gfc_get_common (const char *, int); -/* openmp.c. */ +/* openmp.cc. */ /* OpenACC directive matchers. */ match gfc_match_oacc_atomic (void); @@ -232,12 +229,11 @@ match gfc_match_omp_end_critical (void); match gfc_match_omp_end_nowait (void); match gfc_match_omp_end_single (void); -/* decl.c. */ +/* decl.cc. */ match gfc_match_data (void); match gfc_match_null (gfc_expr **); match gfc_match_kind_spec (gfc_typespec *, bool); -match gfc_match_old_kind_spec (gfc_typespec *); match gfc_match_decl_type_spec (gfc_typespec *, int); match gfc_match_end (gfc_statement *); @@ -292,44 +288,38 @@ match gfc_match_target (void); match gfc_match_value (void); match gfc_match_volatile (void); -/* decl.c. */ +/* decl.cc. */ /* Fortran 2003 c interop. - TODO: some of these should be moved to another file rather than decl.c */ -void set_com_block_bind_c (gfc_common_head *, int); -bool set_verify_bind_c_sym (gfc_symbol *, int); -bool set_verify_bind_c_com_block (gfc_common_head *, int); -bool get_bind_c_idents (void); + TODO: some of these should be moved to another file rather than decl.cc */ match gfc_match_bind_c_stmt (void); -match gfc_match_suffix (gfc_symbol *, gfc_symbol **); match gfc_match_bind_c (gfc_symbol *, bool); -match gfc_get_type_attr_spec (symbol_attribute *, char*); -/* primary.c. */ +/* primary.cc. */ match gfc_match_structure_constructor (gfc_symbol *, gfc_expr **); match gfc_match_variable (gfc_expr **, int); match gfc_match_equiv_variable (gfc_expr **); match gfc_match_actual_arglist (int, gfc_actual_arglist **, bool = false); match gfc_match_literal_constant (gfc_expr **, int); -/* expr.c -- FIXME: this one should be eliminated by moving the - matcher to matchexp.c and a call to a new function in expr.c that +/* expr.cc -- FIXME: this one should be eliminated by moving the + matcher to matchexp.cc and a call to a new function in expr.cc that only makes sure the init expr. is valid. */ bool gfc_reduce_init_expr (gfc_expr *expr); match gfc_match_init_expr (gfc_expr **); -/* array.c. */ +/* array.cc. */ match gfc_match_array_spec (gfc_array_spec **, bool, bool); match gfc_match_array_ref (gfc_array_ref *, gfc_array_spec *, int, int); match gfc_match_array_constructor (gfc_expr **); -/* interface.c. */ +/* interface.cc. */ match gfc_match_abstract_interface (void); match gfc_match_generic_spec (interface_type *, char *, gfc_intrinsic_op *); match gfc_match_interface (void); match gfc_match_end_interface (void); -/* io.c. */ +/* io.cc. */ match gfc_match_format (void); match gfc_match_open (void); match gfc_match_close (void); @@ -343,11 +333,11 @@ match gfc_match_wait (void); match gfc_match_write (void); match gfc_match_print (void); -/* matchexp.c. */ +/* matchexp.cc. */ match gfc_match_defined_op_name (char *, int); match gfc_match_expr (gfc_expr **); -/* module.c. */ +/* module.cc. */ match gfc_match_use (void); match gfc_match_submodule (void); void gfc_use_modules (void); diff --git a/gcc/fortran/matchexp.c b/gcc/fortran/matchexp.cc index bae72d0e..942af78 100644 --- a/gcc/fortran/matchexp.c +++ b/gcc/fortran/matchexp.cc @@ -1,5 +1,5 @@ /* Expression parser. - Copyright (C) 2000-2021 Free Software Foundation, Inc. + Copyright (C) 2000-2022 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. @@ -122,7 +122,7 @@ next_operator (gfc_intrinsic_op t) /* Call the INTRINSIC_PARENTHESES function. This is both - used explicitly, as below, or by resolve.c to generate + used explicitly, as below, or by resolve.cc to generate temporaries. */ gfc_expr * diff --git a/gcc/fortran/mathbuiltins.def b/gcc/fortran/mathbuiltins.def index b1d51b7..615214e 100644 --- a/gcc/fortran/mathbuiltins.def +++ b/gcc/fortran/mathbuiltins.def @@ -1,4 +1,4 @@ -/* Copyright (C) 2004-2021 Free Software Foundation, Inc. +/* Copyright (C) 2004-2022 Free Software Foundation, Inc. This file is part of GCC. @@ -19,7 +19,7 @@ along with GCC; see the file COPYING3. If not see /* DEFINE_MATH_BUILTIN (CODE, NAME, ARGTYPE) NAME The name of the builtin SNAME The name of the builtin as a string - ARGTYPE The type of the arguments. See f95-lang.c + ARGTYPE The type of the arguments. See f95-lang.cc Use DEFINE_MATH_BUILTIN_C if the complex versions of the builtin are also available. */ diff --git a/gcc/fortran/misc.c b/gcc/fortran/misc.cc index e6402e8..af36347 100644 --- a/gcc/fortran/misc.c +++ b/gcc/fortran/misc.cc @@ -1,5 +1,5 @@ /* Miscellaneous stuff that doesn't fit anywhere else. - Copyright (C) 2000-2021 Free Software Foundation, Inc. + Copyright (C) 2000-2022 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. @@ -284,7 +284,7 @@ gfc_dummy_typename (gfc_typespec *ts) { if (ts->kind == gfc_default_character_kind) sprintf(buffer, "CHARACTER(*)"); - else if (ts->kind < 10) + else if (ts->kind >= 0 && ts->kind < 10) sprintf(buffer, "CHARACTER(*,%d)", ts->kind); else sprintf(buffer, "CHARACTER(*,?)"); diff --git a/gcc/fortran/module.c b/gcc/fortran/module.cc index 7b98ba5..281b1b1 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.cc @@ -1,6 +1,6 @@ /* Handle modules, which amounts to loading and saving symbols and their attendant structures. - Copyright (C) 2000-2021 Free Software Foundation, Inc. + Copyright (C) 2000-2022 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. @@ -1079,7 +1079,7 @@ free_true_name (true_name *t) /* Module reading and writing. */ -/* The following are versions similar to the ones in scanner.c, but +/* The following are versions similar to the ones in scanner.cc, but for dealing with compressed module files. */ static gzFile diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.cc index dcf22ac..19142c4 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.cc @@ -1,5 +1,5 @@ /* OpenMP directive matching and resolving. - Copyright (C) 2005-2021 Free Software Foundation, Inc. + Copyright (C) 2005-2022 Free Software Foundation, Inc. Contributed by Jakub Jelinek This file is part of GCC. @@ -85,7 +85,8 @@ gfc_free_omp_clauses (gfc_omp_clauses *c) gfc_free_expr (c->chunk_size); gfc_free_expr (c->safelen_expr); gfc_free_expr (c->simdlen_expr); - gfc_free_expr (c->num_teams); + gfc_free_expr (c->num_teams_lower); + gfc_free_expr (c->num_teams_upper); gfc_free_expr (c->device); gfc_free_expr (c->thread_limit); gfc_free_expr (c->dist_chunk_size); @@ -911,17 +912,21 @@ enum omp_mask1 OMP_CLAUSE_MEMORDER, /* OpenMP 5.0. */ OMP_CLAUSE_DETACH, /* OpenMP 5.0. */ OMP_CLAUSE_AFFINITY, /* OpenMP 5.0. */ + OMP_CLAUSE_ALLOCATE, /* OpenMP 5.0. */ OMP_CLAUSE_BIND, /* OpenMP 5.0. */ OMP_CLAUSE_FILTER, /* OpenMP 5.1. */ OMP_CLAUSE_AT, /* OpenMP 5.1. */ OMP_CLAUSE_MESSAGE, /* OpenMP 5.1. */ OMP_CLAUSE_SEVERITY, /* OpenMP 5.1. */ + OMP_CLAUSE_COMPARE, /* OpenMP 5.1. */ + OMP_CLAUSE_FAIL, /* OpenMP 5.1. */ + OMP_CLAUSE_WEAK, /* OpenMP 5.1. */ OMP_CLAUSE_NOWAIT, /* This must come last. */ OMP_MASK1_LAST }; -/* OpenACC 2.0+ specific clauses. */ +/* More OpenMP clauses and OpenACC 2.0+ specific clauses. */ enum omp_mask2 { OMP_CLAUSE_ASYNC, @@ -950,6 +955,7 @@ enum omp_mask2 OMP_CLAUSE_FINALIZE, OMP_CLAUSE_ATTACH, OMP_CLAUSE_NOHOST, + OMP_CLAUSE_HAS_DEVICE_ADDR, /* OpenMP 5.1 */ /* This must come last. */ OMP_MASK2_LAST }; @@ -1118,7 +1124,7 @@ gfc_match_iterator (gfc_namespace **ns, bool permit_var) if (last) last->tlink = sym; else - (*ns)->proc_name = sym; + (*ns)->omp_affinity_iterators = sym; last = sym; sym->declared_at = prev_loc; sym->ts = ts; @@ -1449,7 +1455,8 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, *cp = NULL; while (1) { - if ((first || gfc_match_char (',') != MATCH_YES) + match m = MATCH_NO; + if ((first || (m = gfc_match_char (',')) != MATCH_YES) && (needs_space && gfc_match_space () != MATCH_YES)) break; needs_space = false; @@ -1459,7 +1466,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, gfc_omp_namelist **head; old_loc = gfc_current_locus; char pc = gfc_peek_ascii_char (); - match m; + if (pc == '\n' && m == MATCH_YES) + { + gfc_error ("Clause expected at %C after trailing comma"); + goto error; + } switch (pc) { case 'a': @@ -1540,6 +1551,40 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, } continue; } + if ((mask & OMP_CLAUSE_ALLOCATE) + && gfc_match ("allocate ( ") == MATCH_YES) + { + gfc_expr *allocator = NULL; + old_loc = gfc_current_locus; + m = gfc_match_expr (&allocator); + if (m == MATCH_YES && gfc_match (" : ") != MATCH_YES) + { + /* If no ":" then there is no allocator, we backtrack + and read the variable list. */ + gfc_free_expr (allocator); + allocator = NULL; + gfc_current_locus = old_loc; + } + + gfc_omp_namelist **head = NULL; + m = gfc_match_omp_variable_list ("", &c->lists[OMP_LIST_ALLOCATE], + true, NULL, &head); + + if (m != MATCH_YES) + { + gfc_free_expr (allocator); + gfc_error ("Expected variable list at %C"); + goto error; + } + + for (gfc_omp_namelist *n = *head; n; n = n->next) + if (allocator) + n->expr = gfc_copy_expr (allocator); + else + n->expr = NULL; + gfc_free_expr (allocator); + continue; + } if ((mask & OMP_CLAUSE_AT) && (m = gfc_match_dupl_check (c->at == OMP_AT_UNSET, "at", true)) != MATCH_NO) @@ -1653,6 +1698,16 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, continue; } } + if ((mask & OMP_CLAUSE_COMPARE) + && (m = gfc_match_dupl_check (!c->compare, "compare")) + != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + c->compare = true; + needs_space = true; + continue; + } if ((mask & OMP_CLAUSE_COPY) && gfc_match ("copy ( ") == MATCH_YES && gfc_match_omp_map_clause (&c->lists[OMP_LIST_MAP], @@ -2008,6 +2063,27 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, } break; case 'f': + if ((mask & OMP_CLAUSE_FAIL) + && (m = gfc_match_dupl_check (c->fail == OMP_MEMORDER_UNSET, + "fail", true)) != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + if (gfc_match ("seq_cst") == MATCH_YES) + c->fail = OMP_MEMORDER_SEQ_CST; + else if (gfc_match ("acquire") == MATCH_YES) + c->fail = OMP_MEMORDER_ACQUIRE; + else if (gfc_match ("relaxed") == MATCH_YES) + c->fail = OMP_MEMORDER_RELAXED; + else + { + gfc_error ("Expected SEQ_CST, ACQUIRE or RELAXED at %C"); + break; + } + if (gfc_match (" )") != MATCH_YES) + goto error; + continue; + } if ((mask & OMP_CLAUSE_FILTER) && (m = gfc_match_dupl_check (!c->filter, "filter", true, &c->filter)) != MATCH_NO) @@ -2076,6 +2152,11 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, } break; case 'h': + if ((mask & OMP_CLAUSE_HAS_DEVICE_ADDR) + && gfc_match_omp_variable_list + ("has_device_addr (", &c->lists[OMP_LIST_HAS_DEVICE_ADDR], + false, NULL, NULL, true) == MATCH_YES) + continue; if ((mask & OMP_CLAUSE_HINT) && (m = gfc_match_dupl_check (!c->hint, "hint", true, &c->hint)) != MATCH_NO) @@ -2420,11 +2501,22 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, continue; } if ((mask & OMP_CLAUSE_NUM_TEAMS) - && (m = gfc_match_dupl_check (!c->num_teams, "num_teams", true, - &c->num_teams)) != MATCH_NO) + && (m = gfc_match_dupl_check (!c->num_teams_upper, "num_teams", + true)) != MATCH_NO) { if (m == MATCH_ERROR) goto error; + if (gfc_match ("%e ", &c->num_teams_upper) != MATCH_YES) + goto error; + if (gfc_peek_ascii_char () == ':') + { + c->num_teams_lower = c->num_teams_upper; + c->num_teams_upper = NULL; + if (gfc_match (": %e ", &c->num_teams_upper) != MATCH_YES) + goto error; + } + if (gfc_match (") ") != MATCH_YES) + goto error; continue; } if ((mask & OMP_CLAUSE_NUM_THREADS) @@ -2837,8 +2929,8 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, continue; if ((mask & OMP_CLAUSE_USE_DEVICE_ADDR) && gfc_match_omp_variable_list - ("use_device_addr (", - &c->lists[OMP_LIST_USE_DEVICE_ADDR], false) == MATCH_YES) + ("use_device_addr (", &c->lists[OMP_LIST_USE_DEVICE_ADDR], + false, NULL, NULL, true) == MATCH_YES) continue; break; case 'v': @@ -2891,6 +2983,16 @@ gfc_match_omp_clauses (gfc_omp_clauses **cp, const omp_mask mask, } continue; } + if ((mask & OMP_CLAUSE_WEAK) + && (m = gfc_match_dupl_check (!c->weak, "weak")) + != MATCH_NO) + { + if (m == MATCH_ERROR) + goto error; + c->weak = true; + needs_space = true; + continue; + } if ((mask & OMP_CLAUSE_WORKER) && (m = gfc_match_dupl_check (!c->worker, "worker")) != MATCH_NO) { @@ -3511,7 +3613,7 @@ cleanup: (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_SHARED | OMP_CLAUSE_COPYIN | OMP_CLAUSE_REDUCTION \ | OMP_CLAUSE_IF | OMP_CLAUSE_NUM_THREADS | OMP_CLAUSE_DEFAULT \ - | OMP_CLAUSE_PROC_BIND) + | OMP_CLAUSE_PROC_BIND | OMP_CLAUSE_ALLOCATE) #define OMP_DECLARE_SIMD_CLAUSES \ (omp_mask (OMP_CLAUSE_SIMDLEN) | OMP_CLAUSE_LINEAR \ | OMP_CLAUSE_UNIFORM | OMP_CLAUSE_ALIGNED | OMP_CLAUSE_INBRANCH \ @@ -3520,15 +3622,16 @@ cleanup: (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION \ | OMP_CLAUSE_SCHEDULE | OMP_CLAUSE_ORDERED | OMP_CLAUSE_COLLAPSE \ - | OMP_CLAUSE_LINEAR | OMP_CLAUSE_ORDER) + | OMP_CLAUSE_LINEAR | OMP_CLAUSE_ORDER | OMP_CLAUSE_ALLOCATE) #define OMP_LOOP_CLAUSES \ (omp_mask (OMP_CLAUSE_BIND) | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_ORDER \ | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION) + #define OMP_SCOPE_CLAUSES \ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_REDUCTION) #define OMP_SECTIONS_CLAUSES \ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ - | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION) + | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_ALLOCATE) #define OMP_SIMD_CLAUSES \ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_LASTPRIVATE \ | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_SAFELEN \ @@ -3539,19 +3642,23 @@ cleanup: | OMP_CLAUSE_SHARED | OMP_CLAUSE_IF | OMP_CLAUSE_DEFAULT \ | OMP_CLAUSE_UNTIED | OMP_CLAUSE_FINAL | OMP_CLAUSE_MERGEABLE \ | OMP_CLAUSE_DEPEND | OMP_CLAUSE_PRIORITY | OMP_CLAUSE_IN_REDUCTION \ - | OMP_CLAUSE_DETACH | OMP_CLAUSE_AFFINITY) + | OMP_CLAUSE_DETACH | OMP_CLAUSE_AFFINITY | OMP_CLAUSE_ALLOCATE) #define OMP_TASKLOOP_CLAUSES \ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_SHARED | OMP_CLAUSE_IF \ | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_UNTIED | OMP_CLAUSE_FINAL \ | OMP_CLAUSE_MERGEABLE | OMP_CLAUSE_PRIORITY | OMP_CLAUSE_GRAINSIZE \ | OMP_CLAUSE_NUM_TASKS | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_NOGROUP \ - | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_IN_REDUCTION) + | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_IN_REDUCTION | OMP_CLAUSE_ALLOCATE) +#define OMP_TASKGROUP_CLAUSES \ + (omp_mask (OMP_CLAUSE_TASK_REDUCTION) | OMP_CLAUSE_ALLOCATE) #define OMP_TARGET_CLAUSES \ (omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF \ | OMP_CLAUSE_DEPEND | OMP_CLAUSE_NOWAIT | OMP_CLAUSE_PRIVATE \ | OMP_CLAUSE_FIRSTPRIVATE | OMP_CLAUSE_DEFAULTMAP \ - | OMP_CLAUSE_IS_DEVICE_PTR | OMP_CLAUSE_IN_REDUCTION) + | OMP_CLAUSE_IS_DEVICE_PTR | OMP_CLAUSE_IN_REDUCTION \ + | OMP_CLAUSE_THREAD_LIMIT | OMP_CLAUSE_ALLOCATE \ + | OMP_CLAUSE_HAS_DEVICE_ADDR) #define OMP_TARGET_DATA_CLAUSES \ (omp_mask (OMP_CLAUSE_DEVICE) | OMP_CLAUSE_MAP | OMP_CLAUSE_IF \ | OMP_CLAUSE_USE_DEVICE_PTR | OMP_CLAUSE_USE_DEVICE_ADDR) @@ -3567,20 +3674,22 @@ cleanup: #define OMP_TEAMS_CLAUSES \ (omp_mask (OMP_CLAUSE_NUM_TEAMS) | OMP_CLAUSE_THREAD_LIMIT \ | OMP_CLAUSE_DEFAULT | OMP_CLAUSE_PRIVATE | OMP_CLAUSE_FIRSTPRIVATE \ - | OMP_CLAUSE_SHARED | OMP_CLAUSE_REDUCTION) + | OMP_CLAUSE_SHARED | OMP_CLAUSE_REDUCTION | OMP_CLAUSE_ALLOCATE) #define OMP_DISTRIBUTE_CLAUSES \ (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ | OMP_CLAUSE_LASTPRIVATE | OMP_CLAUSE_COLLAPSE | OMP_CLAUSE_DIST_SCHEDULE \ - | OMP_CLAUSE_ORDER) + | OMP_CLAUSE_ORDER | OMP_CLAUSE_ALLOCATE) #define OMP_SINGLE_CLAUSES \ - (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE) + (omp_mask (OMP_CLAUSE_PRIVATE) | OMP_CLAUSE_FIRSTPRIVATE \ + | OMP_CLAUSE_ALLOCATE) #define OMP_ORDERED_CLAUSES \ (omp_mask (OMP_CLAUSE_THREADS) | OMP_CLAUSE_SIMD) #define OMP_DECLARE_TARGET_CLAUSES \ (omp_mask (OMP_CLAUSE_TO) | OMP_CLAUSE_LINK | OMP_CLAUSE_DEVICE_TYPE) #define OMP_ATOMIC_CLAUSES \ (omp_mask (OMP_CLAUSE_ATOMIC) | OMP_CLAUSE_CAPTURE | OMP_CLAUSE_HINT \ - | OMP_CLAUSE_MEMORDER) + | OMP_CLAUSE_MEMORDER | OMP_CLAUSE_COMPARE | OMP_CLAUSE_FAIL \ + | OMP_CLAUSE_WEAK) #define OMP_MASKED_CLAUSES \ (omp_mask (OMP_CLAUSE_FILTER)) #define OMP_ERROR_CLAUSES \ @@ -5310,7 +5419,8 @@ gfc_match_omp_requires (void) else goto error; - if (requires_clause & ~OMP_REQ_ATOMIC_MEM_ORDER_MASK) + if (requires_clause & ~(OMP_REQ_ATOMIC_MEM_ORDER_MASK + | OMP_REQ_DYNAMIC_ALLOCATORS)) gfc_error_now ("Sorry, %qs clause at %L on REQUIRES directive is not " "yet supported", clause, &old_loc); if (!gfc_omp_requires_add_clause (requires_clause, clause, &old_loc, NULL)) @@ -5705,6 +5815,7 @@ gfc_match_omp_ordered_depend (void) - capture - memory-order-clause: seq_cst | acq_rel | release | acquire | relaxed - hint(hint-expr) + - OpenMP 5.1: compare | fail (seq_cst | acquire | relaxed ) | weak */ match @@ -5716,12 +5827,25 @@ gfc_match_omp_atomic (void) if (gfc_match_omp_clauses (&c, OMP_ATOMIC_CLAUSES, true, true) != MATCH_YES) return MATCH_ERROR; - if (c->capture && c->atomic_op != GFC_OMP_ATOMIC_UNSET) - gfc_error ("OMP ATOMIC at %L with multiple atomic clauses", &loc); - if (c->atomic_op == GFC_OMP_ATOMIC_UNSET) c->atomic_op = GFC_OMP_ATOMIC_UPDATE; + if (c->capture && c->atomic_op != GFC_OMP_ATOMIC_UPDATE) + gfc_error ("!$OMP ATOMIC at %L with %s clause is incompatible with " + "READ or WRITE", &loc, "CAPTURE"); + if (c->compare && c->atomic_op != GFC_OMP_ATOMIC_UPDATE) + gfc_error ("!$OMP ATOMIC at %L with %s clause is incompatible with " + "READ or WRITE", &loc, "COMPARE"); + if (c->fail != OMP_MEMORDER_UNSET && c->atomic_op != GFC_OMP_ATOMIC_UPDATE) + gfc_error ("!$OMP ATOMIC at %L with %s clause is incompatible with " + "READ or WRITE", &loc, "FAIL"); + if (c->weak && !c->compare) + { + gfc_error ("!$OMP ATOMIC at %L with %s clause requires %s clause", &loc, + "WEAK", "COMPARE"); + c->weak = false; + } + if (c->memorder == OMP_MEMORDER_UNSET) { gfc_namespace *prog_unit = gfc_current_ns; @@ -5752,32 +5876,24 @@ gfc_match_omp_atomic (void) switch (c->atomic_op) { case GFC_OMP_ATOMIC_READ: - if (c->memorder == OMP_MEMORDER_ACQ_REL - || c->memorder == OMP_MEMORDER_RELEASE) + if (c->memorder == OMP_MEMORDER_RELEASE) { gfc_error ("!$OMP ATOMIC READ at %L incompatible with " - "ACQ_REL or RELEASE clauses", &loc); + "RELEASE clause", &loc); c->memorder = OMP_MEMORDER_SEQ_CST; } + else if (c->memorder == OMP_MEMORDER_ACQ_REL) + c->memorder = OMP_MEMORDER_ACQUIRE; break; case GFC_OMP_ATOMIC_WRITE: - if (c->memorder == OMP_MEMORDER_ACQ_REL - || c->memorder == OMP_MEMORDER_ACQUIRE) + if (c->memorder == OMP_MEMORDER_ACQUIRE) { gfc_error ("!$OMP ATOMIC WRITE at %L incompatible with " - "ACQ_REL or ACQUIRE clauses", &loc); - c->memorder = OMP_MEMORDER_SEQ_CST; - } - break; - case GFC_OMP_ATOMIC_UPDATE: - if ((c->memorder == OMP_MEMORDER_ACQ_REL - || c->memorder == OMP_MEMORDER_ACQUIRE) - && !c->capture) - { - gfc_error ("!$OMP ATOMIC UPDATE at %L incompatible with " - "ACQ_REL or ACQUIRE clauses", &loc); + "ACQUIRE clause", &loc); c->memorder = OMP_MEMORDER_SEQ_CST; } + else if (c->memorder == OMP_MEMORDER_ACQ_REL) + c->memorder = OMP_MEMORDER_RELEASE; break; default: break; @@ -5836,7 +5952,7 @@ gfc_match_omp_barrier (void) match gfc_match_omp_taskgroup (void) { - return match_omp (EXEC_OMP_TASKGROUP, OMP_CLAUSE_TASK_REDUCTION); + return match_omp (EXEC_OMP_TASKGROUP, OMP_TASKGROUP_CLAUSES); } @@ -6174,7 +6290,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, "IN_REDUCTION", "TASK_REDUCTION", "DEVICE_RESIDENT", "LINK", "USE_DEVICE", "CACHE", "IS_DEVICE_PTR", "USE_DEVICE_PTR", "USE_DEVICE_ADDR", - "NONTEMPORAL" }; + "NONTEMPORAL", "ALLOCATE", "HAS_DEVICE_ADDR" }; STATIC_ASSERT (ARRAY_SIZE (clause_names) == OMP_LIST_NUM); if (omp_clauses == NULL) @@ -6220,6 +6336,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, case EXEC_OMP_PARALLEL: case EXEC_OMP_PARALLEL_DO: + case EXEC_OMP_PARALLEL_LOOP: case EXEC_OMP_PARALLEL_MASKED: case EXEC_OMP_PARALLEL_MASTER: case EXEC_OMP_PARALLEL_SECTIONS: @@ -6273,6 +6390,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, case EXEC_OMP_TARGET: case EXEC_OMP_TARGET_TEAMS: case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE: + case EXEC_OMP_TARGET_TEAMS_LOOP: ok = ifc == OMP_IF_TARGET; break; @@ -6300,6 +6418,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, case EXEC_OMP_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO: case EXEC_OMP_TARGET_PARALLEL: case EXEC_OMP_TARGET_PARALLEL_DO: + case EXEC_OMP_TARGET_PARALLEL_LOOP: ok = ifc == OMP_IF_TARGET || ifc == OMP_IF_PARALLEL; break; @@ -6457,7 +6576,8 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, && list != OMP_LIST_REDUCTION_INSCAN && list != OMP_LIST_REDUCTION_TASK && list != OMP_LIST_IN_REDUCTION - && list != OMP_LIST_TASK_REDUCTION) + && list != OMP_LIST_TASK_REDUCTION + && list != OMP_LIST_ALLOCATE) for (n = omp_clauses->lists[list]; n; n = n->next) { bool component_ref_p = false; @@ -6526,6 +6646,78 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, n->sym->mark = 1; } + if (omp_clauses->lists[OMP_LIST_ALLOCATE]) + { + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next) + if (n->expr && (n->expr->ts.type != BT_INTEGER + || n->expr->ts.kind != gfc_c_intptr_kind)) + { + gfc_error ("Expected integer expression of the " + "'omp_allocator_handle_kind' kind at %L", + &n->expr->where); + break; + } + + /* Check for 2 things here. + 1. There is no duplication of variable in allocate clause. + 2. Variable in allocate clause are also present in some + privatization clase (non-composite case). */ + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next) + n->sym->mark = 0; + + gfc_omp_namelist *prev = NULL; + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n;) + { + if (n->sym->mark == 1) + { + gfc_warning (0, "%qs appears more than once in %<allocate%> " + "clauses at %L" , n->sym->name, &n->where); + /* We have already seen this variable so it is a duplicate. + Remove it. */ + if (prev != NULL && prev->next == n) + { + prev->next = n->next; + n->next = NULL; + gfc_free_omp_namelist (n, 0); + n = prev->next; + } + continue; + } + n->sym->mark = 1; + prev = n; + n = n->next; + } + + /* Non-composite constructs. */ + if (code && code->op < EXEC_OMP_DO_SIMD) + { + for (list = 0; list < OMP_LIST_NUM; list++) + switch (list) + { + case OMP_LIST_PRIVATE: + case OMP_LIST_FIRSTPRIVATE: + case OMP_LIST_LASTPRIVATE: + case OMP_LIST_REDUCTION: + case OMP_LIST_REDUCTION_INSCAN: + case OMP_LIST_REDUCTION_TASK: + case OMP_LIST_IN_REDUCTION: + case OMP_LIST_TASK_REDUCTION: + case OMP_LIST_LINEAR: + for (n = omp_clauses->lists[list]; n; n = n->next) + n->sym->mark = 0; + break; + default: + break; + } + + for (n = omp_clauses->lists[OMP_LIST_ALLOCATE]; n; n = n->next) + if (n->sym->mark == 1) + gfc_error ("%qs specified in 'allocate' clause at %L but not " + "in an explicit privatization clause", + n->sym->name, &n->where); + } + } + /* OpenACC reductions. */ if (openacc) { @@ -6647,8 +6839,8 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, && n->u2.ns && !n->u2.ns->resolved) { n->u2.ns->resolved = 1; - for (gfc_symbol *sym = n->u2.ns->proc_name; sym; - sym = sym->tlink) + for (gfc_symbol *sym = n->u2.ns->omp_affinity_iterators; + sym; sym = sym->tlink) { gfc_constructor *c; c = gfc_constructor_first (sym->value->value.constructor); @@ -6947,6 +7139,7 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, n->sym->name, name, &n->where); } break; + case OMP_LIST_HAS_DEVICE_ADDR: case OMP_LIST_USE_DEVICE_PTR: case OMP_LIST_USE_DEVICE_ADDR: /* FIXME: Handle OMP_LIST_USE_DEVICE_PTR. */ @@ -7293,8 +7486,18 @@ resolve_omp_clauses (gfc_code *code, gfc_omp_clauses *omp_clauses, resolve_positive_int_expr (omp_clauses->safelen_expr, "SAFELEN"); if (omp_clauses->simdlen_expr) resolve_positive_int_expr (omp_clauses->simdlen_expr, "SIMDLEN"); - if (omp_clauses->num_teams) - resolve_positive_int_expr (omp_clauses->num_teams, "NUM_TEAMS"); + if (omp_clauses->num_teams_lower) + resolve_positive_int_expr (omp_clauses->num_teams_lower, "NUM_TEAMS"); + if (omp_clauses->num_teams_upper) + resolve_positive_int_expr (omp_clauses->num_teams_upper, "NUM_TEAMS"); + if (omp_clauses->num_teams_lower + && omp_clauses->num_teams_lower->expr_type == EXPR_CONSTANT + && omp_clauses->num_teams_upper->expr_type == EXPR_CONSTANT + && mpz_cmp (omp_clauses->num_teams_lower->value.integer, + omp_clauses->num_teams_upper->value.integer) > 0) + gfc_warning (0, "NUM_TEAMS lower bound at %L larger than upper bound at %L", + &omp_clauses->num_teams_lower->where, + &omp_clauses->num_teams_upper->where); if (omp_clauses->device) resolve_nonnegative_int_expr (omp_clauses->device, "DEVICE"); if (omp_clauses->filter) @@ -7425,20 +7628,24 @@ expr_references_sym (gfc_expr *e, gfc_symbol *s, gfc_expr *se) /* If EXPR is a conversion function that widens the type - if WIDENING is true or narrows the type if WIDENING is false, + if WIDENING is true or narrows the type if NARROW is true, return the inner expression, otherwise return NULL. */ static gfc_expr * -is_conversion (gfc_expr *expr, bool widening) +is_conversion (gfc_expr *expr, bool narrowing, bool widening) { gfc_typespec *ts1, *ts2; if (expr->expr_type != EXPR_FUNCTION || expr->value.function.isym == NULL || expr->value.function.esym != NULL - || expr->value.function.isym->id != GFC_ISYM_CONVERSION) + || expr->value.function.isym->id != GFC_ISYM_CONVERSION + || (!narrowing && !widening)) return NULL; + if (narrowing && widening) + return expr->value.function.actual->expr; + if (widening) { ts1 = &expr->ts; @@ -7457,163 +7664,330 @@ is_conversion (gfc_expr *expr, bool widening) return NULL; } +static bool +is_scalar_intrinsic_expr (gfc_expr *expr, bool must_be_var, bool conv_ok) +{ + if (must_be_var + && (expr->expr_type != EXPR_VARIABLE || !expr->symtree)) + { + if (!conv_ok) + return false; + gfc_expr *conv = is_conversion (expr, true, true); + if (!conv) + return false; + if (conv->expr_type != EXPR_VARIABLE || !conv->symtree) + return false; + } + return (expr->rank == 0 + && !gfc_is_coindexed (expr) + && (expr->ts.type == BT_INTEGER + || expr->ts.type == BT_REAL + || expr->ts.type == BT_COMPLEX + || expr->ts.type == BT_LOGICAL)); +} static void resolve_omp_atomic (gfc_code *code) { gfc_code *atomic_code = code->block; gfc_symbol *var; - gfc_expr *expr2, *expr2_tmp; + gfc_expr *stmt_expr2, *capt_expr2; gfc_omp_atomic_op aop = (gfc_omp_atomic_op) (atomic_code->ext.omp_clauses->atomic_op & GFC_OMP_ATOMIC_MASK); + gfc_code *stmt = NULL, *capture_stmt = NULL, *tailing_stmt = NULL; + gfc_expr *comp_cond = NULL; + locus *loc = NULL; code = code->block->next; - /* resolve_blocks asserts this is initially EXEC_ASSIGN. + /* resolve_blocks asserts this is initially EXEC_ASSIGN or EXEC_IF If it changed to EXEC_NOP, assume an error has been emitted already. */ if (code->op == EXEC_NOP) return; - if (code->op != EXEC_ASSIGN) + + if (atomic_code->ext.omp_clauses->compare + && atomic_code->ext.omp_clauses->capture) { - unexpected: - gfc_error ("unexpected !$OMP ATOMIC expression at %L", &code->loc); - return; + /* Must be either "if (x == e) then; x = d; else; v = x; end if" + or "v = expr" followed/preceded by + "if (x == e) then; x = d; end if" or "if (x == e) x = d". */ + gfc_code *next = code; + if (code->op == EXEC_ASSIGN) + { + capture_stmt = code; + next = code->next; + } + if (next->op == EXEC_IF + && next->block + && next->block->op == EXEC_IF + && next->block->next + && next->block->next->op == EXEC_ASSIGN) + { + comp_cond = next->block->expr1; + stmt = next->block->next; + if (stmt->next) + { + loc = &stmt->loc; + goto unexpected; + } + } + else if (capture_stmt) + { + gfc_error ("Expected IF at %L in atomic compare capture", + &next->loc); + return; + } + if (stmt && !capture_stmt && next->block->block) + { + if (next->block->block->expr1) + { + gfc_error ("Expected ELSE at %L in atomic compare capture", + &next->block->block->expr1->where); + return; + } + if (!code->block->block->next + || code->block->block->next->op != EXEC_ASSIGN) + { + loc = (code->block->block->next ? &code->block->block->next->loc + : &code->block->block->loc); + goto unexpected; + } + capture_stmt = code->block->block->next; + if (capture_stmt->next) + { + loc = &capture_stmt->next->loc; + goto unexpected; + } + } + if (stmt && !capture_stmt && next->next->op == EXEC_ASSIGN) + capture_stmt = next->next; + else if (!capture_stmt) + { + loc = &code->loc; + goto unexpected; + } + } + else if (atomic_code->ext.omp_clauses->compare) + { + /* Must be: "if (x == e) then; x = d; end if" or "if (x == e) x = d". */ + if (code->op == EXEC_IF + && code->block + && code->block->op == EXEC_IF + && code->block->next + && code->block->next->op == EXEC_ASSIGN) + { + comp_cond = code->block->expr1; + stmt = code->block->next; + if (stmt->next || code->block->block) + { + loc = stmt->next ? &stmt->next->loc : &code->block->block->loc; + goto unexpected; + } + } + else + { + loc = &code->loc; + goto unexpected; + } } - if (!atomic_code->ext.omp_clauses->capture) + else if (atomic_code->ext.omp_clauses->capture) { - if (code->next != NULL) + /* Must be: "v = x" followed/preceded by "x = ...". */ + if (code->op != EXEC_ASSIGN) goto unexpected; + if (code->next->op != EXEC_ASSIGN) + { + loc = &code->next->loc; + goto unexpected; + } + gfc_expr *expr2, *expr2_next; + expr2 = is_conversion (code->expr2, true, true); + if (expr2 == NULL) + expr2 = code->expr2; + expr2_next = is_conversion (code->next->expr2, true, true); + if (expr2_next == NULL) + expr2_next = code->next->expr2; + if (code->expr1->expr_type == EXPR_VARIABLE + && code->next->expr1->expr_type == EXPR_VARIABLE + && expr2->expr_type == EXPR_VARIABLE + && expr2_next->expr_type == EXPR_VARIABLE) + { + if (code->expr1->symtree->n.sym == expr2_next->symtree->n.sym) + { + stmt = code; + capture_stmt = code->next; + } + else + { + capture_stmt = code; + stmt = code->next; + } + } + else if (expr2->expr_type == EXPR_VARIABLE) + { + capture_stmt = code; + stmt = code->next; + } + else + { + stmt = code; + capture_stmt = code->next; + } + /* Shall be NULL but can happen for invalid code. */ + tailing_stmt = code->next->next; } else { - if (code->next == NULL) + /* x = ... */ + stmt = code; + if (!atomic_code->ext.omp_clauses->compare && stmt->op != EXEC_ASSIGN) goto unexpected; - if (code->next->op == EXEC_NOP) + /* Shall be NULL but can happen for invalid code. */ + tailing_stmt = code->next; + } + + if (comp_cond) + { + if (comp_cond->expr_type != EXPR_OP + || (comp_cond->value.op.op != INTRINSIC_EQ + && comp_cond->value.op.op != INTRINSIC_EQ_OS + && comp_cond->value.op.op != INTRINSIC_EQV)) + { + gfc_error ("Expected %<==%>, %<.EQ.%> or %<.EQV.%> atomic comparison " + "expression at %L", &comp_cond->where); + return; + } + if (!is_scalar_intrinsic_expr (comp_cond->value.op.op1, true, true)) + { + gfc_error ("Expected scalar intrinsic variable at %L in atomic " + "comparison", &comp_cond->value.op.op1->where); + return; + } + if (!gfc_resolve_expr (comp_cond->value.op.op2)) return; - if (code->next->op != EXEC_ASSIGN || code->next->next) + if (!is_scalar_intrinsic_expr (comp_cond->value.op.op2, false, false)) { - code = code->next; - goto unexpected; + gfc_error ("Expected scalar intrinsic expression at %L in atomic " + "comparison", &comp_cond->value.op.op1->where); + return; } } - if (code->expr1->expr_type != EXPR_VARIABLE - || code->expr1->symtree == NULL - || code->expr1->rank != 0 - || (code->expr1->ts.type != BT_INTEGER - && code->expr1->ts.type != BT_REAL - && code->expr1->ts.type != BT_COMPLEX - && code->expr1->ts.type != BT_LOGICAL)) + if (!is_scalar_intrinsic_expr (stmt->expr1, true, false)) { gfc_error ("!$OMP ATOMIC statement must set a scalar variable of " - "intrinsic type at %L", &code->loc); + "intrinsic type at %L", &stmt->expr1->where); return; } - var = code->expr1->symtree->n.sym; - expr2 = is_conversion (code->expr2, false); - if (expr2 == NULL) + if (!gfc_resolve_expr (stmt->expr2)) + return; + if (!is_scalar_intrinsic_expr (stmt->expr2, false, false)) { - if (aop == GFC_OMP_ATOMIC_READ || aop == GFC_OMP_ATOMIC_WRITE) - expr2 = is_conversion (code->expr2, true); - if (expr2 == NULL) - expr2 = code->expr2; + gfc_error ("!$OMP ATOMIC statement must assign an expression of " + "intrinsic type at %L", &stmt->expr2->where); + return; } + if (gfc_expr_attr (stmt->expr1).allocatable) + { + gfc_error ("!$OMP ATOMIC with ALLOCATABLE variable at %L", + &stmt->expr1->where); + return; + } + + /* Should be diagnosed above already. */ + gcc_assert (tailing_stmt == NULL); + + var = stmt->expr1->symtree->n.sym; + stmt_expr2 = is_conversion (stmt->expr2, true, true); + if (stmt_expr2 == NULL) + stmt_expr2 = stmt->expr2; + switch (aop) { case GFC_OMP_ATOMIC_READ: - if (expr2->expr_type != EXPR_VARIABLE - || expr2->symtree == NULL - || expr2->rank != 0 - || (expr2->ts.type != BT_INTEGER - && expr2->ts.type != BT_REAL - && expr2->ts.type != BT_COMPLEX - && expr2->ts.type != BT_LOGICAL)) + if (stmt_expr2->expr_type != EXPR_VARIABLE) gfc_error ("!$OMP ATOMIC READ statement must read from a scalar " - "variable of intrinsic type at %L", &expr2->where); + "variable of intrinsic type at %L", &stmt_expr2->where); return; case GFC_OMP_ATOMIC_WRITE: - if (expr2->rank != 0 || expr_references_sym (code->expr2, var, NULL)) + if (expr_references_sym (stmt_expr2, var, NULL)) gfc_error ("expr in !$OMP ATOMIC WRITE assignment var = expr " "must be scalar and cannot reference var at %L", - &expr2->where); + &stmt_expr2->where); return; default: break; } + if (atomic_code->ext.omp_clauses->capture) { - expr2_tmp = expr2; - if (expr2 == code->expr2) + if (!is_scalar_intrinsic_expr (capture_stmt->expr1, true, false)) { - expr2_tmp = is_conversion (code->expr2, true); - if (expr2_tmp == NULL) - expr2_tmp = expr2; + gfc_error ("!$OMP ATOMIC capture-statement must set a scalar " + "variable of intrinsic type at %L", + &capture_stmt->expr1->where); + return; } - if (expr2_tmp->expr_type == EXPR_VARIABLE) + + if (!is_scalar_intrinsic_expr (capture_stmt->expr2, true, true)) { - if (expr2_tmp->symtree == NULL - || expr2_tmp->rank != 0 - || (expr2_tmp->ts.type != BT_INTEGER - && expr2_tmp->ts.type != BT_REAL - && expr2_tmp->ts.type != BT_COMPLEX - && expr2_tmp->ts.type != BT_LOGICAL) - || expr2_tmp->symtree->n.sym == var) - { - gfc_error ("!$OMP ATOMIC CAPTURE capture statement must read from " - "a scalar variable of intrinsic type at %L", - &expr2_tmp->where); - return; - } - var = expr2_tmp->symtree->n.sym; - code = code->next; - if (code->expr1->expr_type != EXPR_VARIABLE - || code->expr1->symtree == NULL - || code->expr1->rank != 0 - || (code->expr1->ts.type != BT_INTEGER - && code->expr1->ts.type != BT_REAL - && code->expr1->ts.type != BT_COMPLEX - && code->expr1->ts.type != BT_LOGICAL)) - { - gfc_error ("!$OMP ATOMIC CAPTURE update statement must set " - "a scalar variable of intrinsic type at %L", - &code->expr1->where); - return; - } - if (code->expr1->symtree->n.sym != var) - { - gfc_error ("!$OMP ATOMIC CAPTURE capture statement reads from " - "different variable than update statement writes " - "into at %L", &code->expr1->where); + gfc_error ("!$OMP ATOMIC capture-statement requires a scalar variable" + " of intrinsic type at %L", &capture_stmt->expr2->where); + return; + } + capt_expr2 = is_conversion (capture_stmt->expr2, true, true); + if (capt_expr2 == NULL) + capt_expr2 = capture_stmt->expr2; + + if (capt_expr2->symtree->n.sym != var) + { + gfc_error ("!$OMP ATOMIC CAPTURE capture statement reads from " + "different variable than update statement writes " + "into at %L", &capture_stmt->expr2->where); return; - } - expr2 = is_conversion (code->expr2, false); - if (expr2 == NULL) - expr2 = code->expr2; } } - if (gfc_expr_attr (code->expr1).allocatable) + if (atomic_code->ext.omp_clauses->compare) { - gfc_error ("!$OMP ATOMIC with ALLOCATABLE variable at %L", - &code->loc); - return; + gfc_expr *var_expr; + if (comp_cond->value.op.op1->expr_type == EXPR_VARIABLE) + var_expr = comp_cond->value.op.op1; + else + var_expr = comp_cond->value.op.op1->value.function.actual->expr; + if (var_expr->symtree->n.sym != var) + { + gfc_error ("For !$OMP ATOMIC COMPARE, the first operand in comparison" + " at %L must be the variable %qs that the update statement" + " writes into at %L", &var_expr->where, var->name, + &stmt->expr1->where); + return; + } + if (stmt_expr2->rank != 0 || expr_references_sym (stmt_expr2, var, NULL)) + { + gfc_error ("expr in !$OMP ATOMIC COMPARE assignment var = expr " + "must be scalar and cannot reference var at %L", + &stmt_expr2->where); + return; + } } - - if (atomic_code->ext.omp_clauses->capture - && code->next == NULL - && code->expr2->rank == 0 - && !expr_references_sym (code->expr2, var, NULL)) + else if (atomic_code->ext.omp_clauses->capture + && !expr_references_sym (stmt_expr2, var, NULL)) atomic_code->ext.omp_clauses->atomic_op = (gfc_omp_atomic_op) (atomic_code->ext.omp_clauses->atomic_op | GFC_OMP_ATOMIC_SWAP); - else if (expr2->expr_type == EXPR_OP) + else if (stmt_expr2->expr_type == EXPR_OP) { gfc_expr *v = NULL, *e, *c; - gfc_intrinsic_op op = expr2->value.op.op; + gfc_intrinsic_op op = stmt_expr2->value.op.op; gfc_intrinsic_op alt_op = INTRINSIC_NONE; + if (atomic_code->ext.omp_clauses->fail != OMP_MEMORDER_UNSET) + gfc_error ("!$OMP ATOMIC UPDATE at %L with FAIL clause requiries either" + " the COMPARE clause or using the intrinsic MIN/MAX " + "procedure", &atomic_code->loc); switch (op) { case INTRINSIC_PLUS: @@ -7640,7 +8014,7 @@ resolve_omp_atomic (gfc_code *code) default: gfc_error ("!$OMP ATOMIC assignment operator must be binary " "+, *, -, /, .AND., .OR., .EQV. or .NEQV. at %L", - &expr2->where); + &stmt_expr2->where); return; } @@ -7650,12 +8024,12 @@ resolve_omp_atomic (gfc_code *code) (expr) op var. We rely here on the fact that the matcher for x op1 y op2 z where op1 and op2 have equal precedence returns (x op1 y) op2 z. */ - e = expr2->value.op.op2; + e = stmt_expr2->value.op.op2; if (e->expr_type == EXPR_VARIABLE && e->symtree != NULL && e->symtree->n.sym == var) v = e; - else if ((c = is_conversion (e, true)) != NULL + else if ((c = is_conversion (e, false, true)) != NULL && c->expr_type == EXPR_VARIABLE && c->symtree != NULL && c->symtree->n.sym == var) @@ -7663,7 +8037,7 @@ resolve_omp_atomic (gfc_code *code) else { gfc_expr **p = NULL, **q; - for (q = &expr2->value.op.op1; (e = *q) != NULL; ) + for (q = &stmt_expr2->value.op.op1; (e = *q) != NULL; ) if (e->expr_type == EXPR_VARIABLE && e->symtree != NULL && e->symtree->n.sym == var) @@ -7671,7 +8045,7 @@ resolve_omp_atomic (gfc_code *code) v = e; break; } - else if ((c = is_conversion (e, true)) != NULL) + else if ((c = is_conversion (e, false, true)) != NULL) q = &e->value.function.actual->expr; else if (e->expr_type != EXPR_OP || (e->value.op.op != op @@ -7687,7 +8061,7 @@ resolve_omp_atomic (gfc_code *code) if (v == NULL) { gfc_error ("!$OMP ATOMIC assignment must be var = var op expr " - "or var = expr op var at %L", &expr2->where); + "or var = expr op var at %L", &stmt_expr2->where); return; } @@ -7702,7 +8076,7 @@ resolve_omp_atomic (gfc_code *code) case INTRINSIC_NEQV: gfc_error ("!$OMP ATOMIC var = var op expr not " "mathematically equivalent to var = var op " - "(expr) at %L", &expr2->where); + "(expr) at %L", &stmt_expr2->where); break; default: break; @@ -7710,43 +8084,44 @@ resolve_omp_atomic (gfc_code *code) /* Canonicalize into var = var op (expr). */ *p = e->value.op.op2; - e->value.op.op2 = expr2; - e->ts = expr2->ts; - if (code->expr2 == expr2) - code->expr2 = expr2 = e; + e->value.op.op2 = stmt_expr2; + e->ts = stmt_expr2->ts; + if (stmt->expr2 == stmt_expr2) + stmt->expr2 = stmt_expr2 = e; else - code->expr2->value.function.actual->expr = expr2 = e; + stmt->expr2->value.function.actual->expr = stmt_expr2 = e; - if (!gfc_compare_types (&expr2->value.op.op1->ts, &expr2->ts)) + if (!gfc_compare_types (&stmt_expr2->value.op.op1->ts, + &stmt_expr2->ts)) { - for (p = &expr2->value.op.op1; *p != v; + for (p = &stmt_expr2->value.op.op1; *p != v; p = &(*p)->value.function.actual->expr) ; *p = NULL; - gfc_free_expr (expr2->value.op.op1); - expr2->value.op.op1 = v; - gfc_convert_type (v, &expr2->ts, 2); + gfc_free_expr (stmt_expr2->value.op.op1); + stmt_expr2->value.op.op1 = v; + gfc_convert_type (v, &stmt_expr2->ts, 2); } } } - if (e->rank != 0 || expr_references_sym (code->expr2, var, v)) + if (e->rank != 0 || expr_references_sym (stmt->expr2, var, v)) { gfc_error ("expr in !$OMP ATOMIC assignment var = var op expr " "must be scalar and cannot reference var at %L", - &expr2->where); + &stmt_expr2->where); return; } } - else if (expr2->expr_type == EXPR_FUNCTION - && expr2->value.function.isym != NULL - && expr2->value.function.esym == NULL - && expr2->value.function.actual != NULL - && expr2->value.function.actual->next != NULL) + else if (stmt_expr2->expr_type == EXPR_FUNCTION + && stmt_expr2->value.function.isym != NULL + && stmt_expr2->value.function.esym == NULL + && stmt_expr2->value.function.actual != NULL + && stmt_expr2->value.function.actual->next != NULL) { gfc_actual_arglist *arg, *var_arg; - switch (expr2->value.function.isym->id) + switch (stmt_expr2->value.function.isym->id) { case GFC_ISYM_MIN: case GFC_ISYM_MAX: @@ -7754,31 +8129,37 @@ resolve_omp_atomic (gfc_code *code) case GFC_ISYM_IAND: case GFC_ISYM_IOR: case GFC_ISYM_IEOR: - if (expr2->value.function.actual->next->next != NULL) + if (stmt_expr2->value.function.actual->next->next != NULL) { gfc_error ("!$OMP ATOMIC assignment intrinsic IAND, IOR " "or IEOR must have two arguments at %L", - &expr2->where); + &stmt_expr2->where); return; } break; default: gfc_error ("!$OMP ATOMIC assignment intrinsic must be " "MIN, MAX, IAND, IOR or IEOR at %L", - &expr2->where); + &stmt_expr2->where); return; } var_arg = NULL; - for (arg = expr2->value.function.actual; arg; arg = arg->next) - { - if ((arg == expr2->value.function.actual - || (var_arg == NULL && arg->next == NULL)) - && arg->expr->expr_type == EXPR_VARIABLE - && arg->expr->symtree != NULL - && arg->expr->symtree->n.sym == var) - var_arg = arg; - else if (expr_references_sym (arg->expr, var, NULL)) + for (arg = stmt_expr2->value.function.actual; arg; arg = arg->next) + { + gfc_expr *e = NULL; + if (arg == stmt_expr2->value.function.actual + || (var_arg == NULL && arg->next == NULL)) + { + e = is_conversion (arg->expr, false, true); + if (!e) + e = arg->expr; + if (e->expr_type == EXPR_VARIABLE + && e->symtree != NULL + && e->symtree->n.sym == var) + var_arg = arg; + } + if ((!var_arg || !e) && expr_references_sym (arg->expr, var, NULL)) { gfc_error ("!$OMP ATOMIC intrinsic arguments except one must " "not reference %qs at %L", @@ -7796,72 +8177,31 @@ resolve_omp_atomic (gfc_code *code) if (var_arg == NULL) { gfc_error ("First or last !$OMP ATOMIC intrinsic argument must " - "be %qs at %L", var->name, &expr2->where); + "be %qs at %L", var->name, &stmt_expr2->where); return; } - if (var_arg != expr2->value.function.actual) + if (var_arg != stmt_expr2->value.function.actual) { /* Canonicalize, so that var comes first. */ gcc_assert (var_arg->next == NULL); - for (arg = expr2->value.function.actual; + for (arg = stmt_expr2->value.function.actual; arg->next != var_arg; arg = arg->next) ; - var_arg->next = expr2->value.function.actual; - expr2->value.function.actual = var_arg; + var_arg->next = stmt_expr2->value.function.actual; + stmt_expr2->value.function.actual = var_arg; arg->next = NULL; } } else gfc_error ("!$OMP ATOMIC assignment must have an operator or " - "intrinsic on right hand side at %L", &expr2->where); - - if (atomic_code->ext.omp_clauses->capture && code->next) - { - code = code->next; - if (code->expr1->expr_type != EXPR_VARIABLE - || code->expr1->symtree == NULL - || code->expr1->rank != 0 - || (code->expr1->ts.type != BT_INTEGER - && code->expr1->ts.type != BT_REAL - && code->expr1->ts.type != BT_COMPLEX - && code->expr1->ts.type != BT_LOGICAL)) - { - gfc_error ("!$OMP ATOMIC CAPTURE capture statement must set " - "a scalar variable of intrinsic type at %L", - &code->expr1->where); - return; - } + "intrinsic on right hand side at %L", &stmt_expr2->where); + return; - expr2 = is_conversion (code->expr2, false); - if (expr2 == NULL) - { - expr2 = is_conversion (code->expr2, true); - if (expr2 == NULL) - expr2 = code->expr2; - } - - if (expr2->expr_type != EXPR_VARIABLE - || expr2->symtree == NULL - || expr2->rank != 0 - || (expr2->ts.type != BT_INTEGER - && expr2->ts.type != BT_REAL - && expr2->ts.type != BT_COMPLEX - && expr2->ts.type != BT_LOGICAL)) - { - gfc_error ("!$OMP ATOMIC CAPTURE capture statement must read " - "from a scalar variable of intrinsic type at %L", - &expr2->where); - return; - } - if (expr2->symtree->n.sym != var) - { - gfc_error ("!$OMP ATOMIC CAPTURE capture statement reads from " - "different variable than update statement writes " - "into at %L", &expr2->where); - return; - } - } +unexpected: + gfc_error ("unexpected !$OMP ATOMIC expression at %L", + loc ? loc : &code->loc); + return; } @@ -8002,7 +8342,7 @@ gfc_resolve_omp_parallel_blocks (gfc_code *code, gfc_namespace *ns) } -/* Save and clear openmp.c private state. */ +/* Save and clear openmp.cc private state. */ void gfc_omp_save_and_clear_state (struct gfc_omp_saved_state *state) @@ -8016,7 +8356,7 @@ gfc_omp_save_and_clear_state (struct gfc_omp_saved_state *state) } -/* Restore openmp.c private state from the saved state. */ +/* Restore openmp.cc private state from the saved state. */ void gfc_omp_restore_state (struct gfc_omp_saved_state *state) @@ -8233,19 +8573,20 @@ resolve_omp_do (gfc_code *code) if (code->ext.omp_clauses) for (list = 0; list < OMP_LIST_NUM; list++) if (!is_simd || code->ext.omp_clauses->collapse > 1 - ? (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE) + ? (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE + && list != OMP_LIST_ALLOCATE) : (list != OMP_LIST_PRIVATE && list != OMP_LIST_LASTPRIVATE - && list != OMP_LIST_LINEAR)) + && list != OMP_LIST_ALLOCATE && list != OMP_LIST_LINEAR)) for (n = code->ext.omp_clauses->lists[list]; n; n = n->next) if (dovar == n->sym) { if (!is_simd || code->ext.omp_clauses->collapse > 1) gfc_error ("%s iteration variable present on clause " - "other than PRIVATE or LASTPRIVATE at %L", - name, &do_code->loc); + "other than PRIVATE, LASTPRIVATE or " + "ALLOCATE at %L", name, &do_code->loc); else gfc_error ("%s iteration variable present on clause " - "other than PRIVATE, LASTPRIVATE or " + "other than PRIVATE, LASTPRIVATE, ALLOCATE or " "LINEAR at %L", name, &do_code->loc); break; } diff --git a/gcc/fortran/options.c b/gcc/fortran/options.cc index 3499a1c..d0fa634 100644 --- a/gcc/fortran/options.c +++ b/gcc/fortran/options.cc @@ -1,5 +1,5 @@ /* Parse and display command line options. - Copyright (C) 2000-2021 Free Software Foundation, Inc. + Copyright (C) 2000-2022 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.cc index b1e73ee..db91829 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.cc @@ -1,5 +1,5 @@ /* Main parser. - Copyright (C) 2000-2021 Free Software Foundation, Inc. + Copyright (C) 2000-2022 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. @@ -924,6 +924,7 @@ decode_omp_directive (void) matcho ("end distribute", gfc_match_omp_eos_error, ST_OMP_END_DISTRIBUTE); matchs ("end do simd", gfc_match_omp_end_nowait, ST_OMP_END_DO_SIMD); matcho ("end do", gfc_match_omp_end_nowait, ST_OMP_END_DO); + matcho ("end loop", gfc_match_omp_eos_error, ST_OMP_END_LOOP); matchs ("end simd", gfc_match_omp_eos_error, ST_OMP_END_SIMD); matcho ("end masked taskloop simd", gfc_match_omp_eos_error, ST_OMP_END_MASKED_TASKLOOP_SIMD); @@ -939,6 +940,8 @@ decode_omp_directive (void) matchs ("end parallel do simd", gfc_match_omp_eos_error, ST_OMP_END_PARALLEL_DO_SIMD); matcho ("end parallel do", gfc_match_omp_eos_error, ST_OMP_END_PARALLEL_DO); + matcho ("end parallel loop", gfc_match_omp_eos_error, + ST_OMP_END_PARALLEL_LOOP); matcho ("end parallel masked taskloop simd", gfc_match_omp_eos_error, ST_OMP_END_PARALLEL_MASKED_TASKLOOP_SIMD); matcho ("end parallel masked taskloop", gfc_match_omp_eos_error, @@ -960,24 +963,29 @@ decode_omp_directive (void) matcho ("end sections", gfc_match_omp_end_nowait, ST_OMP_END_SECTIONS); matcho ("end single", gfc_match_omp_end_single, ST_OMP_END_SINGLE); matcho ("end target data", gfc_match_omp_eos_error, ST_OMP_END_TARGET_DATA); - matchs ("end target parallel do simd", gfc_match_omp_eos_error, + matchs ("end target parallel do simd", gfc_match_omp_end_nowait, ST_OMP_END_TARGET_PARALLEL_DO_SIMD); - matcho ("end target parallel do", gfc_match_omp_eos_error, + matcho ("end target parallel do", gfc_match_omp_end_nowait, ST_OMP_END_TARGET_PARALLEL_DO); - matcho ("end target parallel", gfc_match_omp_eos_error, + matcho ("end target parallel loop", gfc_match_omp_end_nowait, + ST_OMP_END_TARGET_PARALLEL_LOOP); + matcho ("end target parallel", gfc_match_omp_end_nowait, ST_OMP_END_TARGET_PARALLEL); - matchs ("end target simd", gfc_match_omp_eos_error, ST_OMP_END_TARGET_SIMD); + matchs ("end target simd", gfc_match_omp_end_nowait, ST_OMP_END_TARGET_SIMD); matchs ("end target teams distribute parallel do simd", - gfc_match_omp_eos_error, + gfc_match_omp_end_nowait, ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO_SIMD); - matcho ("end target teams distribute parallel do", gfc_match_omp_eos_error, + matcho ("end target teams distribute parallel do", gfc_match_omp_end_nowait, ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_PARALLEL_DO); - matchs ("end target teams distribute simd", gfc_match_omp_eos_error, + matchs ("end target teams distribute simd", gfc_match_omp_end_nowait, ST_OMP_END_TARGET_TEAMS_DISTRIBUTE_SIMD); - matcho ("end target teams distribute", gfc_match_omp_eos_error, + matcho ("end target teams distribute", gfc_match_omp_end_nowait, ST_OMP_END_TARGET_TEAMS_DISTRIBUTE); - matcho ("end target teams", gfc_match_omp_eos_error, ST_OMP_END_TARGET_TEAMS); - matcho ("end target", gfc_match_omp_eos_error, ST_OMP_END_TARGET); + matcho ("end target teams loop", gfc_match_omp_end_nowait, + ST_OMP_END_TARGET_TEAMS_LOOP); + matcho ("end target teams", gfc_match_omp_end_nowait, + ST_OMP_END_TARGET_TEAMS); + matcho ("end target", gfc_match_omp_end_nowait, ST_OMP_END_TARGET); matcho ("end taskgroup", gfc_match_omp_eos_error, ST_OMP_END_TASKGROUP); matchs ("end taskloop simd", gfc_match_omp_eos_error, ST_OMP_END_TASKLOOP_SIMD); @@ -991,6 +999,7 @@ decode_omp_directive (void) ST_OMP_END_TEAMS_DISTRIBUTE_SIMD); matcho ("end teams distribute", gfc_match_omp_eos_error, ST_OMP_END_TEAMS_DISTRIBUTE); + matcho ("end teams loop", gfc_match_omp_eos_error, ST_OMP_END_TEAMS_LOOP); matcho ("end teams", gfc_match_omp_eos_error, ST_OMP_END_TEAMS); matcho ("end workshare", gfc_match_omp_end_nowait, ST_OMP_END_WORKSHARE); @@ -2553,7 +2562,7 @@ gfc_ascii_statement (gfc_statement st) p = "!$OMP END TEAMS DISTRIBUTE SIMD"; break; case ST_OMP_END_TEAMS_LOOP: - p = "!$OMP END TEAMS LOP"; + p = "!$OMP END TEAMS LOOP"; break; case ST_OMP_END_WORKSHARE: p = "!$OMP END WORKSHARE"; @@ -3422,7 +3431,7 @@ parse_union (void) c->ts.type = BT_DERIVED; c->ts.u.derived = gfc_new_block; /* Normally components get their initialization expressions when they - are created in decl.c (build_struct) so we can look through the + are created in decl.cc (build_struct) so we can look through the flat component list for initializers during resolution. Unions and maps create components along with their type definitions so we have to generate initializers here. */ @@ -5304,7 +5313,22 @@ parse_omp_oacc_atomic (bool omp_p) st = next_statement (); if (st == ST_NONE) unexpected_eof (); - else if (st == ST_ASSIGNMENT) + else if (np->ext.omp_clauses->compare + && (st == ST_SIMPLE_IF || st == ST_IF_BLOCK)) + { + count--; + if (st == ST_IF_BLOCK) + { + parse_if_block (); + /* With else (or elseif). */ + if (gfc_state_stack->tail->block->block) + count--; + } + accept_statement (st); + } + else if (st == ST_ASSIGNMENT + && (!np->ext.omp_clauses->compare + || np->ext.omp_clauses->capture)) { accept_statement (st); count--; @@ -5323,8 +5347,6 @@ parse_omp_oacc_atomic (bool omp_p) gfc_warning_check (); st = next_statement (); } - else if (np->ext.omp_clauses->capture) - gfc_error ("Missing !$OMP END ATOMIC after !$OMP ATOMIC CAPTURE at %C"); return st; } @@ -6383,7 +6405,7 @@ set_syms_host_assoc (gfc_symbol *sym) /* Derived types with PRIVATE components that are declared in modules other than the parent module must not be changed to be PUBLIC. The 'use-assoc' attribute must be reset so that the - test in symbol.c(gfc_find_component) works correctly. This is + test in symbol.cc(gfc_find_component) works correctly. This is not necessary for PRIVATE symbols since they are not read from the module. */ memset(parent1, '\0', sizeof(parent1)); @@ -6569,7 +6591,7 @@ resolve_all_program_units (gfc_namespace *gfc_global_ns_list) static void -clean_up_modules (gfc_gsymbol *gsym) +clean_up_modules (gfc_gsymbol *&gsym) { if (gsym == NULL) return; @@ -6577,14 +6599,18 @@ clean_up_modules (gfc_gsymbol *gsym) clean_up_modules (gsym->left); clean_up_modules (gsym->right); - if (gsym->type != GSYM_MODULE || !gsym->ns) + if (gsym->type != GSYM_MODULE) return; - gfc_current_ns = gsym->ns; - gfc_derived_types = gfc_current_ns->derived_types; - gfc_done_2 (); - gsym->ns = NULL; - return; + if (gsym->ns) + { + gfc_current_ns = gsym->ns; + gfc_derived_types = gfc_current_ns->derived_types; + gfc_done_2 (); + gsym->ns = NULL; + } + free (gsym); + gsym = NULL; } @@ -6913,7 +6939,7 @@ done: /* Dump the global symbol ist. We only do this here because part of it is generated after mangling the identifiers in - trans-decl.c. */ + trans-decl.cc. */ if (flag_dump_fortran_global) gfc_dump_global_symbols (stdout); diff --git a/gcc/fortran/parse.h b/gcc/fortran/parse.h index 66b275d..7ddea10 100644 --- a/gcc/fortran/parse.h +++ b/gcc/fortran/parse.h @@ -1,5 +1,5 @@ /* Parser header - Copyright (C) 2003-2021 Free Software Foundation, Inc. + Copyright (C) 2003-2022 Free Software Foundation, Inc. Contributed by Steven Bosscher This file is part of GCC. diff --git a/gcc/fortran/primary.c b/gcc/fortran/primary.cc index d873264..3f01f67 100644 --- a/gcc/fortran/primary.c +++ b/gcc/fortran/primary.cc @@ -1,5 +1,5 @@ /* Primary expression subroutines - Copyright (C) 2000-2021 Free Software Foundation, Inc. + Copyright (C) 2000-2022 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. @@ -2151,6 +2151,7 @@ gfc_match_varspec (gfc_expr *primary, int equiv_flag, bool sub_flag, && !(gfc_matching_procptr_assignment && sym->attr.flavor == FL_PROCEDURE)) || (sym->ts.type == BT_CLASS && sym->attr.class_ok + && sym->ts.u.derived && CLASS_DATA (sym) && (CLASS_DATA (sym)->attr.dimension || CLASS_DATA (sym)->attr.codimension))) { @@ -3363,6 +3364,7 @@ gfc_match_structure_constructor (gfc_symbol *sym, gfc_expr **result) match m; gfc_expr *e; gfc_symtree *symtree; + bool t = true; gfc_get_ha_sym_tree (sym->name, &symtree); @@ -3393,10 +3395,18 @@ gfc_match_structure_constructor (gfc_symbol *sym, gfc_expr **result) in the structure constructor must be a constant. Try to reduce the expression here. */ if (gfc_in_match_data ()) - gfc_reduce_init_expr (e); + t = gfc_reduce_init_expr (e); - *result = e; - return MATCH_YES; + if (t) + { + *result = e; + return MATCH_YES; + } + else + { + gfc_free_expr (e); + return MATCH_ERROR; + } } diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.cc index af71b13..835a478 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.cc @@ -1,5 +1,5 @@ /* Perform type resolution on the various structures. - Copyright (C) 2001-2021 Free Software Foundation, Inc. + Copyright (C) 2001-2022 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. @@ -2127,7 +2127,7 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype, } /* Expressions are assigned a default ts.type of BT_PROCEDURE in - primary.c (match_actual_arg). If above code determines that it + primary.cc (match_actual_arg). If above code determines that it is a variable instead, it needs to be resolved as it was not done at the beginning of this function. */ save_need_full_assumed_size = need_full_assumed_size; @@ -2161,7 +2161,7 @@ resolve_actual_arglist (gfc_actual_arglist *arg, procedure_type ptype, /* Intrinsics are still PROC_UNKNOWN here. However, since same file external procedures are not resolvable in gfortran, it is a good deal easier to leave them to - intrinsic.c. */ + intrinsic.cc. */ if (ptype != PROC_UNKNOWN && ptype != PROC_DUMMY && ptype != PROC_EXTERNAL @@ -2402,7 +2402,7 @@ resolve_elemental_actual (gfc_expr *expr, gfc_code *c) reference being resolved must correspond to the type of gsymbol. Otherwise, the new symbol is equipped with the attributes of the reference. The corresponding code that is called in creating - global entities is parse.c. + global entities is parse.cc. In addition, for all but -std=legacy, the gsymbols are used to check the interfaces of external procedures from the same file. @@ -2974,6 +2974,19 @@ resolve_unknown_f (gfc_expr *expr) return false; } + /* IMPLICIT NONE (external) procedures require an explicit EXTERNAL attr. */ + /* Intrinsics were handled above, only non-intrinsics left here. */ + if (sym->attr.flavor == FL_PROCEDURE + && sym->attr.implicit_type + && sym->ns + && sym->ns->has_implicit_none_export) + { + gfc_error ("Missing explicit declaration with EXTERNAL attribute " + "for symbol %qs at %L", sym->name, &sym->declared_at); + sym->error = 1; + return false; + } + /* The reference is to an external name. */ sym->attr.proc = PROC_EXTERNAL; @@ -4051,7 +4064,7 @@ resolve_operator (gfc_expr *e) { default: if (!gfc_resolve_expr (e->value.op.op2)) - return false; + t = false; /* Fall through. */ @@ -4078,6 +4091,9 @@ resolve_operator (gfc_expr *e) op2 = e->value.op.op2; if (op1 == NULL && op2 == NULL) return false; + /* Error out if op2 did not resolve. We already diagnosed op1. */ + if (t == false) + return false; dual_locus_error = false; @@ -5720,6 +5736,8 @@ resolve_variable (gfc_expr *e) can't be translated that way. */ if (sym->assoc && e->rank == 0 && e->ref && sym->ts.type == BT_CLASS && sym->assoc->target && sym->assoc->target->ts.type == BT_CLASS + && sym->assoc->target->ts.u.derived + && CLASS_DATA (sym->assoc->target) && CLASS_DATA (sym->assoc->target)->as) { gfc_ref *ref = e->ref; @@ -5783,7 +5801,8 @@ resolve_variable (gfc_expr *e) /* Like above, but for class types, where the checking whether an array ref is present is more complicated. Furthermore make sure not to add the full array ref to _vptr or _len refs. */ - if (sym->assoc && sym->ts.type == BT_CLASS + if (sym->assoc && sym->ts.type == BT_CLASS && sym->ts.u.derived + && CLASS_DATA (sym) && CLASS_DATA (sym)->attr.dimension && (e->ts.type != BT_DERIVED || !e->ts.u.derived->attr.vtype)) { @@ -6025,7 +6044,7 @@ check_host_association (gfc_expr *e) bool retval = e->expr_type == EXPR_FUNCTION; /* If the expression is the result of substitution in - interface.c(gfc_extend_expr) because there is no way in + interface.cc(gfc_extend_expr) because there is no way in which the host association can be wrong. */ if (e->symtree == NULL || e->symtree->n.sym == NULL @@ -6770,7 +6789,7 @@ resolve_typebound_function (gfc_expr* e) get_declared_from_expr (&class_ref, NULL, e, false); /* Trim away the extraneous references that emerge from nested - use of interface.c (extend_expr). */ + use of interface.cc (extend_expr). */ if (class_ref && class_ref->next) { gfc_free_ref_list (class_ref->next); @@ -6901,7 +6920,7 @@ resolve_typebound_subroutine (gfc_code *code) code->expr1->ref = gfc_copy_ref (expr->ref); /* Trim away the extraneous references that emerge from nested - use of interface.c (extend_expr). */ + use of interface.cc (extend_expr). */ get_declared_from_expr (&class_ref, NULL, code->expr1, false); if (class_ref && class_ref->next) { @@ -7133,7 +7152,7 @@ gfc_resolve_expr (gfc_expr *e) && e->symtree->n.sym->attr.dummy) { /* Deal with submodule specification expressions that are not - found to be referenced in module.c(read_cleanup). */ + found to be referenced in module.cc(read_cleanup). */ fixup_unique_dummy (e); } @@ -8770,11 +8789,11 @@ resolve_select (gfc_code *code, bool select_type) if (cp->low != NULL && case_expr->ts.kind != gfc_kind_max(case_expr, cp->low)) - gfc_convert_type_warn (case_expr, &cp->low->ts, 2, 0); + gfc_convert_type_warn (case_expr, &cp->low->ts, 1, 0); if (cp->high != NULL && case_expr->ts.kind != gfc_kind_max(case_expr, cp->high)) - gfc_convert_type_warn (case_expr, &cp->high->ts, 2, 0); + gfc_convert_type_warn (case_expr, &cp->high->ts, 1, 0); } } } @@ -8830,7 +8849,8 @@ resolve_select (gfc_code *code, bool select_type) || cp->low != cp->high)) { gfc_error ("Logical range in CASE statement at %L is not " - "allowed", &cp->low->where); + "allowed", + cp->low ? &cp->low->where : &cp->high->where); t = false; break; } @@ -9083,7 +9103,7 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target) /* Finally resolve if this is an array or not. */ if (sym->attr.dimension && target->rank == 0) { - /* primary.c makes the assumption that a reference to an associate + /* primary.cc makes the assumption that a reference to an associate name followed by a left parenthesis is an array reference. */ if (sym->ts.type != BT_CHARACTER) gfc_error ("Associate-name %qs at %L is used as array", @@ -9229,7 +9249,7 @@ resolve_assoc_var (gfc_symbol* sym, bool resolve_target) sym->ts.u.cl = gfc_new_charlen (sym->ns, NULL); sym->ts.deferred = 1; - /* This is reset in trans-stmt.c after the assignment + /* This is reset in trans-stmt.cc after the assignment of the target expression to the associate name. */ sym->attr.allocatable = 1; } @@ -9415,6 +9435,7 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns) /* Check F03:C815. */ if ((c->ts.type == BT_DERIVED || c->ts.type == BT_CLASS) + && selector_type && !selector_type->attr.unlimited_polymorphic && !gfc_type_is_extensible (c->ts.u.derived)) { @@ -9425,7 +9446,8 @@ resolve_select_type (gfc_code *code, gfc_namespace *old_ns) } /* Check F03:C816. */ - if (c->ts.type != BT_UNKNOWN && !selector_type->attr.unlimited_polymorphic + if (c->ts.type != BT_UNKNOWN + && selector_type && !selector_type->attr.unlimited_polymorphic && ((c->ts.type != BT_DERIVED && c->ts.type != BT_CLASS) || !gfc_type_is_extension_of (selector_type, c->ts.u.derived))) { @@ -10832,13 +10854,8 @@ gfc_resolve_blocks (gfc_code *b, gfc_namespace *ns) { /* Verify this before calling gfc_resolve_code, which might change it. */ - gcc_assert (b->next && b->next->op == EXEC_ASSIGN); - gcc_assert ((!b->ext.omp_clauses->capture - && b->next->next == NULL) - || (b->ext.omp_clauses->capture - && b->next->next != NULL - && b->next->next->op == EXEC_ASSIGN - && b->next->next->next == NULL)); + gcc_assert (b->op == EXEC_OMP_ATOMIC + || (b->next && b->next->op == EXEC_ASSIGN)); } break; @@ -13179,7 +13196,7 @@ static bool resolve_fl_procedure (gfc_symbol *sym, int mp_flag) { gfc_formal_arglist *arg; - bool allocatable_or_pointer; + bool allocatable_or_pointer = false; if (sym->attr.function && !resolve_fl_var_and_proc (sym, mp_flag)) @@ -13282,7 +13299,8 @@ resolve_fl_procedure (gfc_symbol *sym, int mp_flag) /* An elemental function is required to return a scalar 12.7.1 */ if (sym->attr.elemental && sym->attr.function - && (sym->as || (sym->ts.type == BT_CLASS && CLASS_DATA (sym)->as))) + && (sym->as || (sym->ts.type == BT_CLASS && sym->attr.class_ok + && CLASS_DATA (sym)->as))) { gfc_error ("ELEMENTAL function %qs at %L must have a scalar " "result", sym->name, &sym->declared_at); @@ -14357,7 +14375,7 @@ resolve_typebound_procedures (gfc_symbol* derived) } -/* Add a derived type to the dt_list. The dt_list is used in trans-types.c +/* Add a derived type to the dt_list. The dt_list is used in trans-types.cc to give all identical derived types the same backend_decl. */ static void add_dt_to_dt_list (gfc_symbol *derived) @@ -16947,7 +16965,7 @@ resolve_equivalence_derived (gfc_symbol *derived, gfc_symbol *sym, gfc_expr *e) derived type shall not have components with default initialization nor shall two objects of an equivalence group be initialized. Either all or none of the objects shall have an protected attribute. - The simple constraints are done in symbol.c(check_conflict) and the rest + The simple constraints are done in symbol.cc(check_conflict) and the rest are implemented here. */ static void diff --git a/gcc/fortran/scanner.c b/gcc/fortran/scanner.cc index 5a45069..4df6576 100644 --- a/gcc/fortran/scanner.c +++ b/gcc/fortran/scanner.cc @@ -1,5 +1,5 @@ /* Character scanner. - Copyright (C) 2000-2021 Free Software Foundation, Inc. + Copyright (C) 2000-2022 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. @@ -78,8 +78,8 @@ static struct gfc_file_change gfc_linebuf *lb; int line; } *file_changes; -size_t file_changes_cur, file_changes_count; -size_t file_changes_allocated; +static size_t file_changes_cur, file_changes_count; +static size_t file_changes_allocated; static gfc_char_t *last_error_char; @@ -1159,7 +1159,6 @@ skip_fixed_comments (void) skip_comment_line (); continue; - gcc_unreachable (); check_for_digits: { /* Required for OpenMP's conditional compilation sentinel. */ diff --git a/gcc/fortran/scanner.h b/gcc/fortran/scanner.h index 8782fe6..033cada 100644 --- a/gcc/fortran/scanner.h +++ b/gcc/fortran/scanner.h @@ -1,5 +1,5 @@ /* Character scanner header. - Copyright (C) 2013-2021 Free Software Foundation, Inc. + Copyright (C) 2013-2022 Free Software Foundation, Inc. Contributed by Janne Blomqvist This file is part of GCC. diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.cc index d675f2c..6483f9c 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.cc @@ -1,5 +1,5 @@ /* Simplify intrinsic functions at compile-time. - Copyright (C) 2000-2021 Free Software Foundation, Inc. + Copyright (C) 2000-2022 Free Software Foundation, Inc. Contributed by Andy Vaught & Katherine Holcomb This file is part of GCC. @@ -2109,6 +2109,9 @@ gfc_simplify_cshift (gfc_expr *array, gfc_expr *shift, gfc_expr *dim) else which = 0; + if (array->shape == NULL) + return NULL; + gfc_array_size (array, &size); arraysize = mpz_get_ui (size); mpz_clear (size); @@ -2569,6 +2572,9 @@ gfc_simplify_eoshift (gfc_expr *array, gfc_expr *shift, gfc_expr *boundary, if (arraysize == 0) goto final; + if (array->shape == NULL) + goto final; + arrayvec = XCNEWVEC (gfc_expr *, arraysize); array_ctor = gfc_constructor_first (array->value.constructor); for (i = 0; i < arraysize; i++) @@ -4263,6 +4269,12 @@ simplify_bound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind, int upper) || (as->type == AS_ASSUMED_SHAPE && upper))) return NULL; + /* 'array' shall not be an unallocated allocatable variable or a pointer that + is not associated. */ + if (array->expr_type == EXPR_VARIABLE + && (gfc_expr_attr (array).allocatable || gfc_expr_attr (array).pointer)) + return NULL; + gcc_assert (!as || (as->type != AS_DEFERRED && array->expr_type == EXPR_VARIABLE @@ -4280,7 +4292,7 @@ simplify_bound (gfc_expr *array, gfc_expr *dim, gfc_expr *kind, int upper) if (upper && type == AR_FULL && as && as->type == AS_ASSUMED_SIZE) { /* An error message will be emitted in - check_assumed_size_reference (resolve.c). */ + check_assumed_size_reference (resolve.cc). */ return &gfc_bad_expr; } @@ -4869,6 +4881,9 @@ gfc_simplify_maskr (gfc_expr *i, gfc_expr *kind_arg) bool fail = gfc_extract_int (i, &arg); gcc_assert (!fail); + if (!gfc_check_mask (i, kind_arg)) + return &gfc_bad_expr; + result = gfc_get_constant_expr (BT_INTEGER, kind, &i->where); /* MASKR(n) = 2^n - 1 */ @@ -4900,6 +4915,9 @@ gfc_simplify_maskl (gfc_expr *i, gfc_expr *kind_arg) bool fail = gfc_extract_int (i, &arg); gcc_assert (!fail); + if (!gfc_check_mask (i, kind_arg)) + return &gfc_bad_expr; + result = gfc_get_constant_expr (BT_INTEGER, kind, &i->where); /* MASKL(n) = 2^bit_size - 2^(bit_size - n) */ @@ -5087,6 +5105,7 @@ min_max_choose (gfc_expr *arg, gfc_expr *extremum, int sign, bool back_val) static gfc_expr * simplify_min_max (gfc_expr *expr, int sign) { + int tmp1, tmp2; gfc_actual_arglist *arg, *last, *extremum; gfc_expr *tmp, *ret; const char *fname; @@ -5131,7 +5150,16 @@ simplify_min_max (gfc_expr *expr, int sign) if ((tmp->ts.type != BT_INTEGER || tmp->ts.kind != gfc_integer_4_kind) && (strcmp (fname, "min1") == 0 || strcmp (fname, "max1") == 0)) { + /* Explicit conversion, turn off -Wconversion and -Wconversion-extra + warnings. */ + tmp1 = warn_conversion; + tmp2 = warn_conversion_extra; + warn_conversion = warn_conversion_extra = 0; + ret = gfc_convert_constant (tmp, BT_INTEGER, gfc_integer_4_kind); + + warn_conversion = tmp1; + warn_conversion_extra = tmp2; } else if ((tmp->ts.type != BT_REAL || tmp->ts.kind != gfc_real_4_kind) && (strcmp (fname, "amin0") == 0 || strcmp (fname, "amax0") == 0)) @@ -5271,6 +5299,9 @@ simplify_minmaxloc_nodim (gfc_expr *result, gfc_expr *extremum, && !mask->value.logical) goto finish; + if (array->shape == NULL) + goto finish; + for (i = 0; i < array->rank; i++) { count[i] = 0; @@ -8134,7 +8165,18 @@ gfc_simplify_transfer (gfc_expr *source, gfc_expr *mold, gfc_expr *size) set even for array expressions, in order to pass this information into gfc_target_interpret_expr. */ if (result->ts.type == BT_CHARACTER && gfc_is_constant_expr (mold_element)) - result->value.character.length = mold_element->value.character.length; + { + result->value.character.length = mold_element->value.character.length; + + /* Let the typespec of the result inherit the string length. + This is crucial if a resulting array has size zero. */ + if (mold_element->ts.u.cl->length) + result->ts.u.cl->length = gfc_copy_expr (mold_element->ts.u.cl->length); + else + result->ts.u.cl->length = + gfc_get_int_expr (gfc_charlen_int_kind, NULL, + mold_element->value.character.length); + } /* Set the number of elements in the result, and determine its size. */ @@ -8174,6 +8216,9 @@ gfc_simplify_transpose (gfc_expr *matrix) gcc_assert (matrix->rank == 2); + if (matrix->shape == NULL) + return NULL; + result = gfc_get_array_expr (matrix->ts.type, matrix->ts.kind, &matrix->where); result->rank = 2; diff --git a/gcc/fortran/st.c b/gcc/fortran/st.cc index 6bf730c..73f30c2 100644 --- a/gcc/fortran/st.c +++ b/gcc/fortran/st.cc @@ -1,5 +1,5 @@ /* Build executable statement trees. - Copyright (C) 2000-2021 Free Software Foundation, Inc. + Copyright (C) 2000-2022 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.cc index c77f3f8..7a80dfd0 100644 --- a/gcc/fortran/symbol.c +++ b/gcc/fortran/symbol.cc @@ -1,5 +1,5 @@ /* Maintain binary trees of symbols. - Copyright (C) 2000-2021 Free Software Foundation, Inc. + Copyright (C) 2000-2022 Free Software Foundation, Inc. Contributed by Andy Vaught This file is part of GCC. @@ -299,7 +299,7 @@ gfc_set_default_type (gfc_symbol *sym, int error_flag, gfc_namespace *ns) if (ts->type == BT_UNKNOWN) { - if (error_flag && !sym->attr.untyped) + if (error_flag && !sym->attr.untyped && !gfc_query_suppress_errors ()) { const char *guessed = lookup_symbol_fuzzy (sym->name, sym); if (guessed) @@ -357,7 +357,7 @@ gfc_set_default_type (gfc_symbol *sym, int error_flag, gfc_namespace *ns) } -/* This function is called from parse.c(parse_progunit) to check the +/* This function is called from parse.cc(parse_progunit) to check the type of the function is not implicitly typed in the host namespace and to implicitly type the function result, if necessary. */ @@ -995,7 +995,7 @@ gfc_add_ext_attribute (symbol_attribute *attr, ext_attr_id_t ext_attr, } -/* Called from decl.c (attr_decl1) to check attributes, when declared +/* Called from decl.cc (attr_decl1) to check attributes, when declared separately. */ bool @@ -2610,7 +2610,7 @@ free_components (gfc_component *p) if (p->param_list) gfc_free_actual_arglist (p->param_list); free (p->tb); - + p->tb = NULL; free (p); } } @@ -3067,7 +3067,7 @@ set_symbol_common_block (gfc_symbol *sym, gfc_common_head *common_block) /* Remove a gfc_symbol structure and everything it points to. */ void -gfc_free_symbol (gfc_symbol *sym) +gfc_free_symbol (gfc_symbol *&sym) { if (sym == NULL) @@ -3097,13 +3097,14 @@ gfc_free_symbol (gfc_symbol *sym) gfc_free_actual_arglist (sym->param_list); free (sym); + sym = NULL; } /* Decrease the reference counter and free memory when we reach zero. */ void -gfc_release_symbol (gfc_symbol *sym) +gfc_release_symbol (gfc_symbol *&sym) { if (sym == NULL) return; @@ -3830,9 +3831,9 @@ free_tb_tree (gfc_symtree *t) free_tb_tree (t->left); free_tb_tree (t->right); - /* TODO: Free type-bound procedure structs themselves; probably needs some - sort of ref-counting mechanism. */ - + /* TODO: Free type-bound procedure u.generic */ + free (t->n.tb); + t->n.tb = NULL; free (t); } @@ -3985,7 +3986,7 @@ gfc_new_charlen (gfc_namespace *ns, gfc_charlen *old_cl) /* Free the charlen list from cl to end (end is not freed). Free the whole list if end is NULL. */ -void +static void gfc_free_charlen (gfc_charlen *cl, gfc_charlen *end) { gfc_charlen *cl2; @@ -4022,7 +4023,7 @@ free_entry_list (gfc_entry_list *el) taken care of when a specific name is freed. */ void -gfc_free_namespace (gfc_namespace *ns) +gfc_free_namespace (gfc_namespace *&ns) { gfc_namespace *p, *q; int i; @@ -4073,6 +4074,7 @@ gfc_free_namespace (gfc_namespace *ns) p = ns->contained; free (ns); + ns = NULL; /* Recursively free any contained namespaces. */ while (p != NULL) @@ -5106,23 +5108,6 @@ gfc_get_derived_super_type (gfc_symbol* derived) } -/* Get the ultimate super-type of a given derived type. */ - -gfc_symbol* -gfc_get_ultimate_derived_super_type (gfc_symbol* derived) -{ - if (!derived->attr.extension) - return NULL; - - derived = gfc_get_derived_super_type (derived); - - if (derived->attr.extension) - return gfc_get_ultimate_derived_super_type (derived); - else - return derived; -} - - /* Check if a derived type t2 is an extension of (or equal to) a type t1. */ bool @@ -5255,6 +5240,9 @@ gfc_sym_get_dummy_args (gfc_symbol *sym) { gfc_formal_arglist *dummies; + if (sym == NULL) + return NULL; + dummies = sym->formal; if (dummies == NULL && sym->ts.interface != NULL) dummies = sym->ts.interface->formal; diff --git a/gcc/fortran/target-memory.c b/gcc/fortran/target-memory.cc index 7b21a9e..7ce7d73 100644 --- a/gcc/fortran/target-memory.c +++ b/gcc/fortran/target-memory.cc @@ -1,5 +1,5 @@ /* Simulate storage of variables into target memory. - Copyright (C) 2007-2021 Free Software Foundation, Inc. + Copyright (C) 2007-2022 Free Software Foundation, Inc. Contributed by Paul Thomas and Brooks Moses This file is part of GCC. @@ -138,7 +138,6 @@ gfc_element_size (gfc_expr *e, size_t *siz) *siz = 0; return false; } - return true; } @@ -366,7 +365,8 @@ gfc_target_encode_expr (gfc_expr *source, unsigned char *buffer, static size_t -interpret_array (unsigned char *buffer, size_t buffer_size, gfc_expr *result) +interpret_array (unsigned char *buffer, size_t buffer_size, gfc_expr *result, + bool convert_widechar) { gfc_constructor_base base = NULL; size_t array_size = 1; @@ -391,7 +391,7 @@ interpret_array (unsigned char *buffer, size_t buffer_size, gfc_expr *result) gfc_constructor_append_expr (&base, e, &result->where); ptr += gfc_target_interpret_expr (&buffer[ptr], buffer_size - ptr, e, - true); + convert_widechar); } result->value.constructor = base; @@ -486,7 +486,7 @@ gfc_interpret_character (unsigned char *buffer, size_t buffer_size, result->value.character.string[result->value.character.length] = '\0'; - return result->value.character.length; + return size_character (result->value.character.length, result->ts.kind); } @@ -581,7 +581,7 @@ gfc_target_interpret_expr (unsigned char *buffer, size_t buffer_size, gfc_expr *result, bool convert_widechar) { if (result->expr_type == EXPR_ARRAY) - return interpret_array (buffer, buffer_size, result); + return interpret_array (buffer, buffer_size, result, convert_widechar); switch (result->ts.type) { @@ -653,7 +653,7 @@ gfc_target_interpret_expr (unsigned char *buffer, size_t buffer_size, /* --------------------------------------------------------------- */ -/* Two functions used by trans-common.c to write overlapping +/* Two functions used by trans-common.cc to write overlapping equivalence initializers to a buffer. This is added to the union and the original initializers freed. */ diff --git a/gcc/fortran/target-memory.h b/gcc/fortran/target-memory.h index 78ab650..7ffdcb2 100644 --- a/gcc/fortran/target-memory.h +++ b/gcc/fortran/target-memory.h @@ -1,5 +1,5 @@ /* Simulate storage of variables into target memory, header. - Copyright (C) 2007-2021 Free Software Foundation, Inc. + Copyright (C) 2007-2022 Free Software Foundation, Inc. Contributed by Paul Thomas and Brooks Moses This file is part of GCC. @@ -43,7 +43,7 @@ size_t gfc_interpret_character (unsigned char *, size_t, gfc_expr *); int gfc_interpret_derived (unsigned char *, size_t, gfc_expr *); size_t gfc_target_interpret_expr (unsigned char *, size_t, gfc_expr *, bool); -/* Merge overlapping equivalence initializers for trans-common.c. */ +/* Merge overlapping equivalence initializers for trans-common.cc. */ size_t gfc_merge_initializers (gfc_typespec, gfc_expr *, locus *, unsigned char *, unsigned char *, size_t); diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.cc index bceb8b2..cfb6eac 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.cc @@ -1,5 +1,5 @@ /* Array translation routines - Copyright (C) 2002-2021 Free Software Foundation, Inc. + Copyright (C) 2002-2022 Free Software Foundation, Inc. Contributed by Paul Brook <paul@nowt.org> and Steven Bosscher <s.bosscher@student.tudelft.nl> @@ -19,7 +19,7 @@ You should have received a copy of the GNU General Public License along with GCC; see the file COPYING3. If not see <http://www.gnu.org/licenses/>. */ -/* trans-array.c-- Various array related code, including scalarization, +/* trans-array.cc-- Various array related code, including scalarization, allocation, initialization and other support routines. */ /* How the scalarizer works. @@ -216,7 +216,7 @@ gfc_get_cfi_dim_sm (tree desc, tree idx) of an array descriptor. To understand these magic numbers, look at the comments - before gfc_build_array_type() in trans-types.c. + before gfc_build_array_type() in trans-types.cc. The code within these defines should be the only code which knows the format of an array descriptor. @@ -583,7 +583,7 @@ gfc_conv_shift_descriptor_lbound (stmtblock_t* block, tree desc, } -/* Obtain offsets for trans-types.c(gfc_get_array_descr_info). */ +/* Obtain offsets for trans-types.cc(gfc_get_array_descr_info). */ void gfc_get_descriptor_offsets_for_info (const_tree desc_type, tree *data_off, @@ -3010,7 +3010,8 @@ gfc_scalar_elemental_arg_saved_as_reference (gfc_ss_info * ss_info) /* If the expression is of polymorphic type, it's actual size is not known, so we avoid copying it anywhere. */ if (ss_info->data.scalar.dummy_arg - && ss_info->data.scalar.dummy_arg->ts.type == BT_CLASS + && gfc_dummy_arg_get_typespec (*ss_info->data.scalar.dummy_arg).type + == BT_CLASS && ss_info->expr->ts.type == BT_CLASS) return true; @@ -4161,7 +4162,7 @@ gfc_start_scalarized_body (gfc_loopinfo * loop, stmtblock_t * pbody) /* Generates the actual loop code for a scalarization loop. */ -void +static void gfc_trans_scalarized_loop_end (gfc_loopinfo * loop, int n, stmtblock_t * pbody) { @@ -4692,7 +4693,7 @@ done: desc = info->descriptor; - /* This is the run-time equivalent of resolve.c's + /* This is the run-time equivalent of resolve.cc's check_dimension(). The logical is more readable there than it is here, with all the trees. */ lbound = gfc_conv_array_lbound (desc, dim); @@ -5028,7 +5029,7 @@ gfc_could_be_alias (gfc_ss * lss, gfc_ss * rss) /* Resolve array data dependencies. Creates a temporary if required. */ /* TODO: Calc dependencies with gfc_expr rather than gfc_ss, and move to - dependency.c. */ + dependency.cc. */ void gfc_conv_resolve_dependencies (gfc_loopinfo * loop, gfc_ss * dest, @@ -7215,7 +7216,7 @@ gfc_get_dataptr_offset (stmtblock_t *block, tree parm, tree desc, tree offset, by adding up the string lengths of all the elements in the expression. Function with non-constant expressions have their string lengths mapped onto the actual arguments using the - interface mapping machinery in trans-expr.c. */ + interface mapping machinery in trans-expr.cc. */ static void get_array_charlen (gfc_expr *expr, gfc_se *se) { @@ -9101,6 +9102,10 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, continue; } + /* Do not broadcast a caf_token. These are local to the image. */ + if (attr->caf_token) + continue; + add_when_allocated = NULL_TREE; if (cmp_has_alloc_comps && !c->attr.pointer && !c->attr.proc_pointer) @@ -9133,10 +9138,13 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, if (attr->dimension) { tmp = gfc_get_element_type (TREE_TYPE (comp)); - ubound = gfc_full_array_size (&tmpblock, comp, - c->ts.type == BT_CLASS - ? CLASS_DATA (c)->as->rank - : c->as->rank); + if (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (comp))) + ubound = GFC_TYPE_ARRAY_SIZE (TREE_TYPE (comp)); + else + ubound = gfc_full_array_size (&tmpblock, comp, + c->ts.type == BT_CLASS + ? CLASS_DATA (c)->as->rank + : c->as->rank); } else { @@ -9144,26 +9152,39 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, ubound = build_int_cst (gfc_array_index_type, 1); } - cdesc = gfc_get_array_type_bounds (tmp, 1, 0, &gfc_index_one_node, - &ubound, 1, - GFC_ARRAY_ALLOCATABLE, false); + /* Treat strings like arrays. Or the other way around, do not + * generate an additional array layer for scalar components. */ + if (attr->dimension || c->ts.type == BT_CHARACTER) + { + cdesc = gfc_get_array_type_bounds (tmp, 1, 0, &gfc_index_one_node, + &ubound, 1, + GFC_ARRAY_ALLOCATABLE, false); - cdesc = gfc_create_var (cdesc, "cdesc"); - DECL_ARTIFICIAL (cdesc) = 1; + cdesc = gfc_create_var (cdesc, "cdesc"); + DECL_ARTIFICIAL (cdesc) = 1; - gfc_add_modify (&tmpblock, gfc_conv_descriptor_dtype (cdesc), - gfc_get_dtype_rank_type (1, tmp)); - gfc_conv_descriptor_lbound_set (&tmpblock, cdesc, - gfc_index_zero_node, - gfc_index_one_node); - gfc_conv_descriptor_stride_set (&tmpblock, cdesc, - gfc_index_zero_node, - gfc_index_one_node); - gfc_conv_descriptor_ubound_set (&tmpblock, cdesc, - gfc_index_zero_node, ubound); + gfc_add_modify (&tmpblock, gfc_conv_descriptor_dtype (cdesc), + gfc_get_dtype_rank_type (1, tmp)); + gfc_conv_descriptor_lbound_set (&tmpblock, cdesc, + gfc_index_zero_node, + gfc_index_one_node); + gfc_conv_descriptor_stride_set (&tmpblock, cdesc, + gfc_index_zero_node, + gfc_index_one_node); + gfc_conv_descriptor_ubound_set (&tmpblock, cdesc, + gfc_index_zero_node, ubound); + } + else + /* Prevent warning. */ + cdesc = NULL_TREE; if (attr->dimension) - comp = gfc_conv_descriptor_data_get (comp); + { + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (comp))) + comp = gfc_conv_descriptor_data_get (comp); + else + comp = gfc_build_addr_expr (NULL_TREE, comp); + } else { gfc_se se; @@ -9171,14 +9192,18 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, gfc_init_se (&se, NULL); comp = gfc_conv_scalar_to_descriptor (&se, comp, - c->ts.type == BT_CLASS - ? CLASS_DATA (c)->attr - : c->attr); - comp = gfc_build_addr_expr (NULL_TREE, comp); + c->ts.type == BT_CLASS + ? CLASS_DATA (c)->attr + : c->attr); + if (c->ts.type == BT_CHARACTER) + comp = gfc_build_addr_expr (NULL_TREE, comp); gfc_add_block_to_block (&tmpblock, &se.pre); } - gfc_conv_descriptor_data_set (&tmpblock, cdesc, comp); + if (attr->dimension || c->ts.type == BT_CHARACTER) + gfc_conv_descriptor_data_set (&tmpblock, cdesc, comp); + else + cdesc = comp; tree fndecl; @@ -11460,6 +11485,62 @@ gfc_get_proc_ifc_for_expr (gfc_expr *procedure_ref) } +/* Given an expression referring to an intrinsic function call, + return the intrinsic symbol. */ + +gfc_intrinsic_sym * +gfc_get_intrinsic_for_expr (gfc_expr *call) +{ + if (call == NULL) + return NULL; + + /* Normal procedure case. */ + if (call->expr_type == EXPR_FUNCTION) + return call->value.function.isym; + else + return NULL; +} + + +/* Indicates whether an argument to an intrinsic function should be used in + scalarization. It is usually the case, except for some intrinsics + requiring the value to be constant, and using the value at compile time only. + As the value is not used at runtime in those cases, we don’t produce code + for it, and it should not be visible to the scalarizer. + FUNCTION is the intrinsic function being called, ACTUAL_ARG is the actual + argument being examined in that call, and ARG_NUM the index number + of ACTUAL_ARG in the list of arguments. + The intrinsic procedure’s dummy argument associated with ACTUAL_ARG is + identified using the name in ACTUAL_ARG if it is present (that is: if it’s + a keyword argument), otherwise using ARG_NUM. */ + +static bool +arg_evaluated_for_scalarization (gfc_intrinsic_sym *function, + gfc_dummy_arg *dummy_arg) +{ + if (function != NULL && dummy_arg != NULL) + { + switch (function->id) + { + case GFC_ISYM_INDEX: + case GFC_ISYM_LEN_TRIM: + case GFC_ISYM_MASKL: + case GFC_ISYM_MASKR: + case GFC_ISYM_SCAN: + case GFC_ISYM_VERIFY: + if (strcmp ("kind", gfc_dummy_arg_get_name (*dummy_arg)) == 0) + return false; + /* Fallthrough. */ + + default: + break; + } + } + + return true; +} + + /* Walk the arguments of an elemental function. PROC_EXPR is used to check whether an argument is permitted to be absent. If it is NULL, we don't do the check and the argument is assumed to be present. @@ -11467,9 +11548,9 @@ gfc_get_proc_ifc_for_expr (gfc_expr *procedure_ref) gfc_ss * gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg, - gfc_symbol *proc_ifc, gfc_ss_type type) + gfc_intrinsic_sym *intrinsic_sym, + gfc_ss_type type) { - gfc_formal_arglist *dummy_arg; int scalar; gfc_ss *head; gfc_ss *tail; @@ -11478,16 +11559,14 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg, head = gfc_ss_terminator; tail = NULL; - if (proc_ifc) - dummy_arg = gfc_sym_get_dummy_args (proc_ifc); - else - dummy_arg = NULL; - scalar = 1; for (; arg; arg = arg->next) { - if (!arg->expr || arg->expr->expr_type == EXPR_NULL) - goto loop_continue; + gfc_dummy_arg * const dummy_arg = arg->associated_dummy; + if (!arg->expr + || arg->expr->expr_type == EXPR_NULL + || !arg_evaluated_for_scalarization (intrinsic_sym, dummy_arg)) + continue; newss = gfc_walk_subexpr (head, arg->expr); if (newss == head) @@ -11497,13 +11576,13 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg, newss = gfc_get_scalar_ss (head, arg->expr); newss->info->type = type; if (dummy_arg) - newss->info->data.scalar.dummy_arg = dummy_arg->sym; + newss->info->data.scalar.dummy_arg = dummy_arg; } else scalar = 0; if (dummy_arg != NULL - && dummy_arg->sym->attr.optional + && gfc_dummy_arg_is_optional (*dummy_arg) && arg->expr->expr_type == EXPR_VARIABLE && (gfc_expr_attr (arg->expr).optional || gfc_expr_attr (arg->expr).allocatable @@ -11517,10 +11596,6 @@ gfc_walk_elemental_function_args (gfc_ss * ss, gfc_actual_arglist *arg, while (tail->next != gfc_ss_terminator) tail = tail->next; } - -loop_continue: - if (dummy_arg != NULL) - dummy_arg = dummy_arg->next; } if (scalar) @@ -11579,7 +11654,7 @@ gfc_walk_function_expr (gfc_ss * ss, gfc_expr * expr) ss = gfc_walk_elemental_function_args (old_ss, expr->value.function.actual, - gfc_get_proc_ifc_for_expr (expr), + gfc_get_intrinsic_for_expr (expr), GFC_SS_REFERENCE); if (ss != old_ss && (comp diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h index 1d3dc48..04fee61 100644 --- a/gcc/fortran/trans-array.h +++ b/gcc/fortran/trans-array.h @@ -1,5 +1,5 @@ /* Header for array handling functions - Copyright (C) 2002-2021 Free Software Foundation, Inc. + Copyright (C) 2002-2022 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of GCC. @@ -76,6 +76,8 @@ void gfc_trans_static_array_pointer (gfc_symbol *); /* Get the procedure interface for a function call. */ gfc_symbol *gfc_get_proc_ifc_for_expr (gfc_expr *); +/* Get the intrinsic symbol for an intrinsic function call. */ +gfc_intrinsic_sym *gfc_get_intrinsic_for_expr (gfc_expr *); /* Generate scalarization information for an expression. */ gfc_ss *gfc_walk_expr (gfc_expr *); /* Workhorse for gfc_walk_expr. */ @@ -84,7 +86,8 @@ gfc_ss *gfc_walk_subexpr (gfc_ss *, gfc_expr *); gfc_ss *gfc_walk_array_ref (gfc_ss *, gfc_expr *, gfc_ref * ref); /* Walk the arguments of an elemental function. */ gfc_ss *gfc_walk_elemental_function_args (gfc_ss *, gfc_actual_arglist *, - gfc_symbol *, gfc_ss_type); + gfc_intrinsic_sym *, + gfc_ss_type); /* Walk an intrinsic function. */ gfc_ss *gfc_walk_intrinsic_function (gfc_ss *, gfc_expr *, gfc_intrinsic_sym *); @@ -118,8 +121,6 @@ void gfc_copy_loopinfo_to_se (gfc_se *, gfc_loopinfo *); /* Marks the start of a scalarized expression, and declares loop variables. */ void gfc_start_scalarized_body (gfc_loopinfo *, stmtblock_t *); -/* Generates one actual loop for a scalarized expression. */ -void gfc_trans_scalarized_loop_end (gfc_loopinfo *, int, stmtblock_t *); /* Generates the actual loops for a scalarized expression. */ void gfc_trans_scalarizing_loops (gfc_loopinfo *, stmtblock_t *); /* Mark the end of the main loop body and the start of the copying loop. */ @@ -137,8 +138,6 @@ tree gfc_build_null_descriptor (tree); void gfc_conv_array_ref (gfc_se *, gfc_array_ref *, gfc_expr *, locus *); /* Translate a reference to a temporary array. */ void gfc_conv_tmp_array_ref (gfc_se * se); -/* Translate a reference to an array temporary. */ -void gfc_conv_tmp_ref (gfc_se *); /* Calculate the overall offset, including subreferences. */ void gfc_get_dataptr_offset (stmtblock_t*, tree, tree, tree, bool, gfc_expr*); @@ -149,8 +148,6 @@ void gfc_conv_expr_descriptor (gfc_se *, gfc_expr *); /* Convert an array for passing as an actual function parameter. */ void gfc_conv_array_parameter (gfc_se *, gfc_expr *, bool, const gfc_symbol *, const char *, tree *); -/* Evaluate and transpose a matrix expression. */ -void gfc_conv_array_transpose (gfc_se *, gfc_expr *); /* These work with both descriptors and descriptorless arrays. */ tree gfc_conv_array_data (tree); diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.cc index 7bcf18d..7c8cba0 100644 --- a/gcc/fortran/trans-common.c +++ b/gcc/fortran/trans-common.cc @@ -1,5 +1,5 @@ /* Common block and equivalence list handling - Copyright (C) 2000-2021 Free Software Foundation, Inc. + Copyright (C) 2000-2022 Free Software Foundation, Inc. Contributed by Canqun Yang <canqun@nudt.edu.cn> This file is part of GCC. @@ -338,6 +338,13 @@ build_field (segment_info *h, tree union_type, record_layout_info rli) h->field = field; } +#if !defined (NO_DOT_IN_LABEL) +#define GFC_EQUIV_FMT "equiv.%d" +#elif !defined (NO_DOLLAR_IN_LABEL) +#define GFC_EQUIV_FMT "_Equiv$%d" +#else +#define GFC_EQUIV_FMT "_Equiv_%d" +#endif /* Get storage for local equivalence. */ @@ -356,7 +363,7 @@ build_equiv_decl (tree union_type, bool is_init, bool is_saved, bool is_auto) return decl; } - snprintf (name, sizeof (name), "equiv.%d", serial++); + snprintf (name, sizeof (name), GFC_EQUIV_FMT, serial++); decl = build_decl (input_location, VAR_DECL, get_identifier (name), union_type); DECL_ARTIFICIAL (decl) = 1; diff --git a/gcc/fortran/trans-const.c b/gcc/fortran/trans-const.cc index f742708..7b18fb4 100644 --- a/gcc/fortran/trans-const.c +++ b/gcc/fortran/trans-const.cc @@ -1,5 +1,5 @@ /* Translation of constants - Copyright (C) 2002-2021 Free Software Foundation, Inc. + Copyright (C) 2002-2022 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of GCC. @@ -18,7 +18,7 @@ You should have received a copy of the GNU General Public License along with GCC; see the file COPYING3. If not see <http://www.gnu.org/licenses/>. */ -/* trans-const.c -- convert constant values */ +/* trans-const.cc -- convert constant values */ #include "config.h" #include "system.h" diff --git a/gcc/fortran/trans-const.h b/gcc/fortran/trans-const.h index 0621e15..e82f0ce 100644 --- a/gcc/fortran/trans-const.h +++ b/gcc/fortran/trans-const.h @@ -1,5 +1,5 @@ /* Header for code constant translation functions - Copyright (C) 2002-2021 Free Software Foundation, Inc. + Copyright (C) 2002-2022 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of GCC. diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.cc index 49ba906..6493cc2 100644 --- a/gcc/fortran/trans-decl.c +++ b/gcc/fortran/trans-decl.cc @@ -1,5 +1,5 @@ /* Backend function setup - Copyright (C) 2002-2021 Free Software Foundation, Inc. + Copyright (C) 2002-2022 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of GCC. @@ -18,7 +18,7 @@ You should have received a copy of the GNU General Public License along with GCC; see the file COPYING3. If not see <http://www.gnu.org/licenses/>. */ -/* trans-decl.c -- Handling of backend function and variable decls, etc */ +/* trans-decl.cc -- Handling of backend function and variable decls, etc */ #include "config.h" #include "system.h" @@ -42,7 +42,6 @@ along with GCC; see the file COPYING3. If not see #include "trans-types.h" #include "trans-array.h" #include "trans-const.h" -#include "intrinsic.h" /* For gfc_resolve_index_func. */ /* Only for gfc_trans_code. Shouldn't need to include this. */ #include "trans-stmt.h" #include "gomp-constants.h" @@ -172,7 +171,7 @@ tree gfor_fndecl_caf_random_init; /* Math functions. Many other math functions are handled in - trans-intrinsic.c. */ + trans-intrinsic.cc. */ gfc_powdecl_list gfor_fndecl_math_powi[4][3]; tree gfor_fndecl_math_ishftc4; @@ -648,6 +647,9 @@ gfc_finish_var_decl (tree decl, gfc_symbol * sym) && sym->ns->proc_name->attr.flavor == FL_LABEL) /* This is a BLOCK construct. */ add_decl_as_local (decl); + else if (sym->ns->omp_affinity_iterators) + /* This is a block-local iterator. */ + add_decl_as_local (decl); else gfc_add_decl_to_parent_function (decl); } @@ -2267,28 +2269,7 @@ module_sym: { /* All specific intrinsics take less than 5 arguments. */ gcc_assert (isym->formal->next->next->next->next == NULL); - if (isym->resolve.f1m == gfc_resolve_index_func) - { - /* gfc_resolve_index_func is special because it takes a - gfc_actual_arglist instead of individual arguments. */ - gfc_actual_arglist *a, *n; - int i; - a = gfc_get_actual_arglist(); - n = a; - - for (i = 0; i < 4; i++) - { - n->next = gfc_get_actual_arglist(); - n = n->next; - } - - a->expr = &argexpr; - isym->resolve.f1m (&e, a); - a->expr = NULL; - gfc_free_actual_arglist (a); - } - else - isym->resolve.f4 (&e, &argexpr, NULL, NULL, NULL); + isym->resolve.f4 (&e, &argexpr, NULL, NULL, NULL); } } } @@ -2918,7 +2899,7 @@ trans_function_start (gfc_symbol * sym) allocate_struct_function (fndecl, false); - /* function.c requires a push at the start of the function. */ + /* function.cc requires a push at the start of the function. */ pushlevel (); } @@ -3624,8 +3605,9 @@ gfc_build_intrinsic_function_decls (void) rtype = gfc_get_real_type (rkinds[rkind]); if (rtype && itype) { - sprintf (name, PREFIX("pow_r%d_i%d"), rkinds[rkind], - ikinds[ikind]); + sprintf (name, PREFIX("pow_r%d_i%d"), + gfc_type_abi_kind (BT_REAL, rkinds[rkind]), + ikinds[ikind]); gfor_fndecl_math_powi[rkind][ikind].real = gfc_build_library_function_decl (get_identifier (name), rtype, 2, rtype, itype); @@ -3636,8 +3618,9 @@ gfc_build_intrinsic_function_decls (void) ctype = gfc_get_complex_type (rkinds[rkind]); if (ctype && itype) { - sprintf (name, PREFIX("pow_c%d_i%d"), rkinds[rkind], - ikinds[ikind]); + sprintf (name, PREFIX("pow_c%d_i%d"), + gfc_type_abi_kind (BT_REAL, rkinds[rkind]), + ikinds[ikind]); gfor_fndecl_math_powi[rkind][ikind].cmplx = gfc_build_library_function_decl (get_identifier (name), ctype, 2,ctype, itype); @@ -4515,7 +4498,7 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) if (el->sym != el->sym->result) break; } - /* TODO: move to the appropriate place in resolve.c. */ + /* TODO: move to the appropriate place in resolve.cc. */ if (warn_return_type > 0 && el == NULL) gfc_warning (OPT_Wreturn_type, "Return value of function %qs at %L not set", @@ -6002,7 +5985,7 @@ generate_local_decl (gfc_symbol * sym) } else if (sym->attr.flavor == FL_PROCEDURE) { - /* TODO: move to the appropriate place in resolve.c. */ + /* TODO: move to the appropriate place in resolve.cc. */ if (warn_return_type > 0 && sym->attr.function && sym->result @@ -6023,15 +6006,20 @@ generate_local_decl (gfc_symbol * sym) if (sym->attr.dummy == 1) { - /* Modify the tree type for scalar character dummy arguments of bind(c) - procedures if they are passed by value. The tree type for them will - be promoted to INTEGER_TYPE for the middle end, which appears to be - what C would do with characters passed by-value. The value attribute - implies the dummy is a scalar. */ + /* The tree type for scalar character dummy arguments of BIND(C) + procedures, if they are passed by value, should be unsigned char. + The value attribute implies the dummy is a scalar. */ if (sym->attr.value == 1 && sym->backend_decl != NULL && sym->ts.type == BT_CHARACTER && sym->ts.is_c_interop && sym->ns->proc_name != NULL && sym->ns->proc_name->attr.is_bind_c) - gfc_conv_scalar_char_value (sym, NULL, NULL); + { + /* We used to modify the tree here. Now it is done earlier in + the front-end, so we only check it here to avoid regressions. */ + gcc_assert (TREE_CODE (TREE_TYPE (sym->backend_decl)) == INTEGER_TYPE); + gcc_assert (TYPE_UNSIGNED (TREE_TYPE (sym->backend_decl)) == 1); + gcc_assert (TYPE_PRECISION (TREE_TYPE (sym->backend_decl)) == CHAR_TYPE_SIZE); + gcc_assert (DECL_BY_REFERENCE (sym->backend_decl) == 0); + } /* Unused procedure passed as dummy argument. */ if (sym->attr.flavor == FL_PROCEDURE) @@ -7738,7 +7726,7 @@ gfc_generate_function_code (gfc_namespace * ns) if (result == NULL_TREE || artificial_result_decl) { - /* TODO: move to the appropriate place in resolve.c. */ + /* TODO: move to the appropriate place in resolve.cc. */ if (warn_return_type > 0 && sym == sym->result) gfc_warning (OPT_Wreturn_type, "Return value of function %qs at %L not set", diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.cc index 2d7f9e0..eb6a78c 100644 --- a/gcc/fortran/trans-expr.c +++ b/gcc/fortran/trans-expr.cc @@ -1,5 +1,5 @@ /* Expression translation - Copyright (C) 2002-2021 Free Software Foundation, Inc. + Copyright (C) 2002-2022 Free Software Foundation, Inc. Contributed by Paul Brook <paul@nowt.org> and Steven Bosscher <s.bosscher@student.tudelft.nl> @@ -19,7 +19,7 @@ You should have received a copy of the GNU General Public License along with GCC; see the file COPYING3. If not see <http://www.gnu.org/licenses/>. */ -/* trans-expr.c-- generate GENERIC trees for gfc_expr. */ +/* trans-expr.cc-- generate GENERIC trees for gfc_expr. */ #include "config.h" #include "system.h" @@ -41,18 +41,19 @@ along with GCC; see the file COPYING3. If not see #include "trans-stmt.h" #include "dependency.h" #include "gimplify.h" +#include "tm.h" /* For CHAR_TYPE_SIZE. */ /* Calculate the number of characters in a string. */ -tree +static tree gfc_get_character_len (tree type) { tree len; - + gcc_assert (type && TREE_CODE (type) == ARRAY_TYPE && TYPE_STRING_FLAG (type)); - + len = TYPE_MAX_VALUE (TYPE_DOMAIN (type)); len = (len) ? (len) : (integer_zero_node); return fold_convert (gfc_charlen_type_node, len); @@ -66,10 +67,10 @@ tree gfc_get_character_len_in_bytes (tree type) { tree tmp, len; - + gcc_assert (type && TREE_CODE (type) == ARRAY_TYPE && TYPE_STRING_FLAG (type)); - + tmp = TYPE_SIZE_UNIT (TREE_TYPE (type)); tmp = (tmp && !integer_zerop (tmp)) ? (fold_convert (gfc_charlen_type_node, tmp)) : (NULL_TREE); @@ -278,7 +279,7 @@ gfc_class_len_get (tree decl) /* Try to get the _len component of a class. When the class is not unlimited poly, i.e. no _len field exists, then return a zero node. */ -tree +static tree gfc_class_len_or_zero_get (tree decl) { tree len; @@ -382,7 +383,7 @@ VTAB_GET_FIELD_GEN (def_init, VTABLE_DEF_INIT_FIELD) VTAB_GET_FIELD_GEN (copy, VTABLE_COPY_FIELD) VTAB_GET_FIELD_GEN (final, VTABLE_FINAL_FIELD) VTAB_GET_FIELD_GEN (deallocate, VTABLE_DEALLOCATE_FIELD) - +#undef VTAB_GET_FIELD_GEN /* The size field is returned as an array index type. Therefore treat it and only it specially. */ @@ -423,13 +424,13 @@ gfc_vptr_size_get (tree vptr) /* IF ts is null (default), search for the last _class ref in the chain of references of the expression and cut the chain there. Although - this routine is similiar to class.c:gfc_add_component_ref (), there + this routine is similiar to class.cc:gfc_add_component_ref (), there is a significant difference: gfc_add_component_ref () concentrates on an array ref that is the last ref in the chain and is oblivious to the kind of refs following. ELSE IF ts is non-null the cut is at the class entity or component that is followed by an array reference, which is not an element. - These calls come from trans-array.c:build_class_array_ref, which + These calls come from trans-array.cc:build_class_array_ref, which handles scalarized class array references.*/ gfc_expr * @@ -1367,7 +1368,7 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e, gfc_typespec class_ts, /* Given a class array declaration and an index, returns the address of the referenced element. */ -tree +static tree gfc_get_class_array_ref (tree index, tree class_decl, tree data_comp, bool unlimited) { @@ -1646,7 +1647,7 @@ gfc_trans_class_array_init_assign (gfc_expr *rhs, gfc_expr *lhs, gfc_expr *obj) gfc_add_component_ref (ppc, "_copy"); ppc_code = gfc_get_code (EXEC_CALL); ppc_code->resolved_sym = ppc->symtree->n.sym; - /* Although '_copy' is set to be elemental in class.c, it is + /* Although '_copy' is set to be elemental in class.cc, it is not staying that way. Find out why, sometime.... */ ppc_code->resolved_sym->attr.elemental = 1; ppc_code->ext.actual = actual; @@ -3188,7 +3189,7 @@ gfc_conv_unary_op (enum tree_code code, gfc_se * se, gfc_expr * expr) with the first node being one. */ #define POWI_TABLE_SIZE 256 -/* The table is from builtins.c. */ +/* The table is from builtins.cc. */ static const unsigned char powi_table[POWI_TABLE_SIZE] = { 0, 1, 1, 2, 2, 3, 3, 4, /* 0 - 7 */ @@ -3972,63 +3973,50 @@ gfc_string_to_single_character (tree len, tree str, int kind) } -void -gfc_conv_scalar_char_value (gfc_symbol *sym, gfc_se *se, gfc_expr **expr) +static void +conv_scalar_char_value (gfc_symbol *sym, gfc_se *se, gfc_expr **expr) { + gcc_assert (expr); + /* We used to modify the tree here. Now it is done earlier in + the front-end, so we only check it here to avoid regressions. */ if (sym->backend_decl) { - /* This becomes the nominal_type in - function.c:assign_parm_find_data_types. */ - TREE_TYPE (sym->backend_decl) = unsigned_char_type_node; - /* This becomes the passed_type in - function.c:assign_parm_find_data_types. C promotes char to - integer for argument passing. */ - DECL_ARG_TYPE (sym->backend_decl) = unsigned_type_node; - - DECL_BY_REFERENCE (sym->backend_decl) = 0; + gcc_assert (TREE_CODE (TREE_TYPE (sym->backend_decl)) == INTEGER_TYPE); + gcc_assert (TYPE_UNSIGNED (TREE_TYPE (sym->backend_decl)) == 1); + gcc_assert (TYPE_PRECISION (TREE_TYPE (sym->backend_decl)) == CHAR_TYPE_SIZE); + gcc_assert (DECL_BY_REFERENCE (sym->backend_decl) == 0); } - if (expr != NULL) + /* If we have a constant character expression, make it into an + integer of type C char. */ + if ((*expr)->expr_type == EXPR_CONSTANT) { - /* If we have a constant character expression, make it into an - integer. */ - if ((*expr)->expr_type == EXPR_CONSTANT) - { - gfc_typespec ts; - gfc_clear_ts (&ts); + gfc_typespec ts; + gfc_clear_ts (&ts); - *expr = gfc_get_int_expr (gfc_default_integer_kind, NULL, - (int)(*expr)->value.character.string[0]); - if ((*expr)->ts.kind != gfc_c_int_kind) - { - /* The expr needs to be compatible with a C int. If the - conversion fails, then the 2 causes an ICE. */ - ts.type = BT_INTEGER; - ts.kind = gfc_c_int_kind; - gfc_convert_type (*expr, &ts, 2); - } + *expr = gfc_get_int_expr (gfc_default_character_kind, NULL, + (*expr)->value.character.string[0]); + } + else if (se != NULL && (*expr)->expr_type == EXPR_VARIABLE) + { + if ((*expr)->ref == NULL) + { + se->expr = gfc_string_to_single_character + (build_int_cst (integer_type_node, 1), + gfc_build_addr_expr (gfc_get_pchar_type ((*expr)->ts.kind), + gfc_get_symbol_decl + ((*expr)->symtree->n.sym)), + (*expr)->ts.kind); } - else if (se != NULL && (*expr)->expr_type == EXPR_VARIABLE) - { - if ((*expr)->ref == NULL) - { - se->expr = gfc_string_to_single_character - (build_int_cst (integer_type_node, 1), - gfc_build_addr_expr (gfc_get_pchar_type ((*expr)->ts.kind), - gfc_get_symbol_decl - ((*expr)->symtree->n.sym)), - (*expr)->ts.kind); - } - else - { - gfc_conv_variable (se, *expr); - se->expr = gfc_string_to_single_character - (build_int_cst (integer_type_node, 1), - gfc_build_addr_expr (gfc_get_pchar_type ((*expr)->ts.kind), - se->expr), - (*expr)->ts.kind); - } + else + { + gfc_conv_variable (se, *expr); + se->expr = gfc_string_to_single_character + (build_int_cst (integer_type_node, 1), + gfc_build_addr_expr (gfc_get_pchar_type ((*expr)->ts.kind), + se->expr), + (*expr)->ts.kind); } } } @@ -4531,7 +4519,7 @@ gfc_add_interface_mapping (gfc_interface_mapping * mapping, the length of each argument, adding any initialization code to PRE and any finalization code to POST. */ -void +static void gfc_finish_interface_mapping (gfc_interface_mapping * mapping, stmtblock_t * pre, stmtblock_t * post) { @@ -5548,13 +5536,17 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym) { /* If the actual argument can be noncontiguous, copy-in/out is required, if the dummy has either the CONTIGUOUS attribute or is an assumed- - length assumed-length/assumed-size CHARACTER array. */ + length assumed-length/assumed-size CHARACTER array. This only + applies if the actual argument is a "variable"; if it's some + non-lvalue expression, we are going to evaluate it to a + temporary below anyway. */ se.force_no_tmp = 1; if ((fsym->attr.contiguous || (fsym->ts.type == BT_CHARACTER && !fsym->ts.u.cl->length && (fsym->as->type == AS_ASSUMED_SIZE || fsym->as->type == AS_EXPLICIT))) - && !gfc_is_simply_contiguous (e, false, true)) + && !gfc_is_simply_contiguous (e, false, true) + && gfc_expr_is_variable (e)) { bool optional = fsym->attr.optional; fsym->attr.optional = 0; @@ -5638,6 +5630,16 @@ gfc_conv_gfc_desc_to_cfi_desc (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym) itype = CFI_type_other; // FIXME: Or CFI_type_cptr ? break; case BT_CLASS: + if (UNLIMITED_POLY (e) && fsym->ts.type == BT_ASSUMED) + { + // F2017: 7.3.2.2: "An entity that is declared using the TYPE(*) + // type specifier is assumed-type and is an unlimited polymorphic + // entity." The actual argument _data component is passed. + itype = CFI_type_other; // FIXME: Or CFI_type_cptr ? + break; + } + else + gcc_unreachable (); case BT_PROCEDURE: case BT_HOLLERITH: case BT_UNION: @@ -6157,7 +6159,10 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, { /* Pass a NULL pointer for an absent arg. */ parmse.expr = null_pointer_node; - if (arg->missing_arg_type == BT_CHARACTER) + gfc_dummy_arg * const dummy_arg = arg->associated_dummy; + if (dummy_arg + && gfc_dummy_arg_get_typespec (*dummy_arg).type + == BT_CHARACTER) parmse.string_length = build_int_cst (gfc_charlen_type_node, 0); } @@ -6174,7 +6179,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, || !CLASS_DATA (fsym)->attr.allocatable)); gfc_init_se (&parmse, NULL); parmse.expr = null_pointer_node; - if (arg->missing_arg_type == BT_CHARACTER) + if (arg->associated_dummy + && gfc_dummy_arg_get_typespec (*arg->associated_dummy).type + == BT_CHARACTER) parmse.string_length = build_int_cst (gfc_charlen_type_node, 0); } else if (fsym && fsym->ts.type == BT_CLASS @@ -6336,7 +6343,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, && fsym->ns->proc_name->attr.is_bind_c) { parmse.expr = NULL; - gfc_conv_scalar_char_value (fsym, &parmse, &e); + conv_scalar_char_value (fsym, &parmse, &e); if (parmse.expr == NULL) gfc_conv_expr (&parmse, e); } @@ -6848,6 +6855,8 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, fsym->attr.pointer); } else + /* This is where we introduce a temporary to store the + result of a non-lvalue array expression. */ gfc_conv_array_parameter (&parmse, e, nodesc_arg, fsym, sym->name, NULL); @@ -7007,7 +7016,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, deallocated for non-variable scalars, array arguments to elemental procedures, and array arguments with descriptor to non-elemental procedures. As bounds information for descriptorless arrays is no - longer available here, they are dealt with in trans-array.c + longer available here, they are dealt with in trans-array.cc (gfc_conv_array_parameter). */ if (e && (e->ts.type == BT_DERIVED || e->ts.type == BT_CLASS) && e->ts.u.derived->attr.alloc_comp @@ -7385,7 +7394,7 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, if (ts.u.cl->length == NULL) { /* Assumed character length results are not allowed by C418 of the 2003 - standard and are trapped in resolve.c; except in the case of SPREAD + standard and are trapped in resolve.cc; except in the case of SPREAD (and other intrinsics?) and dummy functions. In the case of SPREAD, we take the character length of the first argument for the result. For dummies, we have to look through the formal argument list for @@ -10838,7 +10847,7 @@ gfc_trans_arrayfunc_assign (gfc_expr * expr1, gfc_expr * expr2) the shape of the result is unknown and, in any case, the function must correctly take care of the reallocation internally. For intrinsic calls, the array data is freed and the library takes care of allocation. - TODO: Add logic of trans-array.c: gfc_alloc_allocatable_for_assignment + TODO: Add logic of trans-array.cc: gfc_alloc_allocatable_for_assignment to the library. */ if (flag_realloc_lhs && gfc_is_reallocatable_lhs (expr1) @@ -11074,14 +11083,9 @@ gfc_expr_is_variable (gfc_expr *expr) func_ifc = expr->value.function.esym; goto found_ifc; } - else - { - gcc_assert (expr->symtree); - func_ifc = expr->symtree->n.sym; - goto found_ifc; - } - - gcc_unreachable (); + gcc_assert (expr->symtree); + func_ifc = expr->symtree->n.sym; + goto found_ifc; } comp = gfc_get_proc_ptr_comp (expr); diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.cc index 0d91958..e680de1 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.cc @@ -1,5 +1,5 @@ /* Intrinsic translation - Copyright (C) 2002-2021 Free Software Foundation, Inc. + Copyright (C) 2002-2022 Free Software Foundation, Inc. Contributed by Paul Brook <paul@nowt.org> and Steven Bosscher <s.bosscher@student.tudelft.nl> @@ -19,7 +19,7 @@ You should have received a copy of the GNU General Public License along with GCC; see the file COPYING3. If not see <http://www.gnu.org/licenses/>. */ -/* trans-intrinsic.c-- generate GENERIC trees for calls to intrinsics. */ +/* trans-intrinsic.cc-- generate GENERIC trees for calls to intrinsics. */ #include "config.h" #include "system.h" @@ -154,7 +154,9 @@ builtin_decl_for_precision (enum built_in_function base_built_in, i = m->float_built_in; else if (precision == TYPE_PRECISION (double_type_node)) i = m->double_built_in; - else if (precision == TYPE_PRECISION (long_double_type_node)) + else if (precision == TYPE_PRECISION (long_double_type_node) + && (!gfc_real16_is_float128 + || long_double_type_node != gfc_float128_type_node)) i = m->long_double_built_in; else if (precision == TYPE_PRECISION (gfc_float128_type_node)) { @@ -881,7 +883,7 @@ gfc_get_intrinsic_lib_fndecl (gfc_intrinsic_map_t * m, gfc_expr * expr) { snprintf (name, sizeof (name), PREFIX ("%s_%c%d"), m->name, ts->type == BT_COMPLEX ? 'c' : 'r', - ts->kind); + gfc_type_abi_kind (ts)); } argtypes = NULL; @@ -2618,7 +2620,7 @@ conv_intrinsic_image_status (gfc_se *se, gfc_expr *expr) else gcc_unreachable (); - se->expr = tmp; + se->expr = fold_convert (gfc_get_int_type (gfc_default_integer_kind), tmp); } static void @@ -2660,7 +2662,7 @@ conv_intrinsic_team_number (gfc_se *se, gfc_expr *expr) else gcc_unreachable (); - se->expr = tmp; + se->expr = fold_convert (gfc_get_int_type (gfc_default_integer_kind), tmp); } @@ -4555,6 +4557,18 @@ rad2deg (int kind) } +static gfc_intrinsic_map_t * +gfc_lookup_intrinsic (gfc_isym_id id) +{ + gfc_intrinsic_map_t *m = gfc_intrinsic_map; + for (; m->id != GFC_ISYM_NONE || m->double_built_in != END_BUILTINS; m++) + if (id == m->id) + break; + gcc_assert (id == m->id); + return m; +} + + /* ACOSD(x) is translated into ACOS(x) * 180 / pi. ASIND(x) is translated into ASIN(x) * 180 / pi. ATAND(x) is translated into ATAN(x) * 180 / pi. */ @@ -4565,20 +4579,27 @@ gfc_conv_intrinsic_atrigd (gfc_se * se, gfc_expr * expr, gfc_isym_id id) tree arg; tree atrigd; tree type; + gfc_intrinsic_map_t *m; type = gfc_typenode_for_spec (&expr->ts); gfc_conv_intrinsic_function_args (se, expr, &arg, 1); - if (id == GFC_ISYM_ACOSD) - atrigd = gfc_builtin_decl_for_float_kind (BUILT_IN_ACOS, expr->ts.kind); - else if (id == GFC_ISYM_ASIND) - atrigd = gfc_builtin_decl_for_float_kind (BUILT_IN_ASIN, expr->ts.kind); - else if (id == GFC_ISYM_ATAND) - atrigd = gfc_builtin_decl_for_float_kind (BUILT_IN_ATAN, expr->ts.kind); - else - gcc_unreachable (); - + switch (id) + { + case GFC_ISYM_ACOSD: + m = gfc_lookup_intrinsic (GFC_ISYM_ACOS); + break; + case GFC_ISYM_ASIND: + m = gfc_lookup_intrinsic (GFC_ISYM_ASIN); + break; + case GFC_ISYM_ATAND: + m = gfc_lookup_intrinsic (GFC_ISYM_ATAN); + break; + default: + gcc_unreachable (); + } + atrigd = gfc_get_intrinsic_lib_fndecl (m, expr); atrigd = build_call_expr_loc (input_location, atrigd, 1, arg); se->expr = fold_build2_loc (input_location, MULT_EXPR, type, atrigd, @@ -4614,13 +4635,9 @@ gfc_conv_intrinsic_cotan (gfc_se *se, gfc_expr *expr) mpfr_clear (pio2); /* Find tan builtin function. */ - m = gfc_intrinsic_map; - for (; m->id != GFC_ISYM_NONE || m->double_built_in != END_BUILTINS; m++) - if (GFC_ISYM_TAN == m->id) - break; - - tmp = fold_build2_loc (input_location, PLUS_EXPR, type, arg, tmp); + m = gfc_lookup_intrinsic (GFC_ISYM_TAN); tan = gfc_get_intrinsic_lib_fndecl (m, expr); + tmp = fold_build2_loc (input_location, PLUS_EXPR, type, arg, tmp); tan = build_call_expr_loc (input_location, tan, 1, tmp); se->expr = fold_build1_loc (input_location, NEGATE_EXPR, type, tan); } @@ -4630,20 +4647,12 @@ gfc_conv_intrinsic_cotan (gfc_se *se, gfc_expr *expr) tree cos; /* Find cos builtin function. */ - m = gfc_intrinsic_map; - for (; m->id != GFC_ISYM_NONE || m->double_built_in != END_BUILTINS; m++) - if (GFC_ISYM_COS == m->id) - break; - + m = gfc_lookup_intrinsic (GFC_ISYM_COS); cos = gfc_get_intrinsic_lib_fndecl (m, expr); cos = build_call_expr_loc (input_location, cos, 1, arg); /* Find sin builtin function. */ - m = gfc_intrinsic_map; - for (; m->id != GFC_ISYM_NONE || m->double_built_in != END_BUILTINS; m++) - if (GFC_ISYM_SIN == m->id) - break; - + m = gfc_lookup_intrinsic (GFC_ISYM_SIN); sin = gfc_get_intrinsic_lib_fndecl (m, expr); sin = build_call_expr_loc (input_location, sin, 1, arg); @@ -4675,11 +4684,7 @@ gfc_conv_intrinsic_cotand (gfc_se *se, gfc_expr *expr) mpfr_clear (ninety); /* Find tand. */ - gfc_intrinsic_map_t *m = gfc_intrinsic_map; - for (; m->id != GFC_ISYM_NONE || m->double_built_in != END_BUILTINS; m++) - if (GFC_ISYM_TAND == m->id) - break; - + gfc_intrinsic_map_t *m = gfc_lookup_intrinsic (GFC_ISYM_TAND); tree tand = gfc_get_intrinsic_lib_fndecl (m, expr); tand = build_call_expr_loc (input_location, tand, 1, arg); @@ -4699,7 +4704,8 @@ gfc_conv_intrinsic_atan2d (gfc_se *se, gfc_expr *expr) gfc_conv_intrinsic_function_args (se, expr, args, 2); type = TREE_TYPE (args[0]); - atan2d = gfc_builtin_decl_for_float_kind (BUILT_IN_ATAN2, expr->ts.kind); + gfc_intrinsic_map_t *m = gfc_lookup_intrinsic (GFC_ISYM_ATAN2); + atan2d = gfc_get_intrinsic_lib_fndecl (m, expr); atan2d = build_call_expr_loc (input_location, atan2d, 2, args[0], args[1]); se->expr = fold_build2_loc (input_location, MULT_EXPR, type, atan2d, @@ -7249,12 +7255,13 @@ gfc_conv_intrinsic_popcnt_poppar (gfc_se * se, gfc_expr *expr, int parity) /* Combine the results. */ if (parity) - se->expr = fold_build2_loc (input_location, BIT_XOR_EXPR, result_type, - call1, call2); + se->expr = fold_build2_loc (input_location, BIT_XOR_EXPR, + integer_type_node, call1, call2); else - se->expr = fold_build2_loc (input_location, PLUS_EXPR, result_type, - call1, call2); + se->expr = fold_build2_loc (input_location, PLUS_EXPR, + integer_type_node, call1, call2); + se->expr = convert (result_type, se->expr); return; } @@ -7352,7 +7359,7 @@ gfc_conv_intrinsic_len (gfc_se * se, gfc_expr * expr) case EXPR_ARRAY: /* Obtain the string length from the function used by - trans-array.c(gfc_trans_array_constructor). */ + trans-array.cc(gfc_trans_array_constructor). */ len = NULL_TREE; get_array_ctor_strlen (&se->pre, arg->value.constructor, &len); break; @@ -8002,10 +8009,14 @@ gfc_conv_intrinsic_size (gfc_se * se, gfc_expr * expr) cond = gfc_evaluate_now (cond, &se->pre); /* 'block2' contains the arg2 absent case, 'block' the arg2 present case; size_var can be used in both blocks. */ - tree size_var = gfc_tree_array_size (&block2, arg1, e, NULL_TREE); + tree size_var = gfc_create_var (TREE_TYPE (size), "size"); tmp = fold_build2_loc (input_location, MODIFY_EXPR, TREE_TYPE (size_var), size_var, size); gfc_add_expr_to_block (&block, tmp); + size = gfc_tree_array_size (&block2, arg1, e, NULL_TREE); + tmp = fold_build2_loc (input_location, MODIFY_EXPR, + TREE_TYPE (size_var), size_var, size); + gfc_add_expr_to_block (&block2, tmp); tmp = build3_v (COND_EXPR, cond, gfc_finish_block (&block), gfc_finish_block (&block2)); gfc_add_expr_to_block (&se->pre, tmp); @@ -8523,7 +8534,8 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr) { case BT_CHARACTER: tmp = size_of_string_in_bytes (arg->expr->ts.kind, argse.string_length); - mold_type = gfc_get_character_type_len (arg->expr->ts.kind, tmp); + mold_type = gfc_get_character_type_len (arg->expr->ts.kind, + argse.string_length); break; case BT_CLASS: tmp = gfc_class_vtab_size_get (argse.expr); @@ -8625,7 +8637,13 @@ gfc_conv_intrinsic_transfer (gfc_se * se, gfc_expr * expr) se->expr = info->descriptor; if (expr->ts.type == BT_CHARACTER) - se->string_length = fold_convert (gfc_charlen_type_node, dest_word_len); + { + tmp = fold_convert (gfc_charlen_type_node, + TYPE_SIZE_UNIT (gfc_get_char_type (expr->ts.kind))); + se->string_length = fold_build2_loc (input_location, TRUNC_DIV_EXPR, + gfc_charlen_type_node, + dest_word_len, tmp); + } return; @@ -8679,7 +8697,11 @@ scalar_transfer: gfc_add_expr_to_block (&se->post, tmp); se->expr = tmpdecl; - se->string_length = fold_convert (gfc_charlen_type_node, dest_word_len); + tmp = fold_convert (gfc_charlen_type_node, + TYPE_SIZE_UNIT (gfc_get_char_type (expr->ts.kind))); + se->string_length = fold_build2_loc (input_location, TRUNC_DIV_EXPR, + gfc_charlen_type_node, + dest_word_len, tmp); } else { @@ -9474,7 +9496,7 @@ gfc_conv_intrinsic_loc (gfc_se * se, gfc_expr * expr) se->expr = convert (gfc_get_int_type (gfc_index_integer_kind), se->expr); /* Create a temporary variable for loc return value. Without this, - we get an error an ICE in gcc/expr.c(expand_expr_addr_expr_1). */ + we get an error an ICE in gcc/expr.cc(expand_expr_addr_expr_1). */ temp_var = gfc_create_var (gfc_get_int_type (gfc_index_integer_kind), NULL); gfc_add_modify (&se->pre, temp_var, se->expr); se->expr = temp_var; @@ -11084,7 +11106,8 @@ gfc_walk_intrinsic_function (gfc_ss * ss, gfc_expr * expr, if (isym->elemental) return gfc_walk_elemental_function_args (ss, expr->value.function.actual, - NULL, GFC_SS_SCALAR); + expr->value.function.isym, + GFC_SS_SCALAR); if (expr->rank == 0) return ss; @@ -11189,24 +11212,31 @@ conv_co_collective (gfc_code *code) return gfc_finish_block (&block); } + gfc_symbol *derived = code->ext.actual->expr->ts.type == BT_DERIVED + ? code->ext.actual->expr->ts.u.derived : NULL; + /* Handle the array. */ gfc_init_se (&argse, NULL); - if (code->ext.actual->expr->rank == 0) - { - symbol_attribute attr; - gfc_clear_attr (&attr); - gfc_init_se (&argse, NULL); - gfc_conv_expr (&argse, code->ext.actual->expr); - gfc_add_block_to_block (&block, &argse.pre); - gfc_add_block_to_block (&post_block, &argse.post); - array = gfc_conv_scalar_to_descriptor (&argse, argse.expr, attr); - array = gfc_build_addr_expr (NULL_TREE, array); - } - else + if (!derived || !derived->attr.alloc_comp + || code->resolved_isym->id != GFC_ISYM_CO_BROADCAST) { - argse.want_pointer = 1; - gfc_conv_expr_descriptor (&argse, code->ext.actual->expr); - array = argse.expr; + if (code->ext.actual->expr->rank == 0) + { + symbol_attribute attr; + gfc_clear_attr (&attr); + gfc_init_se (&argse, NULL); + gfc_conv_expr (&argse, code->ext.actual->expr); + gfc_add_block_to_block (&block, &argse.pre); + gfc_add_block_to_block (&post_block, &argse.post); + array = gfc_conv_scalar_to_descriptor (&argse, argse.expr, attr); + array = gfc_build_addr_expr (NULL_TREE, array); + } + else + { + argse.want_pointer = 1; + gfc_conv_expr_descriptor (&argse, code->ext.actual->expr); + array = argse.expr; + } } gfc_add_block_to_block (&block, &argse.pre); @@ -11267,9 +11297,6 @@ conv_co_collective (gfc_code *code) gcc_unreachable (); } - gfc_symbol *derived = code->ext.actual->expr->ts.type == BT_DERIVED - ? code->ext.actual->expr->ts.u.derived : NULL; - if (derived && derived->attr.alloc_comp && code->resolved_isym->id == GFC_ISYM_CO_BROADCAST) /* The derived type has the attribute 'alloc_comp'. */ @@ -11926,7 +11953,7 @@ conv_intrinsic_event_query (gfc_code *code) /* This is a peculiar case because of the need to do dependency checking. - It is called via trans-stmt.c(gfc_trans_call), where it is picked out as + It is called via trans-stmt.cc(gfc_trans_call), where it is picked out as a special case and this function called instead of gfc_conv_procedure_call. */ void diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.cc index 3937f82..732221f 100644 --- a/gcc/fortran/trans-io.c +++ b/gcc/fortran/trans-io.cc @@ -1,5 +1,5 @@ /* IO Code translation/library interface - Copyright (C) 2002-2021 Free Software Foundation, Inc. + Copyright (C) 2002-2022 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of GCC. @@ -233,7 +233,7 @@ gfc_build_st_parameter (enum ioparam_type ptype, tree *types) /* Build code to test an error condition and call generate_error if needed. Note: This builds calls to generate_error in the runtime library function. The function generate_error is dependent on certain parameters in the - st_parameter_common flags to be set. (See libgfortran/runtime/error.c) + st_parameter_common flags to be set. (See libgfortran/runtime/error.cc) Therefore, the code to set these flags must be generated before this function is used. */ @@ -1765,18 +1765,17 @@ transfer_namelist_element (stmtblock_t * block, const char * var_name, else tmp = build_int_cst (gfc_charlen_type_node, 0); + int abi_kind = gfc_type_abi_kind (ts); if (dtio_proc == null_pointer_node) - tmp = build_call_expr_loc (input_location, - iocall[IOCALL_SET_NML_VAL], 6, - dt_parm_addr, addr_expr, string, - build_int_cst (gfc_int4_type_node, ts->kind), - tmp, dtype); + tmp = build_call_expr_loc (input_location, iocall[IOCALL_SET_NML_VAL], 6, + dt_parm_addr, addr_expr, string, + build_int_cst (gfc_int4_type_node, abi_kind), + tmp, dtype); else - tmp = build_call_expr_loc (input_location, - iocall[IOCALL_SET_NML_DTIO_VAL], 8, - dt_parm_addr, addr_expr, string, - build_int_cst (gfc_int4_type_node, ts->kind), - tmp, dtype, dtio_proc, vtable); + tmp = build_call_expr_loc (input_location, iocall[IOCALL_SET_NML_DTIO_VAL], + 8, dt_parm_addr, addr_expr, string, + build_int_cst (gfc_int4_type_node, abi_kind), + tmp, dtype, dtio_proc, vtable); gfc_add_expr_to_block (block, tmp); /* If the object is an array, transfer rank times: @@ -2298,7 +2297,7 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, ts->kind = gfc_index_integer_kind; } - kind = ts->kind; + kind = gfc_type_abi_kind (ts); function = NULL; arg2 = NULL; arg3 = NULL; @@ -2318,14 +2317,14 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, arg2 = build_int_cst (integer_type_node, kind); if (last_dt == READ) { - if (gfc_real16_is_float128 && ts->kind == 16) + if ((gfc_real16_is_float128 && kind == 16) || kind == 17) function = iocall[IOCALL_X_REAL128]; else function = iocall[IOCALL_X_REAL]; } else { - if (gfc_real16_is_float128 && ts->kind == 16) + if ((gfc_real16_is_float128 && kind == 16) || kind == 17) function = iocall[IOCALL_X_REAL128_WRITE]; else function = iocall[IOCALL_X_REAL_WRITE]; @@ -2337,14 +2336,14 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, arg2 = build_int_cst (integer_type_node, kind); if (last_dt == READ) { - if (gfc_real16_is_float128 && ts->kind == 16) + if ((gfc_real16_is_float128 && kind == 16) || kind == 17) function = iocall[IOCALL_X_COMPLEX128]; else function = iocall[IOCALL_X_COMPLEX]; } else { - if (gfc_real16_is_float128 && ts->kind == 16) + if ((gfc_real16_is_float128 && kind == 16) || kind == 17) function = iocall[IOCALL_X_COMPLEX128_WRITE]; else function = iocall[IOCALL_X_COMPLEX_WRITE]; @@ -2529,7 +2528,7 @@ transfer_array_desc (gfc_se * se, gfc_typespec * ts, tree addr_expr) else charlen_arg = build_int_cst (gfc_charlen_type_node, 0); - kind_arg = build_int_cst (integer_type_node, ts->kind); + kind_arg = build_int_cst (integer_type_node, gfc_type_abi_kind (ts)); tmp = gfc_build_addr_expr (NULL_TREE, dt_parm); if (last_dt == READ) diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.cc index e81c558..0eba0b3 100644 --- a/gcc/fortran/trans-openmp.c +++ b/gcc/fortran/trans-openmp.cc @@ -1,5 +1,5 @@ /* OpenMP directive translation -- generate GCC trees from gfc_code. - Copyright (C) 2005-2021 Free Software Foundation, Inc. + Copyright (C) 2005-2022 Free Software Foundation, Inc. Contributed by Jakub Jelinek <jakub@redhat.com> This file is part of GCC. @@ -116,7 +116,7 @@ gfc_omp_check_optional_argument (tree decl, bool for_present_check) /* Scalars with VALUE attribute which are passed by value use a hidden argument to denote the present status. They are passed as nonpointer type with one exception: 'type(c_ptr), value' as 'void*'. */ - /* Cf. trans-expr.c's gfc_conv_expr_present. */ + /* Cf. trans-expr.cc's gfc_conv_expr_present. */ if (TREE_CODE (TREE_TYPE (decl)) != POINTER_TYPE || VOID_TYPE_P (TREE_TYPE (TREE_TYPE (decl)))) { @@ -468,7 +468,7 @@ gfc_omp_unshare_expr_r (tree *tp, int *walk_subtrees, void *) /* Unshare in expr anything that the FE which normally doesn't care much about tree sharing (because during gimplification everything is unshared) could cause problems with tree sharing - at omp-low.c time. */ + at omp-low.cc time. */ static tree gfc_omp_unshare_expr (tree expr) @@ -1564,7 +1564,7 @@ gfc_omp_finish_clause (tree c, gimple_seq *pre_p, bool openacc) if (present) ptr = gfc_build_cond_assign_expr (&block, present, ptr, null_pointer_node); - ptr = fold_convert (build_pointer_type (char_type_node), ptr); + gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr))); ptr = build_fold_indirect_ref (ptr); OMP_CLAUSE_DECL (c) = ptr; c2 = build_omp_clause (input_location, OMP_CLAUSE_MAP); @@ -1910,7 +1910,17 @@ gfc_trans_omp_variable_list (enum omp_clause_code code, tree t = gfc_trans_omp_variable (namelist->sym, declare_simd); if (t != error_mark_node) { - tree node = build_omp_clause (input_location, code); + tree node; + /* For HAS_DEVICE_ADDR of an array descriptor, firstprivatize the + descriptor such that the bounds are available; its data component + is unmodified; it is handled as device address inside target. */ + if (code == OMP_CLAUSE_HAS_DEVICE_ADDR + && (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (t)) + || (POINTER_TYPE_P (TREE_TYPE (t)) + && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (TREE_TYPE (t)))))) + node = build_omp_clause (input_location, OMP_CLAUSE_FIRSTPRIVATE); + else + node = build_omp_clause (input_location, code); OMP_CLAUSE_DECL (node) = t; list = gfc_trans_add_clause (node, list); @@ -2381,7 +2391,7 @@ gfc_trans_omp_array_section (stmtblock_t *block, gfc_omp_namelist *n, OMP_CLAUSE_SIZE (node), elemsz); } gcc_assert (se.post.head == NULL_TREE); - ptr = fold_convert (build_pointer_type (char_type_node), ptr); + gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr))); OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr); ptr = fold_convert (ptrdiff_type_node, ptr); @@ -2439,7 +2449,7 @@ gfc_trans_omp_array_section (stmtblock_t *block, gfc_omp_namelist *n, OMP_CLAUSE_DECL (node3) = gfc_conv_descriptor_data_get (decl); /* This purposely does not include GOMP_MAP_ALWAYS_POINTER. The extra - cast prevents gimplify.c from recognising it as being part of the + cast prevents gimplify.cc from recognising it as being part of the struct – and adding an 'alloc: for the 'desc.data' pointer, which would break as the 'desc' (the descriptor) is also mapped (see node4 above). */ @@ -2460,6 +2470,9 @@ gfc_trans_omp_array_section (stmtblock_t *block, gfc_omp_namelist *n, TREE_TYPE (TREE_TYPE (decl)), decl, offset, NULL_TREE, NULL_TREE); OMP_CLAUSE_DECL (node) = offset; + + if (ptr_kind == GOMP_MAP_ALWAYS_POINTER) + return; } else { @@ -2480,7 +2493,7 @@ static tree handle_iterator (gfc_namespace *ns, stmtblock_t *iter_block, tree block) { tree list = NULL_TREE; - for (gfc_symbol *sym = ns->proc_name; sym; sym = sym->tlink) + for (gfc_symbol *sym = ns->omp_affinity_iterators; sym; sym = sym->tlink) { gfc_constructor *c; gfc_se se; @@ -2601,6 +2614,9 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, case OMP_LIST_IS_DEVICE_PTR: clause_code = OMP_CLAUSE_IS_DEVICE_PTR; goto add_clause; + case OMP_LIST_HAS_DEVICE_ADDR: + clause_code = OMP_CLAUSE_HAS_DEVICE_ADDR; + goto add_clause; case OMP_LIST_NONTEMPORAL: clause_code = OMP_CLAUSE_NONTEMPORAL; goto add_clause; @@ -2646,6 +2662,28 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, } } break; + case OMP_LIST_ALLOCATE: + for (; n != NULL; n = n->next) + if (n->sym->attr.referenced) + { + tree t = gfc_trans_omp_variable (n->sym, false); + if (t != error_mark_node) + { + tree node = build_omp_clause (input_location, + OMP_CLAUSE_ALLOCATE); + OMP_CLAUSE_DECL (node) = t; + if (n->expr) + { + tree allocator_; + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, n->expr); + allocator_ = gfc_evaluate_now (se.expr, block); + OMP_CLAUSE_ALLOCATE_ALLOCATOR (node) = allocator_; + } + omp_clauses = gfc_trans_add_clause (node, omp_clauses); + } + } + break; case OMP_LIST_LINEAR: { gfc_expr *last_step_expr = NULL; @@ -2849,8 +2887,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (decl))) { decl = gfc_conv_descriptor_data_get (decl); - decl = fold_convert (build_pointer_type (char_type_node), - decl); + gcc_assert (POINTER_TYPE_P (TREE_TYPE (decl))); decl = build_fold_indirect_ref (decl); } else if (DECL_P (decl)) @@ -2873,8 +2910,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, } gfc_add_block_to_block (&iter_block, &se.pre); gfc_add_block_to_block (&iter_block, &se.post); - ptr = fold_convert (build_pointer_type (char_type_node), - ptr); + gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr))); OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr); } if (list == OMP_LIST_DEPEND) @@ -3073,7 +3109,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, the variable is present; hence, we now set it to NULL to avoid accessing undefined variables. We cannot use a temporary variable here as otherwise the replacement - of the variables in omp-low.c will not work. */ + of the variables in omp-low.cc will not work. */ if (present && GFC_ARRAY_TYPE_P (TREE_TYPE (decl))) { tree tmp = fold_build2_loc (input_location, @@ -3117,8 +3153,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, if (present) ptr = gfc_build_cond_assign_expr (block, present, ptr, null_pointer_node); - ptr = fold_convert (build_pointer_type (char_type_node), - ptr); + gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr))); ptr = build_fold_indirect_ref (ptr); OMP_CLAUSE_DECL (node) = ptr; node2 = build_omp_clause (input_location, @@ -3555,8 +3590,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, { tree type = TREE_TYPE (decl); tree ptr = gfc_conv_descriptor_data_get (decl); - ptr = fold_convert (build_pointer_type (char_type_node), - ptr); + gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr))); ptr = build_fold_indirect_ref (ptr); OMP_CLAUSE_DECL (node) = ptr; OMP_CLAUSE_SIZE (node) @@ -3606,8 +3640,7 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, OMP_CLAUSE_SIZE (node), elemsz); } gfc_add_block_to_block (block, &se.post); - ptr = fold_convert (build_pointer_type (char_type_node), - ptr); + gcc_assert (POINTER_TYPE_P (TREE_TYPE (ptr))); OMP_CLAUSE_DECL (node) = build_fold_indirect_ref (ptr); } omp_clauses = gfc_trans_add_clause (node, omp_clauses); @@ -3927,18 +3960,27 @@ gfc_trans_omp_clauses (stmtblock_t *block, gfc_omp_clauses *clauses, } } - if (clauses->num_teams) + if (clauses->num_teams_upper) { - tree num_teams; + tree num_teams_lower = NULL_TREE, num_teams_upper; gfc_init_se (&se, NULL); - gfc_conv_expr (&se, clauses->num_teams); + gfc_conv_expr (&se, clauses->num_teams_upper); gfc_add_block_to_block (block, &se.pre); - num_teams = gfc_evaluate_now (se.expr, block); + num_teams_upper = gfc_evaluate_now (se.expr, block); gfc_add_block_to_block (block, &se.post); + if (clauses->num_teams_lower) + { + gfc_init_se (&se, NULL); + gfc_conv_expr (&se, clauses->num_teams_lower); + gfc_add_block_to_block (block, &se.pre); + num_teams_lower = gfc_evaluate_now (se.expr, block); + gfc_add_block_to_block (block, &se.post); + } c = build_omp_clause (gfc_get_location (&where), OMP_CLAUSE_NUM_TEAMS); - OMP_CLAUSE_NUM_TEAMS_EXPR (c) = num_teams; + OMP_CLAUSE_NUM_TEAMS_LOWER_EXPR (c) = num_teams_lower; + OMP_CLAUSE_NUM_TEAMS_UPPER_EXPR (c) = num_teams_upper; omp_clauses = gfc_trans_add_clause (c, omp_clauses); } @@ -4481,14 +4523,14 @@ gfc_trans_omp_atomic (gfc_code *code) gfc_se lse; gfc_se rse; gfc_se vse; - gfc_expr *expr2, *e; + gfc_expr *expr1, *expr2, *e, *capture_expr1 = NULL, *capture_expr2 = NULL; gfc_symbol *var; stmtblock_t block; - tree lhsaddr, type, rhs, x; + tree lhsaddr, type, rhs, x, compare = NULL_TREE, comp_tgt = NULL_TREE; enum tree_code op = ERROR_MARK; enum tree_code aop = OMP_ATOMIC; - bool var_on_left = false; - enum omp_memory_order mo; + bool var_on_left = false, else_branch = false; + enum omp_memory_order mo, fail_mo; switch (atomic_code->ext.omp_clauses->memorder) { case OMP_MEMORDER_UNSET: mo = OMP_MEMORY_ORDER_UNSPECIFIED; break; @@ -4499,17 +4541,94 @@ gfc_trans_omp_atomic (gfc_code *code) case OMP_MEMORDER_SEQ_CST: mo = OMP_MEMORY_ORDER_SEQ_CST; break; default: gcc_unreachable (); } + switch (atomic_code->ext.omp_clauses->fail) + { + case OMP_MEMORDER_UNSET: fail_mo = OMP_FAIL_MEMORY_ORDER_UNSPECIFIED; break; + case OMP_MEMORDER_ACQUIRE: fail_mo = OMP_FAIL_MEMORY_ORDER_ACQUIRE; break; + case OMP_MEMORDER_RELAXED: fail_mo = OMP_FAIL_MEMORY_ORDER_RELAXED; break; + case OMP_MEMORDER_SEQ_CST: fail_mo = OMP_FAIL_MEMORY_ORDER_SEQ_CST; break; + default: gcc_unreachable (); + } + mo = (omp_memory_order) (mo | fail_mo); code = code->block->next; - gcc_assert (code->op == EXEC_ASSIGN); - var = code->expr1->symtree->n.sym; + if (atomic_code->ext.omp_clauses->compare) + { + gfc_expr *comp_expr; + if (code->op == EXEC_IF) + { + comp_expr = code->block->expr1; + gcc_assert (code->block->next->op == EXEC_ASSIGN); + expr1 = code->block->next->expr1; + expr2 = code->block->next->expr2; + if (code->block->block) + { + gcc_assert (atomic_code->ext.omp_clauses->capture + && code->block->block->next->op == EXEC_ASSIGN); + else_branch = true; + aop = OMP_ATOMIC_CAPTURE_OLD; + capture_expr1 = code->block->block->next->expr1; + capture_expr2 = code->block->block->next->expr2; + } + else if (atomic_code->ext.omp_clauses->capture) + { + gcc_assert (code->next->op == EXEC_ASSIGN); + aop = OMP_ATOMIC_CAPTURE_NEW; + capture_expr1 = code->next->expr1; + capture_expr2 = code->next->expr2; + } + } + else + { + gcc_assert (atomic_code->ext.omp_clauses->capture + && code->op == EXEC_ASSIGN + && code->next->op == EXEC_IF); + aop = OMP_ATOMIC_CAPTURE_OLD; + capture_expr1 = code->expr1; + capture_expr2 = code->expr2; + expr1 = code->next->block->next->expr1; + expr2 = code->next->block->next->expr2; + comp_expr = code->next->block->expr1; + } + gfc_init_se (&lse, NULL); + gfc_conv_expr (&lse, comp_expr->value.op.op2); + gfc_add_block_to_block (&block, &lse.pre); + compare = lse.expr; + var = expr1->symtree->n.sym; + } + else + { + gcc_assert (code->op == EXEC_ASSIGN); + expr1 = code->expr1; + expr2 = code->expr2; + if (atomic_code->ext.omp_clauses->capture + && (expr2->expr_type == EXPR_VARIABLE + || (expr2->expr_type == EXPR_FUNCTION + && expr2->value.function.isym + && expr2->value.function.isym->id == GFC_ISYM_CONVERSION + && (expr2->value.function.actual->expr->expr_type + == EXPR_VARIABLE)))) + { + capture_expr1 = expr1; + capture_expr2 = expr2; + expr1 = code->next->expr1; + expr2 = code->next->expr2; + aop = OMP_ATOMIC_CAPTURE_OLD; + } + else if (atomic_code->ext.omp_clauses->capture) + { + aop = OMP_ATOMIC_CAPTURE_NEW; + capture_expr1 = code->next->expr1; + capture_expr2 = code->next->expr2; + } + var = expr1->symtree->n.sym; + } gfc_init_se (&lse, NULL); gfc_init_se (&rse, NULL); gfc_init_se (&vse, NULL); gfc_start_block (&block); - expr2 = code->expr2; if (((atomic_code->ext.omp_clauses->atomic_op & GFC_OMP_ATOMIC_MASK) != GFC_OMP_ATOMIC_WRITE) && expr2->expr_type == EXPR_FUNCTION @@ -4520,7 +4639,7 @@ gfc_trans_omp_atomic (gfc_code *code) if ((atomic_code->ext.omp_clauses->atomic_op & GFC_OMP_ATOMIC_MASK) == GFC_OMP_ATOMIC_READ) { - gfc_conv_expr (&vse, code->expr1); + gfc_conv_expr (&vse, expr1); gfc_add_block_to_block (&block, &vse.pre); gfc_conv_expr (&lse, expr2); @@ -4538,36 +4657,32 @@ gfc_trans_omp_atomic (gfc_code *code) return gfc_finish_block (&block); } - if (atomic_code->ext.omp_clauses->capture) + + if (capture_expr2 + && capture_expr2->expr_type == EXPR_FUNCTION + && capture_expr2->value.function.isym + && capture_expr2->value.function.isym->id == GFC_ISYM_CONVERSION) + capture_expr2 = capture_expr2->value.function.actual->expr; + gcc_assert (!capture_expr2 || capture_expr2->expr_type == EXPR_VARIABLE); + + if (aop == OMP_ATOMIC_CAPTURE_OLD) { - aop = OMP_ATOMIC_CAPTURE_NEW; - if (expr2->expr_type == EXPR_VARIABLE) - { - aop = OMP_ATOMIC_CAPTURE_OLD; - gfc_conv_expr (&vse, code->expr1); - gfc_add_block_to_block (&block, &vse.pre); - - gfc_conv_expr (&lse, expr2); - gfc_add_block_to_block (&block, &lse.pre); - gfc_init_se (&lse, NULL); - code = code->next; - var = code->expr1->symtree->n.sym; - expr2 = code->expr2; - if (expr2->expr_type == EXPR_FUNCTION - && expr2->value.function.isym - && expr2->value.function.isym->id == GFC_ISYM_CONVERSION) - expr2 = expr2->value.function.actual->expr; - } + gfc_conv_expr (&vse, capture_expr1); + gfc_add_block_to_block (&block, &vse.pre); + gfc_conv_expr (&lse, capture_expr2); + gfc_add_block_to_block (&block, &lse.pre); + gfc_init_se (&lse, NULL); } - gfc_conv_expr (&lse, code->expr1); + gfc_conv_expr (&lse, expr1); gfc_add_block_to_block (&block, &lse.pre); type = TREE_TYPE (lse.expr); lhsaddr = gfc_build_addr_expr (NULL, lse.expr); if (((atomic_code->ext.omp_clauses->atomic_op & GFC_OMP_ATOMIC_MASK) == GFC_OMP_ATOMIC_WRITE) - || (atomic_code->ext.omp_clauses->atomic_op & GFC_OMP_ATOMIC_SWAP)) + || (atomic_code->ext.omp_clauses->atomic_op & GFC_OMP_ATOMIC_SWAP) + || compare) { gfc_conv_expr (&rse, expr2); gfc_add_block_to_block (&block, &rse.pre); @@ -4659,6 +4774,10 @@ gfc_trans_omp_atomic (gfc_code *code) gcc_unreachable (); } e = expr2->value.function.actual->expr; + if (e->expr_type == EXPR_FUNCTION + && e->value.function.isym + && e->value.function.isym->id == GFC_ISYM_CONVERSION) + e = e->value.function.actual->expr; gcc_assert (e->expr_type == EXPR_VARIABLE && e->symtree != NULL && e->symtree->n.sym == var); @@ -4701,11 +4820,27 @@ gfc_trans_omp_atomic (gfc_code *code) NULL_TREE, NULL_TREE); } - rhs = gfc_evaluate_now (rse.expr, &block); + if (compare) + { + tree var = create_tmp_var_raw (TREE_TYPE (lhsaddr)); + DECL_CONTEXT (var) = current_function_decl; + lhsaddr = build4 (TARGET_EXPR, TREE_TYPE (lhsaddr), var, lhsaddr, NULL, + NULL); + lse.expr = build_fold_indirect_ref_loc (input_location, lhsaddr); + compare = convert (TREE_TYPE (lse.expr), compare); + compare = fold_build2_loc (input_location, EQ_EXPR, boolean_type_node, + lse.expr, compare); + } + + if (expr2->expr_type == EXPR_VARIABLE || compare) + rhs = rse.expr; + else + rhs = gfc_evaluate_now (rse.expr, &block); if (((atomic_code->ext.omp_clauses->atomic_op & GFC_OMP_ATOMIC_MASK) == GFC_OMP_ATOMIC_WRITE) - || (atomic_code->ext.omp_clauses->atomic_op & GFC_OMP_ATOMIC_SWAP)) + || (atomic_code->ext.omp_clauses->atomic_op & GFC_OMP_ATOMIC_SWAP) + || compare) x = rhs; else { @@ -4725,35 +4860,64 @@ gfc_trans_omp_atomic (gfc_code *code) gfc_add_block_to_block (&block, &lse.pre); gfc_add_block_to_block (&block, &rse.pre); + if (aop == OMP_ATOMIC_CAPTURE_NEW) + { + gfc_conv_expr (&vse, capture_expr1); + gfc_add_block_to_block (&block, &vse.pre); + gfc_add_block_to_block (&block, &lse.pre); + } + + if (compare && else_branch) + { + tree var2 = create_tmp_var_raw (boolean_type_node); + DECL_CONTEXT (var2) = current_function_decl; + comp_tgt = build4 (TARGET_EXPR, boolean_type_node, var2, + boolean_false_node, NULL, NULL); + compare = fold_build2_loc (input_location, MODIFY_EXPR, TREE_TYPE (var2), + var2, compare); + TREE_OPERAND (compare, 0) = comp_tgt; + compare = omit_one_operand_loc (input_location, boolean_type_node, + compare, comp_tgt); + } + + if (compare) + x = build3_loc (input_location, COND_EXPR, type, compare, + convert (type, x), lse.expr); + if (aop == OMP_ATOMIC) { x = build2_v (OMP_ATOMIC, lhsaddr, convert (type, x)); OMP_ATOMIC_MEMORY_ORDER (x) = mo; + OMP_ATOMIC_WEAK (x) = atomic_code->ext.omp_clauses->weak; gfc_add_expr_to_block (&block, x); } else { - if (aop == OMP_ATOMIC_CAPTURE_NEW) - { - code = code->next; - expr2 = code->expr2; - if (expr2->expr_type == EXPR_FUNCTION - && expr2->value.function.isym - && expr2->value.function.isym->id == GFC_ISYM_CONVERSION) - expr2 = expr2->value.function.actual->expr; - - gcc_assert (expr2->expr_type == EXPR_VARIABLE); - gfc_conv_expr (&vse, code->expr1); - gfc_add_block_to_block (&block, &vse.pre); - - gfc_init_se (&lse, NULL); - gfc_conv_expr (&lse, expr2); - gfc_add_block_to_block (&block, &lse.pre); - } x = build2 (aop, type, lhsaddr, convert (type, x)); OMP_ATOMIC_MEMORY_ORDER (x) = mo; - x = convert (TREE_TYPE (vse.expr), x); - gfc_add_modify (&block, vse.expr, x); + OMP_ATOMIC_WEAK (x) = atomic_code->ext.omp_clauses->weak; + if (compare && else_branch) + { + tree vtmp = create_tmp_var_raw (TREE_TYPE (x)); + DECL_CONTEXT (vtmp) = current_function_decl; + x = fold_build2_loc (input_location, MODIFY_EXPR, + TREE_TYPE (vtmp), vtmp, x); + vtmp = build4 (TARGET_EXPR, TREE_TYPE (vtmp), vtmp, + build_zero_cst (TREE_TYPE (vtmp)), NULL, NULL); + TREE_OPERAND (x, 0) = vtmp; + tree x2 = convert (TREE_TYPE (vse.expr), vtmp); + x2 = fold_build2_loc (input_location, MODIFY_EXPR, + TREE_TYPE (vse.expr), vse.expr, x2); + x2 = build3_loc (input_location, COND_EXPR, void_type_node, comp_tgt, + void_node, x2); + x = omit_one_operand_loc (input_location, TREE_TYPE (x2), x2, x); + gfc_add_expr_to_block (&block, x); + } + else + { + x = convert (TREE_TYPE (vse.expr), x); + gfc_add_modify (&block, vse.expr, x); + } } return gfc_finish_block (&block); @@ -5861,6 +6025,8 @@ gfc_split_omp_clauses (gfc_code *code, = code->ext.omp_clauses->lists[OMP_LIST_IS_DEVICE_PTR]; clausesa[GFC_OMP_SPLIT_TARGET].device = code->ext.omp_clauses->device; + clausesa[GFC_OMP_SPLIT_TARGET].thread_limit + = code->ext.omp_clauses->thread_limit; for (int i = 0; i < OMP_DEFAULTMAP_CAT_NUM; i++) clausesa[GFC_OMP_SPLIT_TARGET].defaultmap[i] = code->ext.omp_clauses->defaultmap[i]; @@ -5869,12 +6035,16 @@ gfc_split_omp_clauses (gfc_code *code, /* And this is copied to all. */ clausesa[GFC_OMP_SPLIT_TARGET].if_expr = code->ext.omp_clauses->if_expr; + clausesa[GFC_OMP_SPLIT_TARGET].nowait + = code->ext.omp_clauses->nowait; } if (mask & GFC_OMP_MASK_TEAMS) { /* First the clauses that are unique to some constructs. */ - clausesa[GFC_OMP_SPLIT_TEAMS].num_teams - = code->ext.omp_clauses->num_teams; + clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_lower + = code->ext.omp_clauses->num_teams_lower; + clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_upper + = code->ext.omp_clauses->num_teams_upper; clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit = code->ext.omp_clauses->thread_limit; /* Shared and default clauses are allowed on parallel, teams @@ -6125,6 +6295,71 @@ gfc_split_omp_clauses (gfc_code *code, == (GFC_OMP_MASK_PARALLEL | GFC_OMP_MASK_DO)) && !is_loop) clausesa[GFC_OMP_SPLIT_DO].nowait = true; + + /* Distribute allocate clause to do, parallel, distribute, teams, target + and taskloop. The code below itereates over variables in the + allocate list and checks if that available is also in any + privatization clause on those construct. If yes, then we add it + to the list of 'allocate'ed variables for that construct. If a + variable is found in none of them then we issue an error. */ + + if (code->ext.omp_clauses->lists[OMP_LIST_ALLOCATE]) + { + gfc_omp_namelist *alloc_nl, *priv_nl; + gfc_omp_namelist *tails[GFC_OMP_SPLIT_NUM]; + for (alloc_nl = code->ext.omp_clauses->lists[OMP_LIST_ALLOCATE]; + alloc_nl; alloc_nl = alloc_nl->next) + { + bool found = false; + for (int i = GFC_OMP_SPLIT_DO; i <= GFC_OMP_SPLIT_TASKLOOP; i++) + { + gfc_omp_namelist *p; + int list; + for (list = 0; list < OMP_LIST_NUM; list++) + { + switch (list) + { + case OMP_LIST_PRIVATE: + case OMP_LIST_FIRSTPRIVATE: + case OMP_LIST_LASTPRIVATE: + case OMP_LIST_REDUCTION: + case OMP_LIST_REDUCTION_INSCAN: + case OMP_LIST_REDUCTION_TASK: + case OMP_LIST_IN_REDUCTION: + case OMP_LIST_TASK_REDUCTION: + case OMP_LIST_LINEAR: + for (priv_nl = clausesa[i].lists[list]; priv_nl; + priv_nl = priv_nl->next) + if (alloc_nl->sym == priv_nl->sym) + { + found = true; + p = gfc_get_omp_namelist (); + p->sym = alloc_nl->sym; + p->expr = alloc_nl->expr; + p->where = alloc_nl->where; + if (clausesa[i].lists[OMP_LIST_ALLOCATE] == NULL) + { + clausesa[i].lists[OMP_LIST_ALLOCATE] = p; + tails[i] = p; + } + else + { + tails[i]->next = p; + tails[i] = tails[i]->next; + } + } + break; + default: + break; + } + } + } + if (!found) + gfc_error ("%qs specified in 'allocate' clause at %L but not " + "in an explicit privatization clause", + alloc_nl->sym->name, &alloc_nl->where); + } + } } static tree @@ -6649,7 +6884,7 @@ gfc_trans_omp_target (gfc_code *code) break; default: if (flag_openmp - && (clausesa[GFC_OMP_SPLIT_TEAMS].num_teams + && (clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_upper || clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit)) { gfc_omp_clauses clausesb; @@ -6658,9 +6893,13 @@ gfc_trans_omp_target (gfc_code *code) thread_limit clauses are evaluated before entering the target construct. */ memset (&clausesb, '\0', sizeof (clausesb)); - clausesb.num_teams = clausesa[GFC_OMP_SPLIT_TEAMS].num_teams; + clausesb.num_teams_lower + = clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_lower; + clausesb.num_teams_upper + = clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_upper; clausesb.thread_limit = clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit; - clausesa[GFC_OMP_SPLIT_TEAMS].num_teams = NULL; + clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_lower = NULL; + clausesa[GFC_OMP_SPLIT_TEAMS].num_teams_upper = NULL; clausesa[GFC_OMP_SPLIT_TEAMS].thread_limit = NULL; teams_clauses = gfc_trans_omp_clauses (&block, &clausesb, code->loc); diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.cc index eaf2cc2..04f8147 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.cc @@ -1,5 +1,5 @@ /* Statement translation -- generate GCC trees from gfc_code. - Copyright (C) 2002-2021 Free Software Foundation, Inc. + Copyright (C) 2002-2022 Free Software Foundation, Inc. Contributed by Paul Brook <paul@nowt.org> and Steven Bosscher <s.bosscher@student.tudelft.nl> @@ -356,24 +356,22 @@ gfc_conv_elemental_dependencies (gfc_se * se, gfc_se * loopse, } -/* Get the interface symbol for the procedure corresponding to the given call. - We can't get the procedure symbol directly as we have to handle the case - of (deferred) type-bound procedures. */ +/* Given an executable statement referring to an intrinsic function call, + returns the intrinsic symbol. */ -static gfc_symbol * -get_proc_ifc_for_call (gfc_code *c) +static gfc_intrinsic_sym * +get_intrinsic_for_code (gfc_code *code) { - gfc_symbol *sym; - - gcc_assert (c->op == EXEC_ASSIGN_CALL || c->op == EXEC_CALL); - - sym = gfc_get_proc_ifc_for_expr (c->expr1); - - /* Fall back/last resort try. */ - if (sym == NULL) - sym = c->resolved_sym; + if (code->op == EXEC_CALL) + { + gfc_intrinsic_sym * const isym = code->resolved_isym; + if (isym) + return isym; + else + return gfc_get_intrinsic_for_expr (code->expr1); + } - return sym; + return NULL; } @@ -402,7 +400,7 @@ gfc_trans_call (gfc_code * code, bool dependency_check, ss = gfc_ss_terminator; if (code->resolved_sym->attr.elemental) ss = gfc_walk_elemental_function_args (ss, code->ext.actual, - get_proc_ifc_for_call (code), + get_intrinsic_for_code (code), GFC_SS_REFERENCE); /* MVBITS is inlined but needs the dependency checking found here. */ @@ -2184,7 +2182,7 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) gfc_init_se (&se, NULL); - /* resolve.c converts some associate names to allocatable so that + /* resolve.cc converts some associate names to allocatable so that allocation can take place automatically in gfc_trans_assignment. The frontend prevents them from being either allocated, deallocated or reallocated. */ @@ -6640,16 +6638,13 @@ gfc_trans_allocate (gfc_code * code) else e3rhs = gfc_copy_expr (code->expr3); - // We need to propagate the bounds of the expr3 for source=/mold=; - // however, for nondescriptor arrays, we use internally a lower bound - // of zero instead of one, which needs to be corrected for the allocate obj - if (e3_is == E3_DESC) - { - symbol_attribute attr = gfc_expr_attr (code->expr3); - if (code->expr3->expr_type == EXPR_ARRAY || - (!attr.allocatable && !attr.pointer)) - e3_has_nodescriptor = true; - } + // We need to propagate the bounds of the expr3 for source=/mold=. + // However, for non-named arrays, the lbound has to be 1 and neither the + // bound used inside the called function even when returning an + // allocatable/pointer nor the zero used internally. + if (e3_is == E3_DESC + && code->expr3->expr_type != EXPR_VARIABLE) + e3_has_nodescriptor = true; } /* Loop over all objects to allocate. */ @@ -7342,7 +7337,7 @@ gfc_trans_deallocate (gfc_code *code) && TREE_CODE (TREE_TYPE (TREE_TYPE (se.expr))) == RECORD_TYPE) { - /* class.c(finalize_component) generates these, when a + /* class.cc(finalize_component) generates these, when a finalizable entity has a non-allocatable derived type array component, which has allocatable components. Obtain the derived type of the array and deallocate the allocatable diff --git a/gcc/fortran/trans-stmt.h b/gcc/fortran/trans-stmt.h index 1a24d9b..477add4 100644 --- a/gcc/fortran/trans-stmt.h +++ b/gcc/fortran/trans-stmt.h @@ -1,5 +1,5 @@ /* Header for statement translation functions - Copyright (C) 2002-2021 Free Software Foundation, Inc. + Copyright (C) 2002-2022 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of GCC. @@ -27,13 +27,13 @@ tree gfc_trans_code_cond (gfc_code *, tree); /* All other gfc_trans_* should only need be called by gfc_trans_code */ -/* trans-expr.c */ +/* trans-expr.cc */ tree gfc_trans_assign (gfc_code *); tree gfc_trans_pointer_assign (gfc_code *); tree gfc_trans_init_assign (gfc_code *); tree gfc_trans_class_init_assign (gfc_code *); -/* trans-stmt.c */ +/* trans-stmt.cc */ tree gfc_trans_cycle (gfc_code *); tree gfc_trans_critical (gfc_code *); tree gfc_trans_exit (gfc_code *); @@ -66,16 +66,15 @@ tree gfc_trans_sync_team (gfc_code *); tree gfc_trans_where (gfc_code *); tree gfc_trans_allocate (gfc_code *); tree gfc_trans_deallocate (gfc_code *); -tree gfc_trans_deallocate_array (tree); -/* trans-openmp.c */ +/* trans-openmp.cc */ tree gfc_trans_omp_directive (gfc_code *); void gfc_trans_omp_declare_simd (gfc_namespace *); void gfc_trans_omp_declare_variant (gfc_namespace *); tree gfc_trans_oacc_directive (gfc_code *); tree gfc_trans_oacc_declare (gfc_namespace *); -/* trans-io.c */ +/* trans-io.cc */ tree gfc_trans_open (gfc_code *); tree gfc_trans_close (gfc_code *); tree gfc_trans_read (gfc_code *); diff --git a/gcc/fortran/trans-types.c b/gcc/fortran/trans-types.cc index 4277806..3cdc529 100644 --- a/gcc/fortran/trans-types.c +++ b/gcc/fortran/trans-types.cc @@ -1,5 +1,5 @@ /* Backend support for Fortran 95 basic types and derived types. - Copyright (C) 2002-2021 Free Software Foundation, Inc. + Copyright (C) 2002-2022 Free Software Foundation, Inc. Contributed by Paul Brook <paul@nowt.org> and Steven Bosscher <s.bosscher@student.tudelft.nl> @@ -19,7 +19,7 @@ You should have received a copy of the GNU General Public License along with GCC; see the file COPYING3. If not see <http://www.gnu.org/licenses/>. */ -/* trans-types.c -- gfortran backend types */ +/* trans-types.cc -- gfortran backend types */ #include "config.h" #include "system.h" @@ -61,7 +61,7 @@ tree pvoid_type_node; tree prvoid_type_node; tree ppvoid_type_node; tree pchar_type_node; -tree pfunc_type_node; +static tree pfunc_type_node; tree logical_type_node; tree logical_true_node; @@ -133,7 +133,7 @@ int gfc_size_kind; int gfc_numeric_storage_size; int gfc_character_storage_size; -tree dtype_type_node = NULL_TREE; +static tree dtype_type_node = NULL_TREE; /* Build the dtype_type_node if necessary. */ @@ -175,25 +175,6 @@ tree get_dtype_type_node (void) return dtype_type_node; } -bool -gfc_check_any_c_kind (gfc_typespec *ts) -{ - int i; - - for (i = 0; i < ISOCBINDING_NUMBER; i++) - { - /* Check for any C interoperable kind for the given type/kind in ts. - This can be used after verify_c_interop to make sure that the - Fortran kind being used exists in at least some form for C. */ - if (c_interop_kinds_table[i].f90_type == ts->type && - c_interop_kinds_table[i].value == ts->kind) - return true; - } - - return false; -} - - static int get_real_kind_from_node (tree type) { @@ -382,6 +363,8 @@ gfc_init_kinds (void) int i_index, r_index, kind; bool saw_i4 = false, saw_i8 = false; bool saw_r4 = false, saw_r8 = false, saw_r10 = false, saw_r16 = false; + scalar_mode r16_mode = QImode; + scalar_mode composite_mode = QImode; i_index = 0; FOR_EACH_MODE_IN_CLASS (int_mode_iter, MODE_INT) @@ -447,6 +430,10 @@ gfc_init_kinds (void) if (!targetm.scalar_mode_supported_p (mode)) continue; + if (MODE_COMPOSITE_P (mode) + && (GET_MODE_PRECISION (mode) + 7) / 8 == 16) + composite_mode = mode; + /* Only let float, double, long double and TFmode go through. Runtime support for others is not provided, so they would be useless. */ @@ -490,7 +477,10 @@ gfc_init_kinds (void) if (kind == 10) saw_r10 = true; if (kind == 16) - saw_r16 = true; + { + saw_r16 = true; + r16_mode = mode; + } /* Careful we don't stumble a weird internal mode. */ gcc_assert (r_index <= 0 || gfc_real_kinds[r_index-1].kind != kind); @@ -498,6 +488,7 @@ gfc_init_kinds (void) gcc_assert (r_index != MAX_REAL_KINDS); gfc_real_kinds[r_index].kind = kind; + gfc_real_kinds[r_index].abi_kind = kind; gfc_real_kinds[r_index].radix = fmt->b; gfc_real_kinds[r_index].digits = fmt->p; gfc_real_kinds[r_index].min_exponent = fmt->emin; @@ -515,6 +506,31 @@ gfc_init_kinds (void) r_index += 1; } + /* Detect the powerpc64le-linux case with -mabi=ieeelongdouble, where + the long double type is non-MODE_COMPOSITE_P TFmode but one can use + -mabi=ibmlongdouble too and get MODE_COMPOSITE_P TFmode with the same + precision. For libgfortran calls pretend the IEEE 754 quad TFmode has + kind 17 rather than 16 and use kind 16 for the IBM extended format + TFmode. */ + if (composite_mode != QImode && saw_r16 && !MODE_COMPOSITE_P (r16_mode)) + { + for (int i = 0; i < r_index; ++i) + if (gfc_real_kinds[i].kind == 16) + { + gfc_real_kinds[i].abi_kind = 17; + if (flag_building_libgfortran + && (TARGET_GLIBC_MAJOR < 2 + || (TARGET_GLIBC_MAJOR == 2 && TARGET_GLIBC_MINOR < 32))) + { + gfc_real16_is_float128 = true; + gfc_real_kinds[i].c_float128 = 1; + } + } + } + else if ((flag_convert & (GFC_CONVERT_R16_IEEE | GFC_CONVERT_R16_IBM)) != 0) + gfc_fatal_error ("%<-fconvert=r16_ieee%> or %<-fconvert=r16_ibm%> not " + "supported on this architecture"); + /* Choose the default integer kind. We choose 4 unless the user directs us otherwise. Even if the user specified that the default integer kind is 8, the numeric storage size is not 64 bits. In this case, a warning will be @@ -855,7 +871,7 @@ gfc_build_real_type (gfc_real_info *info) info->c_float = 1; if (mode_precision == DOUBLE_TYPE_SIZE) info->c_double = 1; - if (mode_precision == LONG_DOUBLE_TYPE_SIZE) + if (mode_precision == LONG_DOUBLE_TYPE_SIZE && !info->c_float128) info->c_long_double = 1; if (mode_precision != LONG_DOUBLE_TYPE_SIZE && mode_precision == 128) { @@ -2281,7 +2297,7 @@ gfc_sym_type (gfc_symbol * sym, bool is_bind_c) if (sym->ts.type == BT_CHARACTER && ((sym->attr.function && sym->attr.is_bind_c) - || (sym->attr.result + || ((sym->attr.result || sym->attr.value) && sym->ns->proc_name && sym->ns->proc_name->attr.is_bind_c) || (sym->ts.deferred && (!sym->ts.u.cl @@ -2470,7 +2486,7 @@ gfc_copy_dt_decls_ifequal (gfc_symbol *from, gfc_symbol *to, /* Build a tree node for a procedure pointer component. */ -tree +static tree gfc_get_ppc_type (gfc_component* c) { tree t; @@ -3436,10 +3452,8 @@ gfc_get_array_descr_info (const_tree type, struct array_descr_info *info) base_decl = GFC_TYPE_ARRAY_BASE_DECL (type, indirect); if (!base_decl) { - base_decl = make_node (DEBUG_EXPR_DECL); - DECL_ARTIFICIAL (base_decl) = 1; - TREE_TYPE (base_decl) = indirect ? build_pointer_type (ptype) : ptype; - SET_DECL_MODE (base_decl, TYPE_MODE (TREE_TYPE (base_decl))); + base_decl = build_debug_expr_decl (indirect + ? build_pointer_type (ptype) : ptype); GFC_TYPE_ARRAY_BASE_DECL (type, indirect) = base_decl; } info->base_decl = base_decl; @@ -3480,8 +3494,8 @@ gfc_get_array_descr_info (const_tree type, struct array_descr_info *info) if (!integer_zerop (dtype_off)) t = fold_build_pointer_plus (t, rank_off); - t = build1 (NOP_EXPR, build_pointer_type (gfc_array_index_type), t); - t = build1 (INDIRECT_REF, gfc_array_index_type, t); + t = build1 (NOP_EXPR, build_pointer_type (TREE_TYPE (field)), t); + t = build1 (INDIRECT_REF, TREE_TYPE (field), t); info->rank = t; t = build0 (PLACEHOLDER_EXPR, TREE_TYPE (dim_off)); t = size_binop (MULT_EXPR, t, dim_size); diff --git a/gcc/fortran/trans-types.h b/gcc/fortran/trans-types.h index 15d206b..09a51e6 100644 --- a/gcc/fortran/trans-types.h +++ b/gcc/fortran/trans-types.h @@ -1,5 +1,5 @@ /* Header for Fortran 95 types backend support. - Copyright (C) 2002-2021 Free Software Foundation, Inc. + Copyright (C) 2002-2022 Free Software Foundation, Inc. Contributed by Paul Brook <paul@nowt.org> and Steven Bosscher <s.bosscher@student.tudelft.nl> @@ -65,10 +65,7 @@ enum gfc_packed { PACKED_STATIC }; -/* be-function.c */ -void gfc_convert_function_code (gfc_namespace *); - -/* trans-types.c */ +/* trans-types.cc */ void gfc_init_kinds (void); void gfc_init_types (void); void gfc_init_c_interop_kinds (void); @@ -117,7 +114,6 @@ int gfc_is_nodesc_array (gfc_symbol *); tree gfc_get_dtype_rank_type (int, tree); tree gfc_get_dtype (tree, int *rank = NULL); -tree gfc_get_ppc_type (gfc_component *); tree gfc_get_caf_vector_type (int dim); tree gfc_get_caf_reference_type (); diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.cc index 22f2676..333dfa6 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.cc @@ -1,5 +1,5 @@ /* Code translation -- generate GCC trees from gfc_code. - Copyright (C) 2002-2021 Free Software Foundation, Inc. + Copyright (C) 2002-2022 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of GCC. @@ -45,13 +45,12 @@ along with GCC; see the file COPYING3. If not see static gfc_file *gfc_current_backend_file; const char gfc_msg_fault[] = N_("Array reference out of bounds"); -const char gfc_msg_wrong_return[] = N_("Incorrect function return value"); /* Return a location_t suitable for 'tree' for a gfortran locus. The way the parser works in gfortran, loc->lb->location contains only the line number and LOCATION_COLUMN is 0; hence, the column has to be added when generating - locations for 'tree'. Cf. error.c's gfc_format_decoder. */ + locations for 'tree'. Cf. error.cc's gfc_format_decoder. */ location_t gfc_get_location (locus *loc) @@ -2253,7 +2252,7 @@ trans_code (gfc_code * code, tree cond) /* Translate an executable statement with condition, cond. The condition is used by gfc_trans_do to test for IO result conditions inside implied - DO loops of READ and WRITE statements. See build_dt in trans-io.c. */ + DO loops of READ and WRITE statements. See build_dt in trans-io.cc. */ tree gfc_trans_code_cond (gfc_code * code, tree cond) diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h index 7ec4ca53..738c748 100644 --- a/gcc/fortran/trans.h +++ b/gcc/fortran/trans.h @@ -1,5 +1,5 @@ /* Header for code translation functions - Copyright (C) 2002-2021 Free Software Foundation, Inc. + Copyright (C) 2002-2022 Free Software Foundation, Inc. Contributed by Paul Brook This file is part of GCC. @@ -266,8 +266,8 @@ typedef struct gfc_ss_info struct { /* If the scalar is passed as actual argument to an (elemental) procedure, - this is the symbol of the corresponding dummy argument. */ - gfc_symbol *dummy_arg; + this is the corresponding dummy argument. */ + gfc_dummy_arg *dummy_arg; tree value; /* Tells that the scalar is a reference to a variable that might be present on the lhs, so that we should evaluate the value @@ -425,7 +425,6 @@ tree gfc_class_set_static_fields (tree, tree, tree); tree gfc_class_data_get (tree); tree gfc_class_vptr_get (tree); tree gfc_class_len_get (tree); -tree gfc_class_len_or_zero_get (tree); tree gfc_resize_class_size_with_len (stmtblock_t *, tree, tree); gfc_expr * gfc_find_and_cut_at_last_class_ref (gfc_expr *, bool is_mold = false, gfc_typespec **ts = NULL); @@ -433,14 +432,12 @@ gfc_expr * gfc_find_and_cut_at_last_class_ref (gfc_expr *, bool is_mold = false, available. */ tree gfc_class_vtab_hash_get (tree); tree gfc_class_vtab_size_get (tree); -tree gfc_class_vtab_extends_get (tree); tree gfc_class_vtab_def_init_get (tree); tree gfc_class_vtab_copy_get (tree); tree gfc_class_vtab_final_get (tree); /* Get an accessor to the vtab's * field, when a vptr handle is present. */ tree gfc_vptr_hash_get (tree); tree gfc_vptr_size_get (tree); -tree gfc_vptr_extends_get (tree); tree gfc_vptr_def_init_get (tree); tree gfc_vptr_copy_get (tree); tree gfc_vptr_final_get (tree); @@ -450,7 +447,6 @@ void gfc_reset_len (stmtblock_t *, gfc_expr *); tree gfc_get_class_from_gfc_expr (gfc_expr *); tree gfc_get_class_from_expr (tree); tree gfc_get_vptr_from_expr (tree); -tree gfc_get_class_array_ref (tree, tree, tree, bool); tree gfc_copy_class_to_class (tree, tree, tree, bool); bool gfc_add_finalizer_call (stmtblock_t *, gfc_expr *); bool gfc_add_comp_finalizer_call (stmtblock_t *, tree, gfc_component *, bool); @@ -497,7 +493,7 @@ tree gfc_build_compare_string (tree, tree, tree, tree, int, enum tree_code); when a POST chain may be created, and what the returned expression may be used for. Note that character strings have special handling. This should not be a problem as most statements/operations only deal with - numeric/logical types. See the implementations in trans-expr.c + numeric/logical types. See the implementations in trans-expr.cc for details of the individual functions. */ void gfc_conv_expr (gfc_se * se, gfc_expr * expr); @@ -508,12 +504,10 @@ void gfc_conv_expr_reference (gfc_se * se, gfc_expr * expr, void gfc_conv_expr_type (gfc_se * se, gfc_expr *, tree); -/* trans-expr.c */ -tree gfc_get_character_len (tree); +/* trans-expr.cc */ tree gfc_get_character_len_in_bytes (tree); tree gfc_conv_scalar_to_descriptor (gfc_se *, tree, symbol_attribute); tree gfc_get_ultimate_alloc_ptr_comps_caf_token (gfc_se *, gfc_expr *); -void gfc_conv_scalar_char_value (gfc_symbol *sym, gfc_se *se, gfc_expr **expr); tree gfc_string_to_single_character (tree len, tree str, int kind); tree gfc_get_tree_for_caf_expr (gfc_expr *); void gfc_get_caf_token_offset (gfc_se*, tree *, tree *, tree, tree, gfc_expr *); @@ -621,9 +615,6 @@ tree gfc_get_extern_function_decl (gfc_symbol *, gfc_actual_arglist *args = NULL, const char *fnspec = NULL); -/* Return the decl for a function. */ -tree gfc_get_function_decl (gfc_symbol *); - /* Build an ADDR_EXPR. */ tree gfc_build_addr_expr (tree, tree); @@ -800,18 +791,18 @@ void gfc_process_block_locals (gfc_namespace*); /* Output initialization/clean-up code that was deferred. */ void gfc_trans_deferred_vars (gfc_symbol*, gfc_wrapped_block *); -/* In f95-lang.c. */ +/* In f95-lang.cc. */ tree pushdecl (tree); tree pushdecl_top_level (tree); void pushlevel (void); tree poplevel (int, int); tree getdecls (void); -/* In trans-types.c. */ +/* In trans-types.cc. */ struct array_descr_info; bool gfc_get_array_descr_info (const_tree, struct array_descr_info *); -/* In trans-openmp.c */ +/* In trans-openmp.cc */ bool gfc_omp_is_allocatable_or_ptr (const_tree); tree gfc_omp_check_optional_argument (tree, bool); tree gfc_omp_array_data (tree, bool); @@ -834,7 +825,7 @@ bool gfc_omp_private_outer_ref (tree); struct gimplify_omp_ctx; void gfc_omp_firstprivatize_type_sizes (struct gimplify_omp_ctx *, tree); -/* In trans-intrinsic.c. */ +/* In trans-intrinsic.cc. */ void gfc_conv_intrinsic_mvbits (gfc_se *, gfc_actual_arglist *, gfc_loopinfo *); @@ -909,7 +900,7 @@ extern GTY(()) tree gfor_fndecl_co_sum; extern GTY(()) tree gfor_fndecl_caf_is_present; /* Math functions. Many other math functions are handled in - trans-intrinsic.c. */ + trans-intrinsic.cc. */ typedef struct GTY(()) gfc_powdecl_list { tree integer; @@ -1171,15 +1162,12 @@ void gfc_init_interface_mapping (gfc_interface_mapping *); void gfc_free_interface_mapping (gfc_interface_mapping *); void gfc_add_interface_mapping (gfc_interface_mapping *, gfc_symbol *, gfc_se *, gfc_expr *); -void gfc_finish_interface_mapping (gfc_interface_mapping *, - stmtblock_t *, stmtblock_t *); void gfc_apply_interface_mapping (gfc_interface_mapping *, gfc_se *, gfc_expr *); /* Standard error messages used in all the trans-*.c files. */ extern const char gfc_msg_fault[]; -extern const char gfc_msg_wrong_return[]; #define OMPWS_WORKSHARE_FLAG 1 /* Set if in a workshare construct. */ #define OMPWS_CURR_SINGLEUNIT 2 /* Set if current gfc_code in workshare diff --git a/gcc/fortran/trigd_fe.inc b/gcc/fortran/trigd_fe.inc index dff38e7..fe68a8f 100644 --- a/gcc/fortran/trigd_fe.inc +++ b/gcc/fortran/trigd_fe.inc @@ -1,7 +1,7 @@ /* Stub for defining degree-valued trigonemetric functions using MPFR. - Copyright (C) 2000-2021 Free Software Foundation, Inc. + Copyright (C) 2000-2022 Free Software Foundation, Inc. Contributed by Fritz Reese <foreese@gcc.gnu.org> and Steven G. Kargl <kargl@gcc.gnu.org> diff --git a/gcc/fortran/types.def b/gcc/fortran/types.def index 85b85ed..cd79ad4 100644 --- a/gcc/fortran/types.def +++ b/gcc/fortran/types.def @@ -1,4 +1,4 @@ -/* Copyright (C) 2001-2021 Free Software Foundation, Inc. +/* Copyright (C) 2001-2022 Free Software Foundation, Inc. This file is part of GCC. @@ -117,7 +117,6 @@ DEF_FUNCTION_TYPE_2 (BT_FN_BOOL_VPTR_INT, BT_BOOL, BT_VOLATILE_PTR, BT_INT) DEF_FUNCTION_TYPE_2 (BT_FN_BOOL_SIZE_CONST_VPTR, BT_BOOL, BT_SIZE, BT_CONST_VOLATILE_PTR) DEF_FUNCTION_TYPE_2 (BT_FN_BOOL_INT_BOOL, BT_BOOL, BT_INT, BT_BOOL) -DEF_FUNCTION_TYPE_2 (BT_FN_VOID_UINT_UINT, BT_VOID, BT_UINT, BT_UINT) DEF_FUNCTION_TYPE_2 (BT_FN_VOID_PTR_PTRMODE, BT_VOID, BT_PTR, BT_PTRMODE) DEF_FUNCTION_TYPE_2 (BT_FN_VOID_CONST_PTR_SIZE, BT_VOID, BT_CONST_PTR, BT_SIZE) @@ -173,6 +172,8 @@ DEF_FUNCTION_TYPE_4 (BT_FN_BOOL_UINT_ULLPTR_ULLPTR_ULLPTR, BT_PTR_ULONGLONG) DEF_FUNCTION_TYPE_4 (BT_FN_VOID_UINT_PTR_INT_PTR, BT_VOID, BT_INT, BT_PTR, BT_INT, BT_PTR) +DEF_FUNCTION_TYPE_4 (BT_FN_BOOL_UINT_UINT_UINT_BOOL, + BT_BOOL, BT_UINT, BT_UINT, BT_UINT, BT_BOOL) DEF_FUNCTION_TYPE_5 (BT_FN_VOID_OMPFN_PTR_UINT_UINT_UINT, BT_VOID, BT_PTR_FN_VOID_PTR, BT_PTR, BT_UINT, BT_UINT, |